Changeset 215 for branches/virtcpu fixed int/UFormMain.pas

Timestamp:

Aug 19, 2020, 11:54:20 PM (4 years ago)

Author:

chronos

Message:

• Added: TMachine class which contains CPU and peripherals.
• Added: Execute TCpu inside background thread.

File:

• branches/virtcpu fixed int/UFormMain.pas (modified) (12 diffs)

branches/virtcpu fixed int/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
-  StdCtrls, ExtCtrls, UMachine, UInstructionWriter;
+  StdCtrls, ExtCtrls, UCpu, UInstructionWriter, UMachine;
 
 type
@@ -14 +14 @@
 
   TForm1 = class(TForm)
-    Button1: TButton;
-    Button2: TButton;
+    ButtonStart: TButton;
+    ButtonStop: TButton;
     LabelTicks: TLabel;
     ListViewMemory: TListView;
@@ -21 +21 @@
     Memo1: TMemo;
     Timer1: TTimer;
-    procedure Button1Click(Sender: TObject);
-    procedure Button2Click(Sender: TObject);
+    procedure ButtonStartClick(Sender: TObject);
+    procedure ButtonStopClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
@@ -32 +32 @@
     procedure Timer1Timer(Sender: TObject);
   private
-    KeyInputBuffer: array of Char;
     procedure ReloadMemoryDump;
     procedure ReloadRegisterDump;
-    function CpuInput(Port: T): T;
-    procedure CpuOutput(Port, Value: T);
+    procedure SerialOutputExecute(Sender: TObject);
   public
-    Cpu: TCPU;
+    Machine: TMachine;
     InstructionWriter: TInstructionWriter;
   end;
@@ -87 +85 @@
     Output(0, R1);
     Subtract(R1, R4);
-    JumpZero(R1, LabelPrint);
+    TestZero(R1);
+    JumpCond(LabelPrint);
   LabelPrintBack := IP;
     Increment(R2);
@@ -101 +100 @@
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
-  InstructionWriter.Free;
-  Cpu.Free;
+  FreeAndNil(InstructionWriter);
+  FreeAndNil(Machine);
 end;
 
@@ -111 +110 @@
 procedure TForm1.FormCreate(Sender: TObject);
 begin
-  Cpu := TCPU.Create(nil);
-  Cpu.OnInput := CpuInput;
-  Cpu.OnOutput := CpuOutput;
+  Machine := TMachine.Create(nil);
+  Machine.OnSerialOutput := SerialOutputExecute;
   InstructionWriter := TInstructionWriter.Create;
-  InstructionWriter.Cpu := Cpu;
+  InstructionWriter.Cpu := Machine.Cpu;
 end;
 
-procedure TForm1.Button1Click(Sender: TObject);
+procedure TForm1.ButtonStartClick(Sender: TObject);
 begin
-  Cpu.Start;
+  Machine.Cpu.Start;
 end;
 
-procedure TForm1.Button2Click(Sender: TObject);
+procedure TForm1.ButtonStopClick(Sender: TObject);
 begin
-  Cpu.Stop;
+  Machine.Cpu.Stop;
 end;
 
@@ -133 +131 @@
   I: Integer;
 begin
-  if Item.Index < Length(Cpu.Memory) div ItemsPerLine then begin
+  if Item.Index < Length(Machine.Cpu.Memory) 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(Machine.Cpu.Memory[Item.Index * ItemsPerLine + I], 2) + ' ';
     Item.Caption := IntToHex(Item.Index * ItemsPerLine, 8);
     Item.SubItems.Add(Line);
@@ -144 +142 @@
 procedure TForm1.ListViewRegistersData(Sender: TObject; Item: TListItem);
 begin
-  if Item.Index < Length(Cpu.Registers) + 1 then begin
+  if Item.Index < Length(Machine.Cpu.Registers) + 1 then begin
     if Item.Index = 0 then begin
       Item.Caption := 'IP';
-      Item.SubItems.Add(IntToHex(Cpu.IP, 8));
+      Item.SubItems.Add(IntToHex(Machine.Cpu.IP, 8));
     end else begin
       Item.Caption := 'R' + IntToStr(Item.Index - 1);
-      Item.SubItems.Add(IntToHex(Cpu.Registers[Item.Index - 1], 8));
+      Item.SubItems.Add(IntToHex(Machine.Cpu.Registers[Item.Index - 1], 8));
     end;
   end;
@@ -157 +155 @@
 procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: char);
 begin
-  SetLength(KeyInputBuffer, Length(KeyInputBuffer) + 1);
-  KeyInputBuffer[High(KeyInputBuffer)] := Key;
+  Machine.SerialInput(Key);
 end;
 
@@ -165 +162 @@
   ReloadMemoryDump;
   ReloadRegisterDump;
-  LabelTicks.Caption := 'Ticks: ' + IntToStr(Cpu.Ticks);
+  LabelTicks.Caption := 'Ticks: ' + IntToStr(Machine.Cpu.Ticks);
 end;
 
 procedure TForm1.ReloadMemoryDump;
 begin
-  ListViewMemory.Items.Count := Length(Cpu.Memory) div ItemsPerLine;
+  ListViewMemory.Items.Count := Length(Machine.Cpu.Memory) div ItemsPerLine;
   ListViewMemory.Refresh;
 end;
@@ -176 +173 @@
 procedure TForm1.ReloadRegisterDump;
 begin
-  ListViewRegisters.Items.Count := Length(Cpu.Registers);
+  ListViewRegisters.Items.Count := Length(Machine.Cpu.Registers);
   ListViewRegisters.Refresh;
 end;
 
-function TForm1.CpuInput(Port: T): T;
+procedure TForm1.SerialOutputExecute(Sender: TObject);
+var
+  Buffer: string;
 begin
-  Result := 0;
-  case Port of
-    0: begin
-      while (Length(KeyInputBuffer) = 0) and not Cpu.Terminated do begin
-        Sleep(100);
-        Application.ProcessMessages;
-      end;
-      if Length(KeyInputBuffer) > 0 then begin
-        Result := Ord(KeyInputBuffer[0]);
-        if Length(KeyInputBuffer) > 1 then
-          Move(KeyInputBuffer[1], KeyInputBuffer[0], Length(KeyInputBuffer) - 1);
-        SetLength(KeyInputBuffer, Length(KeyInputBuffer) - 1);
-      end else Result := 0;
+  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;
-  end;
-end;
-
-procedure TForm1.CpuOutput(Port, Value: T);
-begin
-  case Port of
-    0: Memo1.Lines.Text := Memo1.Lines.Text + Char(Value);
+  finally
+    Machine.SerialBufferLock.Release;
   end;
 end;