Changeset 196 for branches/virtcpu varint

Timestamp:

Sep 22, 2019, 7:13:15 PM (5 years ago)

Author:

chronos

Message:

• Modified: Address CPU memory as pointer instead array of bytes.
• Added: TMachine class to represent virtual machine itself.

Location:

branches/virtcpu varint

Files:

• . (modified) (1 prop)
• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (7 diffs)
• UInstructionWriter.pas (modified) (1 diff)
• UMachine.pas (modified) (12 diffs)
• UVarInt.pas (modified) (6 diffs)
• virtcpu.lpi (modified) (1 diff)
• virtcpu.lpr (modified) (1 diff)

branches/virtcpu varint/UFormMain.lfm

@@ -1 @@
-object Form1: TForm1
+object FormMain: TFormMain
   Left = 385
   Height = 914
   Top = 208
   Width = 1543
-  Caption = 'Form1'
+  Caption = 'VarInt machine'
   ClientHeight = 914
   ClientWidth = 1543

branches/virtcpu varint/UFormMain.pas

@@ -11 +11 @@
 type
 
-  { TForm1 }
-
-  TForm1 = class(TForm)
+  { TFormMain }
+
+  TFormMain = class(TForm)
     Button1: TButton;
     Button2: TButton;
@@ -38 +38 @@
     procedure CpuOutput(Port, Value: T);
   public
-    Cpu: TCPU;
+    Machine: TMachine;
     InstructionWriter: TInstructionWriter;
   end;
 
 var
-  Form1: TForm1;
+  FormMain: TFormMain;
 
 const
@@ -53 +53 @@
 {$R *.lfm}
 
-{ TForm1 }
-
-procedure TForm1.FormShow(Sender: TObject);
+{ TFormMain }
+
+procedure TFormMain.FormShow(Sender: TObject);
 var
   LabelStart: Integer;
@@ -104 +104 @@
 end;
 
-procedure TForm1.FormDestroy(Sender: TObject);
-begin
-  InstructionWriter.Free;
-  Cpu.Free;
-end;
-
-procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
-begin
-end;
-
-procedure TForm1.FormCreate(Sender: TObject);
-begin
-  Cpu := TCPU.Create(nil);
-  Cpu.OnInput := CpuInput;
-  Cpu.OnOutput := CpuOutput;
+procedure TFormMain.FormDestroy(Sender: TObject);
+begin
+  FreeAndNil(InstructionWriter);
+  FreeAndNil(Machine);
+end;
+
+procedure TFormMain.FormKeyPress(Sender: TObject; var Key: char);
+begin
+end;
+
+procedure TFormMain.FormCreate(Sender: TObject);
+begin
+  Machine := TMachine.Create(nil);
+  Machine.Cpu.OnInput := CpuInput;
+  Machine.Cpu.OnOutput := CpuOutput;
   InstructionWriter := TInstructionWriter.Create;
-  InstructionWriter.Cpu := Cpu;
-end;
-
-procedure TForm1.Button1Click(Sender: TObject);
-begin
-  Cpu.Start;
-end;
-
-procedure TForm1.Button2Click(Sender: TObject);
-begin
-  Cpu.Stop;
-end;
-
-procedure TForm1.ListViewMemoryData(Sender: TObject; Item: TListItem);
+  InstructionWriter.Cpu := Machine.Cpu;
+end;
+
+procedure TFormMain.Button1Click(Sender: TObject);
+begin
+  Machine.Cpu.Start;
+end;
+
+procedure TFormMain.Button2Click(Sender: TObject);
+begin
+  Machine.Cpu.Stop;
+end;
+
+procedure TFormMain.ListViewMemoryData(Sender: TObject; Item: TListItem);
 var
   Line: string;
   I: Integer;
 begin
-  if Item.Index < Length(Cpu.Memory) div ItemsPerLine then begin
+  if Item.Index < Machine.MemorySize div ItemsPerLine then begin
     Line := '';
     for I := 0 to ItemsPerLine - 1 do
-      Line := Line + IntToHex(Cpu.Memory[Item.Index * ItemsPerLine + I], 2) + ' ';
+      Line := Line + IntToHex(PByte(NativeUInt(Machine.Memory) + Item.Index * ItemsPerLine + I)^, 2) + ' ';
     Item.Caption := IntToHex(Item.Index * ItemsPerLine, 8);
     Item.SubItems.Add(Line);
@@ -147 +147 @@
 end;
 
