source: branches/virtcpu fixed int/UFormMain.pas

unit UFormMain;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  StdCtrls, ExtCtrls, UCpu, UInstructionWriter, UMachine;

type

  { TForm1 }

  TForm1 = class(TForm)
    ButtonStart: TButton;
    ButtonStop: TButton;
    LabelTicks: TLabel;
    ListViewMemory: TListView;
    ListViewRegisters: TListView;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: char);
    procedure FormShow(Sender: TObject);
    procedure ListViewMemoryData(Sender: TObject; Item: TListItem);
    procedure ListViewRegistersData(Sender: TObject; Item: TListItem);
    procedure Memo1KeyPress(Sender: TObject; var Key: char);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure ReloadMemoryDump;
    procedure ReloadRegisterDump;
    procedure SerialOutputExecute(Sender: TObject);
  public
    Machine: TMachine;
    InstructionWriter: TInstructionWriter;
  end;

var
  Form1: TForm1;

const
  ItemsPerLine = 16;


implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
var
  LabelStart: Integer;
  LabelPrint: Integer;
  LabelPrintBack: Integer;
  R0: Integer;
  R1: Integer;
  R2: Integer;
  R3: Integer;
  R4: Integer;
begin
  R0 := 0;
  R1 := 1;
  R2 := 2;
  R3 := 3;
  R4 := 4;
  with InstructionWriter do begin
    {NoOperation;
    LoadConst(1, $ffff);
    Load(0, 1);
    LoadConst(2, $10);
    StoreMemory(2, 0);
    }
    LabelPrint := $100;

    LoadConst(R2, 0);
    LoadConst(R0, 0);
    LoadConst(R4, Ord('a'));
  LabelStart := IP;
    Input(R1, 0);
    Output(0, R1);
    Subtract(R1, R4);
    TestZero(R1);
    JumpCond(LabelPrint);
  LabelPrintBack := IP;
    Increment(R2);
    Jump(LabelStart);
    Halt;
  IP := LabelPrint;
    LoadConst(R3, Ord('!'));
    Output(0, R3);
    Jump(LabelPrintBack)
  end;
end;

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

procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
begin
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Machine := TMachine.Create(nil);
  Machine.OnSerialOutput := SerialOutputExecute;
  InstructionWriter := TInstructionWriter.Create;
  InstructionWriter.Cpu := Machine.Cpu;
end;

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

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

procedure TForm1.ListViewMemoryData(Sender: TObject; Item: TListItem);
var
  Line: string;
  I: Integer;
begin
  if Item.Index < Length(Machine.Cpu.Memory) div ItemsPerLine then begin
    Line := '';
    for I := 0 to ItemsPerLine - 1 do
      Line := Line + IntToHex(Machine.Cpu.Memory[Item.Index * ItemsPerLine + I], 2) + ' ';
    Item.Caption := IntToHex(Item.Index * ItemsPerLine, 8);
    Item.SubItems.Add(Line);
  end;
end;

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

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: char);
begin
  Machine.SerialInput(Key);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  ReloadMemoryDump;
  ReloadRegisterDump;
  LabelTicks.Caption := 'Ticks: ' + IntToStr(Machine.Cpu.Ticks);
end;

procedure TForm1.ReloadMemoryDump;
begin
  ListViewMemory.Items.Count := Length(Machine.Cpu.Memory) div ItemsPerLine;
  ListViewMemory.Refresh;
end;

procedure TForm1.ReloadRegisterDump;
begin
  ListViewRegisters.Items.Count := Length(Machine.Cpu.Registers);
  ListViewRegisters.Refresh;
end;

procedure TForm1.SerialOutputExecute(Sender: TObject);
var
  Buffer: string;
begin
  Machine.SerialBufferLock.Acquire;
  try
    if Length(Machine.SerialBufferOutput) > 0 then begin
      SetLength(Buffer, Length(Machine.SerialBufferOutput));
      Move(Machine.SerialBufferOutput[0], Buffer[1], Length(Machine.SerialBufferOutput));
      Memo1.Lines.Text := Memo1.Lines.Text + Buffer;
      SetLength(Machine.SerialBufferOutput, 0);
    end;
  finally
    Machine.SerialBufferLock.Release;
  end;
end;

end.