Changeset 89 for branches

Timestamp:

Sep 30, 2016, 10:13:35 PM (8 years ago)

Author:

chronos

Message:

• Modified: Start/stop virtual machine by buttons. Thread moved from main form to TMachine class.

Location:

branches/virt simple

Files:

• . (modified) (1 prop)
• UCompiler.pas (modified) (1 diff)
• UFormMain.lfm (modified) (3 diffs)
• UFormMain.pas (modified) (9 diffs)
• UMachine.pas (modified) (5 diffs)
• example.vasm (modified) (1 diff)

branches/virt simple/UCompiler.pas

@@ -53 +53 @@
   OutValue: Integer;
 begin
+  Line := Trim(Line);
+  // Strip comments
+  if Pos(';', Line) > 0 then begin
+    Line := Trim(Copy(Line, 1, Pos(';', Line) - 1));
+  end;
+  if Line = '' then Exit;
   Name := Trim(GetPart(Line, ' '));
   OpcodeIndex := GetOpcodeFromName(Name);

branches/virt simple/UFormMain.lfm

@@ -150 +150 @@
     Top = 31
     Width = 502
+    Font.Name = 'Liberation Mono'
+    ParentFont = False
     ScrollBars = ssAutoBoth
     TabOrder = 5
@@ -164 +166 @@
     Left = 532
     Height = 25
-    Top = 759
+    Top = 760
     Width = 100
     Caption = 'Compile'
     OnClick = ButtonCompileClick
     TabOrder = 6
+  end
+  object ButtonStart: TButton
+    Left = 664
+    Height = 25
+    Top = 760
+    Width = 100
+    Caption = 'Start'
+    OnClick = ButtonStartClick
+    TabOrder = 7
+  end
+  object ButtonStop: TButton
+    Left = 784
+    Height = 25
+    Top = 760
+    Width = 100
+    Caption = 'Stop'
+    OnClick = ButtonStopClick
+    TabOrder = 8
   end
   object Timer1: TTimer
@@ -176 +196 @@
     top = 205
   end
+  object ActionList1: TActionList
+    left = 1051
+    top = 808
+    object ASave: TAction
+      Caption = 'Save'
+      OnExecute = ASaveExecute
+      ShortCut = 16467
+    end
+  end
 end

branches/virt simple/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
-  ExtCtrls, StdCtrls, fgl, UMachine, UBigInt, UCompiler;
+  ExtCtrls, StdCtrls, ActnList, fgl, UMachine, UBigInt, UCompiler;
 
 type
 
-  { TMachineThread }
-
-  TMachineThread = class(TThread)
-    Machine: TMachine;
-    procedure Execute; override;
-  end;
-
 { TForm1 }
 
   TForm1 = class(TForm)
+    ASave: TAction;
+    ActionList1: TActionList;
     ButtonCompile: TButton;
+    ButtonStart: TButton;
+    ButtonStop: TButton;
     Label1: TLabel;
     Label2: TLabel;
@@ -35 +32 @@
     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);
@@ -46 +46 @@
     procedure Timer1Timer(Sender: TObject);
   private
-    MachineThread: TMachineThread;
     Console: string;
     procedure ReloadMemory;
     procedure DoSystemCall(Index: Integer);
+    procedure UpdateInterface;
   public
     Machine: TMachine;
@@ -65 +65 @@
 {$R *.lfm}
 
-{ TMachineThread }
-
-procedure TMachineThread.Execute;
-begin
-  Machine.Run;
-end;
-
 { TForm1 }
 
@@ -83 +76 @@
 procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 begin
-  Machine.Terminated := True;
-  MachineThread.WaitFor;
-  MemoSource.Lines.SaveToFile(DefaultFileName);
+  Machine.Stop;
+  ASave.Execute;
 end;
 
@@ -94 +86 @@
 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
@@ -104 +113 @@
   MemoSource.Lines.LoadFromFile(DefaultFileName);
   ReloadMemory;
+  UpdateInterface;
   with Machine do begin
     Init(32000, 16);
-    with Instructions do begin
+{    with Instructions do begin
       AddInst(opNoOperation);
       AddInst(opIncrement, ptRegister, False, 0);
@@ -122 +132 @@
       AddInst(opHalt);
     end;
-    MachineThread := TMachineThread.Create(True);
-    MachineThread.Machine := Machine;
-    MachineThread.Start;
+    }
   end;
 end;
@@ -200 +208 @@
 end;
 
+procedure TForm1.UpdateInterface;
+begin
+  ButtonStart.Enabled := not Machine.Running;
+  ButtonStop.Enabled := Machine.Running;
+end;
+
 end.
 

branches/virt simple/UMachine.pas

@@ -63 +63 @@
   TSystemCallEvent = procedure(Index: TValue) of object;
 
+  TMachineThread = class;
+
   { TMachine }
 
@@ -70 +72 @@
     FOnPortOut: TPortOutEvent;
     FOnSystemCall: TSystemCallEvent;
+    FRunning: Boolean;
     InstructionHandlers: array[TOpcode] of TInstructionHandler;
+    Thread: TMachineThread;
     function GetValue(Param: TParam): TValue;
     procedure InstructionAdd;
@@ -103 +107 @@
     procedure Init(MemorySize, RegisterCount: Integer);
     procedure Run;
+    procedure Start;
+    procedure Stop;
     constructor Create;
     destructor Destroy; override;
+    property Running: Boolean read FRunning;
     property OnPortOut: TPortOutEvent read FOnPortOut write FOnPortOut;
     property OnPortIn: TPortInEvent read FOnPortIn write FOnPortIn;
@@ -110 +117 @@
   end;
 
+  { TMachineThread }
+
+  TMachineThread = class(TThread)
+    Machine: TMachine;
+    procedure Execute; override;
+  end;
+
 
 implementation
+
+{ TMachineThread }
+
+procedure TMachineThread.Execute;
+begin
+  Machine.Run;
+end;
 
 
@@ -369 +390 @@
 begin
   while not Terminated do begin
-    with TInstruction(Instructions[IP]) do
-    if Assigned(InstructionHandlers[Opcode]) then
-      InstructionHandlers[Opcode]
-      else raise Exception.Create('Unsupported instruction opcode ' + OpcodeString[Opcode]);
+    if IP < Instructions.Count then begin
+      with TInstruction(Instructions[IP]) do
+      if Assigned(InstructionHandlers[Opcode]) then
+        InstructionHandlers[Opcode]
+        else raise Exception.Create('Unsupported instruction opcode ' + OpcodeString[Opcode]);
+    end else raise Exception.Create('Reached end of program memory');
     Inc(IP);
+  end;
+end;
+
+procedure TMachine.Start;
+begin
+  if not Running then begin
+    Terminated := False;
+    Thread := TMachineThread.Create(True);
+    Thread.Machine := Self;
+    Thread.Start;
+    FRunning := True;
+  end;
+end;
+
+procedure TMachine.Stop;
+begin
+  if Running then begin
+    Terminated := True;
+    Thread.Terminate;
+    Thread.WaitFor;
+    FreeAndNil(Thread);
+    FRunning := False;
   end;
 end;

branches/virt simple/example.vasm

@@ -6 +6 @@
   PUSH -1
   POP [10]
-  JR 0
+  LD R0, 65
+  SYS 0          ; Output character
+  LD R0, 1000
+  SYS 2          ; Delay 1 second
+  JP 0
   LD [R4], [R3]
   HALT