-procedure TForm1.ListViewRegistersData(Sender: TObject; Item: TListItem);
-begin
-  if Item.Index < Length(Cpu.Registers) + 1 then begin
+procedure TFormMain.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(Int64(Cpu.IP), 8));
+      Item.SubItems.Add(IntToHex(Int64(Machine.Cpu.IP), 8));
     end else
     if Item.Index = 1 then begin
       Item.Caption := 'SP';
-      Item.SubItems.Add(IntToHex(Int64(Cpu.SP), 8));
+      Item.SubItems.Add(IntToHex(Int64(Machine.Cpu.SP), 8));
     end else begin
       Item.Caption := 'R' + IntToStr(Item.Index - 2);
-      Item.SubItems.Add(IntToHex(Int64(Cpu.Registers[Item.Index - 2]), 8));
+      Item.SubItems.Add(IntToHex(Int64(Machine.Cpu.Registers[Item.Index - 2]), 8));
     end;
   end;
 end;
 
-procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: char);
+procedure TFormMain.Memo1KeyPress(Sender: TObject; var Key: char);
 begin
   SetLength(KeyInputBuffer, Length(KeyInputBuffer) + 1);
@@ -170 +170 @@
 end;
 
-procedure TForm1.Timer1Timer(Sender: TObject);
+procedure TFormMain.Timer1Timer(Sender: TObject);
 begin
   ReloadMemoryDump;
   ReloadRegisterDump;
-  LabelTicks.Caption := 'Ticks: ' + IntToStr(Cpu.Ticks);
-end;
-
-procedure TForm1.ReloadMemoryDump;
-begin
-  ListViewMemory.Items.Count := Length(Cpu.Memory) div ItemsPerLine;
+  LabelTicks.Caption := 'Ticks: ' + IntToStr(Machine.Cpu.Ticks);
+end;
+
+procedure TFormMain.ReloadMemoryDump;
+begin
+  ListViewMemory.Items.Count := Machine.MemorySize div ItemsPerLine;
   ListViewMemory.Refresh;
 end;
 
-procedure TForm1.ReloadRegisterDump;
-begin
-  ListViewRegisters.Items.Count := Length(Cpu.Registers);
+procedure TFormMain.ReloadRegisterDump;
+begin
+  ListViewRegisters.Items.Count := Length(Machine.Cpu.Registers);
   ListViewRegisters.Refresh;
 end;
 
-function TForm1.CpuInput(Port: T): T;
+function TFormMain.CpuInput(Port: T): T;
 begin
   Result := 0;
   case Integer(Port) of
     0: begin
-      while (Length(KeyInputBuffer) = 0) and not Cpu.Terminated do begin
+      while (Length(KeyInputBuffer) = 0) and not Machine.Cpu.Terminated do begin
         Sleep(100);
         Application.ProcessMessages;
@@ -208 +208 @@
 end;
 
-procedure TForm1.CpuOutput(Port, Value: T);
+procedure TFormMain.CpuOutput(Port, Value: T);
 begin
   case Integer(Port) of

branches/virtcpu varint/UInstructionWriter.pas

@@ -166 +166 @@
   C: Integer;
 begin
-  C := Value.WriteToAddr(@Cpu.Memory[IP]);
+  C := Value.WriteToAddr(Pointer(NativeInt(Cpu.Memory) + IP));
   Inc(IP, C);
 end;

branches/virtcpu varint/UMachine.pas

@@ -1 +1 @@
 unit UMachine;
-
 
 {$mode delphi}{$H+}
@@ -85 +84 @@
     procedure OpcodeLddr;
   public
+    Memory: Pointer;
     Registers: array of T;
     IP: T;
+    SP: T;
     Condition: Boolean;
-    SP: T;
-    Memory: array of Byte;
     Terminated: Boolean;
     Ticks: Integer;
     procedure Start;
     procedure Stop;
+    procedure Step; inline;
     constructor Create(AOwner: TComponent); override;
   published
@@ -100 +100 @@
   end;
 
+  { TMachine }
+
+  TMachine = class(TComponent)
+  private
+    FMemorySize: Integer;
+    procedure SetMemorySize(AValue: Integer);
+  public
+    Cpu: TCpu;
+    Memory: Pointer;
+    property MemorySize: Integer read FMemorySize write SetMemorySize;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
 
 implementation
 
