source: branches/virt simple/UFormMain.pas

unit UFormMain;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  ExtCtrls, StdCtrls, ActnList, fgl, UMachine, UBigInt, UCompiler;

type

{ TForm1 }

  TForm1 = class(TForm)
    ASave: TAction;
    ActionList1: TActionList;
    ButtonCompile: TButton;
    ButtonStart: TButton;
    ButtonStop: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ListViewMemory: TListView;
    ListViewInstructions: TListView;
    ListViewRegisters: TListView;
    ListViewSpecialRegisters: TListView;
    MemoSource: TMemo;
    MemoOutput: TMemo;
    Timer1: TTimer;
    procedure ASaveExecute(Sender: TObject);
    procedure ButtonCompileClick(Sender: TObject);
    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonStopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListViewInstructionsData(Sender: TObject; Item: TListItem);
    procedure ListViewMemoryData(Sender: TObject; Item: TListItem);
    procedure ListViewRegistersData(Sender: TObject; Item: TListItem);
    procedure ListViewSpecialRegistersData(Sender: TObject; Item: TListItem);
    procedure Timer1Timer(Sender: TObject);
  private
    Console: string;
    procedure ReloadMemory;
    procedure DoSystemCall(Index: Integer);
    procedure UpdateInterface;
  public
    Machine: TMachine;
    Compiler: TCompiler;
  end;

var
  Form1: TForm1;

implementation

const
  DefaultFileName = 'example.vasm';

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Machine := TMachine.Create;
  Machine.OnSystemCall := DoSystemCall;
  Compiler := TCompiler.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  Machine.Stop;
  ASave.Execute;
end;

procedure TForm1.ButtonCompileClick(Sender: TObject);
begin
  Compiler.Lines.Assign(MemoSource.Lines);
  Compiler.Compile(Machine.Instructions);
end;

procedure TForm1.ASaveExecute(Sender: TObject);
begin
  MemoSource.Lines.SaveToFile(DefaultFileName);
end;

procedure TForm1.ButtonStartClick(Sender: TObject);
begin
  Machine.Start;
  UpdateInterface;
end;

procedure TForm1.ButtonStopClick(Sender: TObject);
begin
  Machine.Stop;
  UpdateInterface;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(Compiler);
  FreeAndNil(Machine);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  MemoSource.Lines.LoadFromFile(DefaultFileName);
  ReloadMemory;
  UpdateInterface;
  with Machine do begin
    Init(32000, 16);
{    with Instructions do begin
      AddInst(opNoOperation);
      AddInst(opIncrement, ptRegister, False, 0);
      AddInst(opLoad, ptRegister, False, 1, ptRegister, False, 0);
      AddInst(opLoad, ptConst, True, 2, ptRegister, False, 1);
      AddInst(opOutput, ptConst, False, 0, ptRegister, False, 1);
      AddInst(opPush, ptConst, False, 1);
      AddInst(opPop, ptConst, True, 10);
      AddInst(opLoad, ptRegister, False, 0, ptConst, False, Ord('A'));
      AddInst(opSystemCall, ptConst, False, 0);
      AddInst(opLoad, ptRegister, False, 0, ptConst, False, 1000);
      AddInst(opSystemCall, ptConst, False, 2);
      AddInst(opJumpAbsolute, ptConst, False, 0);
      AddInst(opLoad, ptRegister, True, 4, ptRegister, True, 3);
      AddInst(opHalt);
    end;
    }
  end;
end;

procedure TForm1.ListViewInstructionsData(Sender: TObject; Item: TListItem);
begin
  if Item.Index < Machine.Instructions.Count then begin
    Item.Caption := IntToStr(Item.Index);
    Item.SubItems.Add(Machine.Instructions[Item.Index].GetString);
  end;
end;

procedure TForm1.ListViewMemoryData(Sender: TObject; Item: TListItem);
begin
  if Item.Index < Machine.Memory.Count then
  begin
    Item.Caption := IntToHex(Item.Index, 8);
    Item.SubItems.Add(IntToHex(Machine.Memory[Item.Index], 8));
  end;
end;

procedure TForm1.ListViewRegistersData(Sender: TObject; Item: TListItem);
begin
  if Item.Index < Machine.Registers.Count then
  begin
    Item.Caption := 'R' + IntToStr(Item.Index);
    Item.SubItems.Add(IntToHex(Machine.Registers[Item.Index], 8));
  end;
end;

procedure TForm1.ListViewSpecialRegistersData(Sender: TObject; Item: TListItem);
begin
  if Item.Index < 2 then
  begin
    if Item.Index = 0 then begin
      Item.Caption := 'IP';
      Item.SubItems.Add(IntToHex(Machine.IP, 8));
    end else
    if Item.Index = 1 then begin
      Item.Caption := 'SP';
      Item.SubItems.Add(IntToHex(Machine.SP, 8));
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  ReloadMemory;
  MemoOutput.Text := Console;
end;

procedure TForm1.ReloadMemory;
begin
  ListViewMemory.Items.Count := Machine.Memory.Count;
  ListViewMemory.Refresh;
  ListViewRegisters.Items.Count := Machine.Registers.Count;
  ListViewRegisters.Refresh;
  ListViewSpecialRegisters.Items.Count := 2;
  ListViewSpecialRegisters.Refresh;
  ListViewInstructions.Items.Count := Machine.Instructions.Count;
  ListViewInstructions.Refresh;
end;

procedure TForm1.DoSystemCall(Index: Integer);
begin
  with Machine do
  if Index = 0 then begin
    // Write character to output
    Console := Console + Chr((Registers[0]) and $ff);
  end else
  if Index = 2 then begin
    // Sleep in milliseconds
    Sleep(Registers[0]);
  end;
end;

procedure TForm1.UpdateInterface;
begin
  ButtonStart.Enabled := not Machine.Running;
  ButtonStop.Enabled := Machine.Running;
end;

end.