+{ TMachine }
+
+procedure TMachine.SetMemorySize(AValue: Integer);
+begin
+  if FMemorySize = AValue then Exit;
+  FMemorySize := AValue;
+  Memory := ReAllocMem(Memory, FMemorySize);
+  Cpu.Memory := Memory;
+end;
+
+constructor TMachine.Create(AOwner: TComponent);
+begin
+  inherited;
+  Cpu := TCpu.Create(nil);
+  MemorySize := 1000;
+end;
+
+destructor TMachine.Destroy;
+begin
+  MemorySize := 0;
+  FreeAndNil(Cpu);
+  inherited Destroy;
+end;
+
 { TCPU }
 
 function TCPU.ReadNext: T;
 begin
-  IP := IP + Result.ReadFromAddr(@Memory[IP]);
+  IP := IP + Result.ReadFromAddr(Pointer(NativeUInt(Memory) + IP));
 end;
 
@@ -147 +185 @@
   P1 := ReadNext;
   P2 := ReadNext;
-  Registers[P1] := Memory[Registers[P2]];
+  Registers[P1].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(Registers[P2])));
 end;
 
@@ -157 +195 @@
   P1 := ReadNext;
   P2 := ReadNext;
-  Memory[Registers[P1]] := Registers[P2];
+  Registers[P2].WriteToAddr(Pointer(NativeUInt(Memory) + Registers[P1]));
 end;
 
@@ -307 +345 @@
   P1 := ReadNext;
   SP := SP - Registers[P1].GetByteSize;
-  Registers[P1].WriteToAddr(@Memory[SP]);
+  Registers[P1].WriteToAddr(Pointer(NativeUInt(Memory) + Integer(SP)));
 end;
 
 procedure TCPU.OpcodePop;
 begin
-  SP := SP + Registers[ReadNext].ReadFromAddr(@Memory[SP]);
+  SP := SP + Registers[ReadNext].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(SP)));
 end;
 
@@ -321 +359 @@
   Addr := ReadNext;
   SP := SP - IP.GetByteSize;
-  IP.WriteToAddr(@Memory[SP]);
+  IP.WriteToAddr(Pointer(NativeUInt(Memory) + SP));
   IP := Addr;
 end;
@@ -331 +369 @@
   Addr := ReadNext;
   SP := SP - IP.GetByteSize;
-  IP.WriteToAddr(@Memory[SP]);
+  IP.WriteToAddr(Pointer(NativeUInt(Memory) + SP));
   IP := IP + Addr;
 end;
 
 procedure TCPU.OpcodeReturn;
-var
-  S: Integer;
-begin
-  SP := SP + IP.ReadFromAddr(@Memory[SP]);
+begin
+  SP := SP + IP.ReadFromAddr(Pointer(NativeUInt(Memory) + SP));
 end;
 
@@ -424 +460 @@
   Src: T;
   Dst: T;
-  Size: T;
+  Count: T;
+  Bytes: T;
 begin
   Src := ReadNext;
   Dst := ReadNext;
-  Size := ReadNext;
-  while Registers[Size] > 0 do begin
-    Memory[Registers[Dst]] := Memory[Registers[Src]];
-    Inc(Registers[Src]);
-    Inc(Registers[Dst]);
-    Dec(Registers[Size]);
+  Count := ReadNext;
+  Bytes := ReadNext;
+  while Registers[Count] > 0 do begin
+    Move(Pointer(NativeUInt(Memory) + Registers[Src])^,
+      Pointer(NativeUInt(Memory) + Registers[Dst])^, Bytes);
+    Inc(Registers[Src], Bytes);
+    Inc(Registers[Dst], Bytes);
+    Dec(Registers[Count]);
   end;
 end;
@@ -441 +480 @@
   Src: T;
   Dst: T;
-  Size: T;
+  Count: T;
+  Bytes: T;
 begin
   Src := ReadNext;
   Dst := ReadNext;
-  Size := ReadNext;
-  while Registers[Size] > 0 do begin
-    Memory[Registers[Dst]] := Memory[Registers[Src]];
-    Dec(Registers[Src]);
-    Dec(Registers[Dst]);
-    Dec(Registers[Size]);
+  Count := ReadNext;
+  Bytes := ReadNext;
+  while Registers[Count] > 0 do begin
+    Move(Pointer(NativeUInt(Memory) + Registers[Src])^,
+      Pointer(NativeUInt(Memory) + Registers[Dst])^, Bytes);
+    Dec(Registers[Src], Bytes);
+    Dec(Registers[Dst], Bytes);
+    Dec(Registers[Count]);
   end;
 end;
 
 procedure TCPU.Start;
-var
-  Opcode: T;
 begin
   Terminated := False;
   Ticks := 0;
   IP := 0;
-  SP := Length(Memory);
-  while not Terminated do begin
-    Opcode := ReadNext;
-    if (Opcode >= 0) and (Opcode <= T(Integer(High(TOpcode)))) then
-      OpcodeHandlers[TOpcode(Byte(Opcode))]
-      else raise Exception.Create(Format('Unsupported instruction %d', [Int64(Opcode)]));
-    Inc(Ticks);
-  end;
+  SP := MemSize(Memory);
+  while not Terminated do
+    Step;
 end;
 
@@ -474 +509 @@
 begin
   Terminated := True;
+end;
+
+procedure TCPU.Step;
+var
+  Opcode: T;
+begin
+  Opcode := ReadNext;
+  if (Opcode >= 0) and (Opcode <= T(Integer(High(TOpcode)))) then
+    OpcodeHandlers[TOpcode(Byte(Opcode))]
+    else raise Exception.Create(Format('Unsupported instruction %d on address %x', [Int64(Opcode), Int64(IP)]));
+  Inc(Ticks);
 end;
 
@@ -480 +526 @@
   inherited;
   SetLength(Registers, 16);
-  SetLength(Memory, 1024);
   OpcodeHandlers[opNop] := OpcodeNop;
   OpcodeHandlers[opHalt] := OpcodeHalt;

branches/virtcpu varint/UVarInt.pas

@@ -32 +32 @@
     class operator Explicit(A: TVarInt): Int64;
     class operator Inc(A: TVarInt): TVarInt;
-    class operator Inc(A: TVarInt; B: Integer): TVarInt;
+    class operator Inc(A: TVarInt; B: TVarInt): TVarInt;
     class operator Dec(A: TVarInt): TVarInt;
+    class operator Dec(A: TVarInt; B: TVarInt): TVarInt;
     class operator Negative(A: TVarInt): TVarInt;
     class operator Add(A: TVarInt; B: TVarInt): TVarInt;
@@ -75 +76 @@
     class operator Explicit(A: TVarUInt): Int64;
     class operator Inc(A: TVarUInt): TVarUInt;
-    class operator Inc(A: TVarUInt; B: Integer): TVarUInt;
+    class operator Inc(A: TVarUInt; B: TVarInt): TVarUInt;
     class operator Dec(A: TVarUInt): TVarUInt;
+    class operator Dec(A: TVarUInt; B: TVarUInt): TVarUInt;
     class operator Negative(A: TVarUInt): TVarUInt;
     class operator Add(A: TVarUInt; B: TVarUInt): TVarUInt;
@@ -191 +193 @@
 end;
 
-class operator TVarUInt.Inc(A: TVarUInt; B: Integer): TVarUInt;
-begin
-  Result.Value := A.Value + B;
+class operator TVarUInt.Inc(A: TVarUInt; B: TVarInt): TVarUInt;
+begin
+  Result.Value := A.Value + B.Value;
 end;
 
@@ -199 +201 @@
 begin
   Result.Value := A.Value - 1;
+end;
+
+class operator TVarUInt.Dec(A: TVarUInt; B: TVarUInt): TVarUInt;
+begin
+  Result.Value := A.Value - B.Value;
 end;
 
@@ -424 +431 @@
 end;
 
-class operator TVarInt.Inc(A: TVarInt; B: Integer): TVarInt;
-begin
-  Result := A.Value + B;
+class operator TVarInt.Inc(A: TVarInt; B: TVarInt): TVarInt;
+begin
+  Result := A.Value + B.Value;
 end;
 
@@ -432 +439 @@
 begin
   Result.Value := A.Value - 1;
+end;
+
+class operator TVarInt.Dec(A: TVarInt; B: TVarInt): TVarInt;
+begin
+  Result.Value := A.Value - B.Value;
 end;
 

branches/virtcpu varint/virtcpu.lpi

@@ -72 +72 @@
         <Filename Value="UFormMain.pas"/>
         <IsPartOfProject Value="True"/>
-        <ComponentName Value="Form1"/>
+        <ComponentName Value="FormMain"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>

branches/virtcpu varint/virtcpu.lpr

@@ -16 +16 @@
   RequireDerivedFormResource:=True;
   Application.Initialize;
-  Application.CreateForm(TForm1, Form1);
+  Application.CreateForm(TFormMain, FormMain);
   Application.Run;
 end.