Changeset 215


Ignore:
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.
Location:
branches/virtcpu fixed int
Files:
1 added
6 edited

Legend:

Unmodified
Added
Removed

  • branches/virtcpu fixed int/UFormMain.lfm

    r168 r215  
    11object Form1: TForm1
    22  Left = 385
    3   Height = 762
     3  Height = 914
    44  Top = 208
    5   Width = 1286
     5  Width = 1543
    66  Caption = 'Form1'
    7   ClientHeight = 762
    8   ClientWidth = 1286
    9   DesignTimePPI = 120
     7  ClientHeight = 914
     8  ClientWidth = 1543
     9  DesignTimePPI = 144
    1010  OnCreate = FormCreate
    1111  OnDestroy = FormDestroy
    1212  OnKeyPress = FormKeyPress
    1313  OnShow = FormShow
    14   LCLVersion = '1.8.2.0'
     14  LCLVersion = '2.0.10.0'
    1515  object ListViewMemory: TListView
    16     Left = 515
    17     Height = 687
    18     Top = 40
    19     Width = 733
     16    Left = 618
     17    Height = 824
     18    Top = 48
     19    Width = 880
    2020    Columns = <   
    2121      item
    2222        Caption = 'Address'
    23         Width = 100
     23        Width = 120
    2424      end   
    2525      item
    26         Width = 500
     26        Width = 745
    2727      end>
    2828    Font.Name = 'Liberation Mono'
    … …  
    3434  end
    3535  object ListViewRegisters: TListView
    36     Left = 312
    37     Height = 687
    38     Top = 41
    39     Width = 192
     36    Left = 374
     37    Height = 824
     38    Top = 49
     39    Width = 230
    4040    Columns = <   
    4141      item
    4242        Caption = 'Register'
    43         Width = 80
     43        Width = 96
    4444      end   
    4545      item
    46         Width = 100
     46        Width = 120
    4747      end>
    4848    Font.Name = 'Liberation Mono'
    … …  
    5454  end
    5555  object Memo1: TMemo
    56     Left = 16
    57     Height = 531
    58     Top = 24
    59     Width = 284
     56    Left = 19
     57    Height = 637
     58    Top = 29
     59    Width = 341
    6060    OnKeyPress = Memo1KeyPress
     61    ParentFont = False
    6162    ReadOnly = True
    6263    TabOrder = 2
    6364  end
    64   object Button1: TButton
    65     Left = 206
    66     Height = 31
    67     Top = 568
    68     Width = 94
     65  object ButtonStart: TButton
     66    Left = 248
     67    Height = 37
     68    Top = 682
     69    Width = 113
    6970    Caption = 'Start'
    70     OnClick = Button1Click
     71    OnClick = ButtonStartClick
     72    ParentFont = False
    7173    TabOrder = 3
    7274  end
    73   object Button2: TButton
    74     Left = 88
    75     Height = 31
    76     Top = 568
    77     Width = 94
     75  object ButtonStop: TButton
     76    Left = 106
     77    Height = 37
     78    Top = 682
     79    Width = 113
    7880    Caption = 'Stop'
    79     OnClick = Button2Click
     81    OnClick = ButtonStopClick
     82    ParentFont = False
    8083    TabOrder = 4
    8184  end
    8285  object LabelTicks: TLabel
    83     Left = 16
    84     Height = 20
    85     Top = 612
    86     Width = 35
     86    Left = 19
     87    Height = 24
     88    Top = 734
     89    Width = 48
    8790    Caption = 'Ticks:'
    8891    ParentColor = False
     92    ParentFont = False
    8993  end
    9094  object Timer1: TTimer
    9195    Interval = 500
    9296    OnTimer = Timer1Timer
    93     left = 226
    94     top = 675
     97    Left = 271
     98    Top = 810
    9599  end
    96100end

  • branches/virtcpu fixed int/UFormMain.pas

    r168 r215  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   StdCtrls, ExtCtrls, UMachine, UInstructionWriter;
     9  StdCtrls, ExtCtrls, UCpu, UInstructionWriter, UMachine;
    1010
    1111type
    … …  
    1414
    1515  TForm1 = class(TForm)
    16     Button1: TButton;
    17     Button2: TButton;
     16    ButtonStart: TButton;
     17    ButtonStop: TButton;
    1818    LabelTicks: TLabel;
    1919    ListViewMemory: TListView;
    … …  
    2121    Memo1: TMemo;
    2222    Timer1: TTimer;
    23     procedure Button1Click(Sender: TObject);
    24     procedure Button2Click(Sender: TObject);
     23    procedure ButtonStartClick(Sender: TObject);
     24    procedure ButtonStopClick(Sender: TObject);
    2525    procedure FormCreate(Sender: TObject);
    2626    procedure FormDestroy(Sender: TObject);
    … …  
    3232    procedure Timer1Timer(Sender: TObject);
    3333  private
    34     KeyInputBuffer: array of Char;
    3534    procedure ReloadMemoryDump;
    3635    procedure ReloadRegisterDump;
    37     function CpuInput(Port: T): T;
    38     procedure CpuOutput(Port, Value: T);
     36    procedure SerialOutputExecute(Sender: TObject);
    3937  public
    40     Cpu: TCPU;
     38    Machine: TMachine;
    4139    InstructionWriter: TInstructionWriter;
    4240  end;
    … …  
    8785    Output(0, R1);
    8886    Subtract(R1, R4);
    89     JumpZero(R1, LabelPrint);
     87    TestZero(R1);
     88    JumpCond(LabelPrint);
    9089  LabelPrintBack := IP;
    9190    Increment(R2);
    … …  
    101100procedure TForm1.FormDestroy(Sender: TObject);
    102101begin
    103   InstructionWriter.Free;
    104   Cpu.Free;
     102  FreeAndNil(InstructionWriter);
     103  FreeAndNil(Machine);
    105104end;
    106105
    … …  
    111110procedure TForm1.FormCreate(Sender: TObject);
    112111begin
    113   Cpu := TCPU.Create(nil);
    114   Cpu.OnInput := CpuInput;
    115   Cpu.OnOutput := CpuOutput;
     112  Machine := TMachine.Create(nil);
     113  Machine.OnSerialOutput := SerialOutputExecute;
    116114  InstructionWriter := TInstructionWriter.Create;
    117   InstructionWriter.Cpu := Cpu;
     115  InstructionWriter.Cpu := Machine.Cpu;
    118116end;
    119117
    120 procedure TForm1.Button1Click(Sender: TObject);
     118procedure TForm1.ButtonStartClick(Sender: TObject);
    121119begin
    122   Cpu.Start;
     120  Machine.Cpu.Start;
    123121end;
    124122
    125 procedure TForm1.Button2Click(Sender: TObject);
     123procedure TForm1.ButtonStopClick(Sender: TObject);
    126124begin
    127   Cpu.Stop;
     125  Machine.Cpu.Stop;
    128126end;
    129127
    … …  
    133131  I: Integer;
    134132begin
    135   if Item.Index < Length(Cpu.Memory) div ItemsPerLine then begin
     133  if Item.Index < Length(Machine.Cpu.Memory) div ItemsPerLine then begin
    136134    Line := '';
    137135    for I := 0 to ItemsPerLine - 1 do
    138       Line := Line + IntToHex(Cpu.Memory[Item.Index * ItemsPerLine + I], 2) + ' ';
     136      Line := Line + IntToHex(Machine.Cpu.Memory[Item.Index * ItemsPerLine + I], 2) + ' ';
    139137    Item.Caption := IntToHex(Item.Index * ItemsPerLine, 8);
    140138    Item.SubItems.Add(Line);
    … …  
    144142procedure TForm1.ListViewRegistersData(Sender: TObject; Item: TListItem);
    145143begin
    146   if Item.Index < Length(Cpu.Registers) + 1 then begin
     144  if Item.Index < Length(Machine.Cpu.Registers) + 1 then begin
    147145    if Item.Index = 0 then begin
    148146      Item.Caption := 'IP';
    149       Item.SubItems.Add(IntToHex(Cpu.IP, 8));
     147      Item.SubItems.Add(IntToHex(Machine.Cpu.IP, 8));
    150148    end else begin
    151149      Item.Caption := 'R' + IntToStr(Item.Index - 1);
    152       Item.SubItems.Add(IntToHex(Cpu.Registers[Item.Index - 1], 8));
     150      Item.SubItems.Add(IntToHex(Machine.Cpu.Registers[Item.Index - 1], 8));
    153151    end;
    154152  end;
    … …  
    157155procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: char);
    158156begin
    159   SetLength(KeyInputBuffer, Length(KeyInputBuffer) + 1);
    160   KeyInputBuffer[High(KeyInputBuffer)] := Key;
     157  Machine.SerialInput(Key);
    161158end;
    162159
    … …  
    165162  ReloadMemoryDump;
    166163  ReloadRegisterDump;
    167   LabelTicks.Caption := 'Ticks: ' + IntToStr(Cpu.Ticks);
     164  LabelTicks.Caption := 'Ticks: ' + IntToStr(Machine.Cpu.Ticks);
    168165end;
    169166
    170167procedure TForm1.ReloadMemoryDump;
    171168begin
    172   ListViewMemory.Items.Count := Length(Cpu.Memory) div ItemsPerLine;
     169  ListViewMemory.Items.Count := Length(Machine.Cpu.Memory) div ItemsPerLine;
    173170  ListViewMemory.Refresh;
    174171end;
    … …  
    176173procedure TForm1.ReloadRegisterDump;
    177174begin
    178   ListViewRegisters.Items.Count := Length(Cpu.Registers);
     175  ListViewRegisters.Items.Count := Length(Machine.Cpu.Registers);
    179176  ListViewRegisters.Refresh;
    180177end;
    181178
    182 function TForm1.CpuInput(Port: T): T;
     179procedure TForm1.SerialOutputExecute(Sender: TObject);
     180var
     181  Buffer: string;
    183182begin
    184   Result := 0;
    185   case Port of
    186     0: begin
    187       while (Length(KeyInputBuffer) = 0) and not Cpu.Terminated do begin
    188         Sleep(100);
    189         Application.ProcessMessages;
    190       end;
    191       if Length(KeyInputBuffer) > 0 then begin
    192         Result := Ord(KeyInputBuffer[0]);
    193         if Length(KeyInputBuffer) > 1 then
    194           Move(KeyInputBuffer[1], KeyInputBuffer[0], Length(KeyInputBuffer) - 1);
    195         SetLength(KeyInputBuffer, Length(KeyInputBuffer) - 1);
    196       end else Result := 0;
     183  Machine.SerialBufferLock.Acquire;
     184  try
     185    if Length(Machine.SerialBufferOutput) > 0 then begin
     186      SetLength(Buffer, Length(Machine.SerialBufferOutput));
     187      Move(Machine.SerialBufferOutput[0], Buffer[1], Length(Machine.SerialBufferOutput));
     188      Memo1.Lines.Text := Memo1.Lines.Text + Buffer;
     189      SetLength(Machine.SerialBufferOutput, 0);
    197190    end;
    198   end;
    199 end;
    200 
    201 procedure TForm1.CpuOutput(Port, Value: T);
    202 begin
    203   case Port of
    204     0: Memo1.Lines.Text := Memo1.Lines.Text + Char(Value);
     191  finally
     192    Machine.SerialBufferLock.Release;
    205193  end;
    206194end;

  • branches/virtcpu fixed int/UInstructionWriter.pas

    r168 r215  
    66
    77uses
    8   Classes, SysUtils, UMachine;
     8  Classes, SysUtils, UCpu;
    99
    1010type
    … …  
    2828    procedure Subtract(R1, R2: Integer);
    2929    procedure Jump(Addr: Integer);
    30     procedure JumpNotZero(R1: Integer; Addr: Integer);
    31     procedure JumpZero(R1: Integer; Addr: Integer);
     30    procedure JumpCond(Addr: Integer);
     31    procedure TestZero(R: Integer);
    3232    {$IFDEF EXT_REL_JUMP}procedure JumpRelative(Addr: Integer);{$ENDIF}
     33    procedure SysCall;
    3334    procedure Increment(R: Integer);
    3435    procedure Decrement(R: Integer);
    … …  
    112113end;
    113114
    114 procedure TInstructionWriter.JumpNotZero(R1: Integer; Addr: Integer);
     115procedure TInstructionWriter.JumpCond(Addr: Integer);
    115116begin
    116   Write(T(opJumpNotZero));
    117   Write(R1);
     117  Write(T(opJumpCond));
    118118  Write(Addr);
    119119end;
    120120
    121 procedure TInstructionWriter.JumpZero(R1: Integer; Addr: Integer);
     121procedure TInstructionWriter.TestZero(R: Integer);
    122122begin
    123   Write(T(opJumpZero));
    124   Write(R1);
    125   Write(Addr);
     123  Write(T(opTestZero));
     124  Write(R);
     125end;
     126
     127procedure TInstructionWriter.SysCall;
     128begin
     129  Write(T(opSysCall));
    126130end;
    127131

  • branches/virtcpu fixed int/UMachine.pas

    r168 r215  
    11unit UMachine;
    22
    3 {$DEFINE EXT_MEMORY}
    4 {$DEFINE EXT_IO}
    5 {$DEFINE EXT_ARITHMETIC}
    6 {$DEFINE EXT_CONDITIONAL}
    7 {$DEFINE EXT_LOGICAL}
    8 {$DEFINE EXT_STACK}
    9 {$DEFINE EXT_SUBROUTINE}
    10 {$DEFINE EXT_ROTATION}
    11 {$DEFINE EXT_MULTIPLICATION}
    12 {$DEFINE EXT_SHIFT}
    13 {$DEFINE EXT_BLOCK}
    14 {$DEFINE EXT_GENERAL}
    15 {$DEFINE EXT_BIT}
    16 {$DEFINE EXT_REL_JUMP}
    17 
    18 // Extension dependencies
    19 {$IFDEF EXT_SUBROUTINE}
    20 {$DEFINE EXT_STACK}
    21 {$ENDIF}
    22 {$IFDEF EXT_MULTIPLICATION}
    23 {$DEFINE EXT_ARITHMETIC}
    24 {$ENDIF}
    25 
    26 
    27 {$mode delphi}{$H+}
     3{$mode delphi}
    284
    295interface
    306
    317uses
    32   Classes, SysUtils;
     8  Classes, SysUtils, UCpu, syncobjs;
    339
    3410type
    35   T = Integer;
     11  { TMachine }
    3612
    37   TOpcode = (opNop, opLoad, opLoadConst, opNeg,
    38     opJump, {$IFDEF EXT_REL_JUMP}opJumpRel,{$ENDIF}
    39     opInc, opDec,
    40     {$IFDEF EXT_MEMORY}opLoadMem, opStoreMem,{$ENDIF}
    41     {$IFDEF EXT_ARITHMETIC}opAdd, opSub,{$ENDIF}
    42     {$IFDEF EXT_IO}opInput, opOutput,{$ENDIF}
    43     {$IFDEF EXT_SUBROUTINE}opCall,
    44     {$IFDEF EXT_REL_JUMP}opCallRel,{$ENDIF}
    45     opRet,{$ENDIF}
    46     {$IFDEF EXT_GENERAL}opExchg,{$ENDIF}
    47     {$IFDEF EXT_LOGICAL}opAnd, opOr, opXor,{$ENDIF}
    48     {$IFDEF EXT_SHIFT}opShl, opShr,{$ENDIF}
    49     {$IFDEF EXT_ROTATION}opRor, opRol,{$ENDIF}
    50     {$IFDEF EXT_STACK}opPush, opPop,{$ENDIF}
    51     {$IFDEF EXT_CONDITIONAL}
    52     {$IFDEF EXT_REL_JUMP}opJumpRelZero, opJumpRelNotZero,{$ENDIF}
    53     opJumpZero, opJumpNotZero, opTestEqual, opTestNotEqual, opTestLess,
    54     opTestLessEqual, opTestGreater, opTestGreaterEqual,
    55     {$ENDIF}
    56     {$IFDEF EXT_MULTIPLICATION}
    57     opMul, opDiv,
    58     {$ENDIF}
    59     opHalt
    60   );
    61 
    62   TOpcodeHandler = procedure of object;
    63   TInputEvent = function (Port: T): T of object;
    64   TOutputEvent = procedure (Port, Value: T) of object;
    65 
    66   { TCPU }
    67 
    68   TCPU = class(TComponent)
     13  TMachine = class(TComponent)
    6914  private
    70     FOnInput: TInputEvent;
    71     FOnOutput: TOutputEvent;
    72     OpcodeHandlers: array[TOpcode] of TOpcodeHandler;
    73     function ReadNext: T; inline;
    74     procedure OpcodeNop;
    75     procedure OpcodeHalt;
    76     procedure OpcodeLoad;
    77     procedure OpcodeLoadConst;
    78     procedure OpcodeJump;
    79     {$IFDEF EXT_REL_JUMP}
    80     procedure OpcodeJumpRel;
    81     {$ENDIF}
    82     procedure OpcodeNeg;
    83     procedure OpcodeInc;
    84     procedure OpcodeDec;
    85     {$IFDEF EXT_MEMORY}
    86     procedure OpcodeLoadMem;
    87     procedure OpcodeStoreMem;
    88     {$ENDIF}
    89     {$IFDEF EXT_GENERAL}
    90     procedure OpcodeExchange;
    91     {$ENDIF}
    92     {$IFDEF EXT_CONDITIONAL}
    93     procedure OpcodeTestEqual;
    94     procedure OpcodeTestNotEqual;
    95     procedure OpcodeTestGreatEqual;
    96     procedure OpcodeTestGreat;
    97     procedure OpcodeTestLessEqual;
    98     procedure OpcodeTestLess;
    99     procedure OpcodeJumpCondNotZero;
    100     procedure OpcodeJumpCondZero;
    101     {$IFDEF EXT_REL_JUMP}
    102     procedure OpcodeJumpRelCondNotZero;
    103     procedure OpcodeJumpRelCondZero;
    104     {$ENDIF}
    105     {$ENDIF}
    106     {$IFDEF EXT_SHIFT}
    107     procedure OpcodeShl;
    108     procedure OpcodeShr;
    109     {$ENDIF}
    110     {$IFDEF EXT_ROTATION}
    111     procedure OpcodeRor;
    112     procedure OpcodeRol;
    113     {$ENDIF}
    114     {$IFDEF EXT_LOGICAL}
    115     procedure OpcodeAnd;
    116     procedure OpcodeOr;
    117     procedure OpcodeXor;
    118     {$ENDIF}
    119     {$IFDEF EXT_STACK}
    120     procedure OpcodePush;
    121     procedure OpcodePop;
    122     {$ENDIF}
    123     {$IFDEF EXT_SUBROUTINE}
    124     procedure OpcodeCall;
    125     procedure OpcodeReturn;
    126     {$IFDEF EXT_REL_JUMP}
    127     procedure OpcodeCallRel;
    128     {$ENDIF}
    129     {$ENDIF}
    130     {$IFDEF EXT_IO}
    131     procedure OpcodeOutput;
    132     procedure OpcodeInput;
    133     {$ENDIF}
    134     {$IFDEF EXT_ARITHMETIC}
    135     procedure OpcodeAdd;
    136     procedure OpcodeSub;
    137     {$ENDIF}
    138     {$IFDEF EXT_MULTIPLICATION}
    139     procedure OpcodeMul;
    140     procedure OpcodeDiv;
    141     {$ENDIF}
     15    FOnSerialOutput: TNotifyEvent;
     16    function CpuInput(Port: T): T;
     17    procedure CpuOutput(Port, Value: T);
     18    procedure DoSerialOutput;
    14219  public
    143     Registers: array of T;
    144     IP: T;
    145     {$IFDEF EXT_STACK}
    146     SP: T;
    147     {$ENDIF}
    14820    Memory: array of T;
    149     Terminated: Boolean;
    150     Ticks: Integer;
    151     procedure Start;
    152     procedure Stop;
     21    Cpu: TCpu;
     22    VideoBase: T;
     23    VideoWidth: T;
     24    VideoHeight: T;
     25    SerialBufferInput: array of Char;
     26    SerialBufferOutput: array of Char;
     27    SerialBufferLock: TCriticalSection;
    15328    constructor Create(AOwner: TComponent); override;
    154   published
    155     property OnInput: TInputEvent read FOnInput write FOnInput;
    156     property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
     29    destructor Destroy; override;
     30    procedure SerialInput(C: Char);
     31    property OnSerialOutput: TNotifyEvent read FOnSerialOutput write FOnSerialOutput;
    15732  end;
    158 
    15933
    16034implementation
    16135
    162 { TCPU }
     36{ TMachine }
    16337
    164 function TCPU.ReadNext: T;
     38constructor TMachine.Create(AOwner: TComponent);
    16539begin
    166   Result := Memory[IP];
    167   Inc(IP);
     40  inherited;
     41  SerialBufferLock := TCriticalSection.Create;
     42  Cpu := TCpu.Create(nil);
     43  Cpu.OnInput := CpuInput;
     44  Cpu.OnOutput := CpuOutput;
    16845end;
    16946
    170 procedure TCPU.OpcodeHalt;
     47destructor TMachine.Destroy;
    17148begin
    172   Terminated := True;
     49  Cpu.Stop;
     50  FreeAndNil(Cpu);
     51  FreeAndNil(SerialBufferLock);
     52  inherited;
    17353end;
    17454
    175 procedure TCPU.OpcodeNop;
     55procedure TMachine.SerialInput(C: Char);
    17656begin
    177   // Do nothing
    178 end;
    179 
    180 procedure TCPU.OpcodeLoad;
    181 var
    182   P1: T;
    183   P2: T;
    184 begin
    185   P1 := ReadNext;
    186   P2 := ReadNext;
    187   Registers[P1] := Registers[P2];
    188 end;
    189 
    190 procedure TCPU.OpcodeLoadConst;
    191 var
    192   P1: T;
    193   P2: T;
    194 begin
    195   P1 := ReadNext;
    196   P2 := ReadNext;
    197   Registers[P1] := P2;
    198 end;
    199 
    200 {$IFDEF EXT_MEMORY}
    201 procedure TCPU.OpcodeLoadMem;
    202 var
    203   P1: T;
    204   P2: T;
    205 begin
    206   P1 := ReadNext;
    207   P2 := ReadNext;
    208   Registers[P1] := Memory[Registers[P2]];
    209 end;
    210 
    211 procedure TCPU.OpcodeStoreMem;
    212 var
    213   P1: T;
    214   P2: T;
    215 begin
    216   P1 := ReadNext;
    217   P2 := ReadNext;
    218   Memory[Registers[P1]] := Registers[P2];
    219 end;
    220 {$ENDIF}
    221 
    222 procedure TCPU.OpcodeNeg;
    223 var
    224   P1: T;
    225 begin
    226   P1 := ReadNext;
    227   Registers[P1] := -Registers[P1];
    228 end;
    229 
    230 {$IFDEF EXT_GENERAL}
    231 procedure TCPU.OpcodeExchange;
    232 var
    233   P1, P2, Temp: T;
    234 begin
    235   P1 := ReadNext;
    236   P2 := ReadNext;
    237   Temp := Registers[P1];
    238   Registers[P1] := Registers[P2];
    239   Registers[P2] := Temp;
    240 end;
    241 {$ENDIF}
    242 
    243 procedure TCPU.OpcodeJump;
    244 begin
    245   IP := ReadNext;
    246 end;
    247 
    248 {$IFDEF EXT_REL_JUMP}
    249 procedure TCPU.OpcodeJumpRel;
    250 begin
    251   IP := IP + ReadNext;
    252 end;
    253 {$ENDIF}
    254 
    255 {$IFDEF EXT_CONDITIONAL}
    256 procedure TCPU.OpcodeTestEqual;
    257 var
    258   P1, P2: T;
    259 begin
    260   P1 := ReadNext;
    261   P2 := ReadNext;
    262   if Registers[P1] = Registers[P2] then Registers[P1] := 1
    263     else Registers[P1] := 0;
    264 end;
    265 
    266 procedure TCPU.OpcodeTestNotEqual;
    267 var
    268   P1, P2: T;
    269 begin
    270   P1 := ReadNext;
    271   P2 := ReadNext;
    272   if Registers[P1] <> Registers[P2] then Registers[P1] := 1
    273     else Registers[P1] := 0;
    274 end;
    275 
    276 procedure TCPU.OpcodeTestGreatEqual;
    277 var
    278   P1, P2: T;
    279 begin
    280   P1 := ReadNext;
    281   P2 := ReadNext;
    282   if Registers[P1] >= Registers[P2] then Registers[P1] := 1
    283     else Registers[P1] := 0;
    284 end;
    285 
    286 procedure TCPU.OpcodeTestGreat;
    287 var
    288   P1, P2: T;
    289 begin
    290   P1 := ReadNext;
    291   P2 := ReadNext;
    292   if Registers[P1] > Registers[P2] then Registers[P1] := 1
    293     else Registers[P1] := 0;
    294 end;
    295 
    296 procedure TCPU.OpcodeTestLessEqual;
    297 var
    298   P1, P2: T;
    299 begin
    300   P1 := ReadNext;
    301   P2 := ReadNext;
    302   if Registers[P1] <= Registers[P2] then Registers[P1] := 1
    303     else Registers[P1] := 0;
    304 end;
    305 
    306 procedure TCPU.OpcodeTestLess;
    307 var
    308   P1, P2: T;
    309 begin
    310   P1 := ReadNext;
    311   P2 := ReadNext;
    312   if Registers[P1] < Registers[P2] then Registers[P1] := 1
    313     else Registers[P1] := 0;
    314 end;
    315 
    316 procedure TCPU.OpcodeJumpCondNotZero;
    317 var
    318   P1, P2: T;
    319 begin
    320   P1 := ReadNext;
    321   P2 := ReadNext;
    322   if Registers[P1] <> 0 then IP := P2;
    323 end;
    324 
    325 procedure TCPU.OpcodeJumpCondZero;
    326 var
    327   P1, P2: T;
    328 begin
    329   P1 := ReadNext;
    330   P2 := ReadNext;
    331   if Registers[P1] = 0 then IP := P2;
    332 end;
    333 
    334 {$IFDEF EXT_REL_JUMP}
    335 procedure TCPU.OpcodeJumpRelCondZero;
    336 var
    337   P1, P2: T;
    338 begin
    339   P1 := ReadNext;
    340   P2 := ReadNext;
    341   if P1 = 0 then IP := IP + P2;
    342 end;
    343 
    344 procedure TCPU.OpcodeJumpRelCondNotZero;
    345 var
    346   P1, P2: T;
    347 begin
    348   P1 := ReadNext;
    349   P2 := ReadNext;
    350   if P1 <> 0 then IP := IP + P2;
    351 end;
    352 {$ENDIF}
    353 {$ENDIF}
    354 
    355 {$IFDEF EXT_ROTATION}
    356 procedure TCPU.OpcodeRor;
    357 var
    358   P1, P2: T;
    359 begin
    360   P1 := ReadNext;
    361   P2 := ReadNext;
    362   Registers[P1] := (Registers[P1] shr Registers[P2]) or
    363     ((Registers[P1] and ((1 shl Registers[P2]) - 1)) shl (SizeOf(T) * 8 - Registers[P2]));
    364 end;
    365 
    366 procedure TCPU.OpcodeRol;
    367 var
    368   P1, P2: T;
    369 begin
    370   P1 := ReadNext;
    371   P2 := ReadNext;
    372   Registers[P1] := (Registers[P1] shl Registers[P2]) or
    373     ((Registers[P1] shr (SizeOf(T) * 8 - Registers[P2])) and ((1 shl Registers[P2]) - 1));
    374 end;
    375 {$ENDIF}
    376 
    377 {$IFDEF EXT_SHIFT}
    378 procedure TCPU.OpcodeShl;
    379 var
    380   P1, P2: T;
    381 begin
    382   P1 := ReadNext;
    383   P2 := ReadNext;
    384   Registers[P1] := Registers[P1] shl Registers[P2];
    385 end;
    386 
    387 procedure TCPU.OpcodeShr;
    388 var
    389   P1, P2: T;
    390 begin
    391   P1 := ReadNext;
    392   P2 := ReadNext;
    393   Registers[P1] := Registers[P1] shr Registers[P2];
    394 end;
    395 {$ENDIF}
    396 
    397 {$IFDEF EXT_LOGICAL}
    398 procedure TCPU.OpcodeAnd;
    399 var
    400   P1, P2: T;
    401 begin
    402   P1 := ReadNext;
    403   P2 := ReadNext;
    404   Registers[P1] := Registers[P1] and Registers[P2];
    405 end;
    406 
    407 procedure TCPU.OpcodeOr;
    408 var
    409   P1, P2: T;
    410 begin
    411   P1 := ReadNext;
    412   P2 := ReadNext;
    413   Registers[P1] := Registers[P1] or Registers[P2];
    414 end;
    415 
    416 procedure TCPU.OpcodeXor;
    417 var
    418   P1, P2: T;
    419 begin
    420   P1 := ReadNext;
    421   P2 := ReadNext;
    422   Registers[P1] := Registers[P1] xor Registers[P2];
    423 end;
    424 {$ENDIF}
    425 
    426 {$IFDEF EXT_STACK}
    427 procedure TCPU.OpcodePush;
    428 begin
    429   Memory[SP] := Registers[ReadNext];
    430   Dec(SP);
    431 end;
    432 
    433 procedure TCPU.OpcodePop;
    434 begin
    435   Inc(SP);
    436   Registers[ReadNext] := Memory[SP];
    437 end;
    438 {$ENDIF}
    439 
    440 {$IFDEF EXT_SUBROUTINE}
    441 procedure TCPU.OpcodeCall;
    442 var
    443   Addr: T;
    444 begin
    445   Addr := ReadNext;
    446   Memory[SP] := IP;
    447   Dec(SP);
    448   IP := Addr;
    449 end;
    450 
    451 {$IFDEF EXT_REL_JUMP}
    452 procedure TCPU.OpcodeCallRel;
    453 var
    454   Addr: T;
    455 begin
    456   Addr := ReadNext;
    457   Memory[SP] := IP;
    458   Dec(SP);
    459   IP := IP + Addr;
    460 end;
    461 {$ENDIF}
    462 
    463 procedure TCPU.OpcodeReturn;
    464 begin
    465   Inc(SP);
    466   IP := Memory[SP];
    467 end;
    468 {$ENDIF}
    469 
    470 {$IFDEF EXT_IO}
    471 procedure TCPU.OpcodeOutput;
    472 var
    473   R1: T;
    474   R2: T;
    475 begin
    476   R1 := ReadNext;
    477   R2 := ReadNext;
    478   if Assigned(FOnOutput) then
    479     FOnOutput(Registers[R1], Registers[R2]);
    480 end;
    481 
    482 procedure TCPU.OpcodeInput;
    483 var
    484   R1: T;
    485   R2: T;
    486 begin
    487   R1 := ReadNext;
    488   R2 := ReadNext;
    489   if Assigned(FOnInput) then
    490     Registers[R1] := FOnInput(Registers[R2]);
    491 end;
    492 {$ENDIF}
    493 
    494 procedure TCPU.OpcodeInc;
    495 var
    496   R: T;
    497 begin
    498   R := ReadNext;
    499   Registers[R] := Registers[R] + 1;
    500 end;
    501 
    502 procedure TCPU.OpcodeDec;
    503 var
    504   R: T;
    505 begin
    506   R := ReadNext;
    507   Registers[R] := Registers[R] - 1;
    508 end;
    509 
    510 {$IFDEF EXT_ARITHMETIC}
    511 procedure TCPU.OpcodeAdd;
    512 var
    513   R1: T;
    514   R2: T;
    515 begin
    516   R1 := ReadNext;
    517   R2 := ReadNext;
    518   Registers[R1] := Registers[R1] + Registers[R2];
    519 end;
    520 
    521 procedure TCPU.OpcodeSub;
    522 var
    523   R1: T;
    524   R2: T;
    525 begin
    526   R1 := ReadNext;
    527   R2 := ReadNext;
    528   Registers[R1] := Registers[R1] - Registers[R2];
    529 end;
    530 {$ENDIF}
    531 
    532 {$IFDEF EXT_MULTIPLICATION}
    533 procedure TCPU.OpcodeMul;
    534 var
    535   R1: T;
    536   R2: T;
    537 begin
    538   R1 := ReadNext;
    539   R2 := ReadNext;
    540   Registers[R1] := Registers[R1] * Registers[R2];
    541 end;
    542 
    543 procedure TCPU.OpcodeDiv;
    544 var
    545   R1: T;
    546   R2: T;
    547 begin
    548   R1 := ReadNext;
    549   R2 := ReadNext;
    550   Registers[R1] := Registers[R1] div Registers[R2];
    551 end;
    552 {$ENDIF}
    553 
    554 procedure TCPU.Start;
    555 var
    556   Opcode: T;
    557 begin
    558   Terminated := False;
    559   IP := 0;
    560   Ticks := 0;
    561   {$IFDEF EXT_STACK}
    562   SP := Length(Memory);
    563   {$ENDIF}
    564   while not Terminated do begin
    565     Opcode := ReadNext;
    566     if (Opcode >= 0) and (Opcode <= T(High(TOpcode))) then
    567       OpcodeHandlers[TOpcode(Opcode)]
    568       else raise Exception.Create(Format('Unsupported instruction %d', [Opcode]));
    569     Inc(Ticks);
     57  SerialBufferLock.Acquire;
     58  try
     59    SetLength(SerialBufferInput, Length(SerialBufferInput) + 1);
     60    SerialBufferInput[High(SerialBufferInput)] := C;
     61  finally
     62    SerialBufferLock.Release;
    57063  end;
    57164end;
    57265
    573 procedure TCPU.Stop;
     66function TMachine.CpuInput(Port: T): T;
    57467begin
    575   Terminated := True;
     68  Result := 0;
     69  case Port of
     70    0: begin
     71      SerialBufferLock.Acquire;
     72      try
     73        while (Length(SerialBufferInput) = 0) and not Cpu.Terminated do begin
     74          try
     75            SerialBufferLock.Release;
     76            Sleep(10);
     77          finally
     78            SerialBufferLock.Acquire;
     79          end;
     80        end;
     81          if Length(SerialBufferInput) > 0 then begin
     82          Result := Ord(SerialBufferInput[0]);
     83          if Length(SerialBufferInput) > 1 then
     84            Move(SerialBufferInput[1], SerialBufferInput[0], Length(SerialBufferInput) - 1);
     85          SetLength(SerialBufferInput, Length(SerialBufferInput) - 1);
     86        end else Result := 0;
     87      finally
     88        SerialBufferLock.Release;
     89      end;
     90    end;
     91    1: begin
     92      Result := Length(SerialBufferInput);
     93    end;
     94  end;
    57695end;
    57796
    578 constructor TCPU.Create(AOwner: TComponent);
     97procedure TMachine.CpuOutput(Port, Value: T);
    57998begin
    580   inherited;
    581   SetLength(Registers, 16);
    582   SetLength(Memory, 1024);
    583   OpcodeHandlers[opNop] := OpcodeNop;
    584   OpcodeHandlers[opLoad] := OpcodeLoad;
    585   OpcodeHandlers[opHalt] := OpcodeHalt;
    586   OpcodeHandlers[opLoadConst] := OpcodeLoadConst;
    587   OpcodeHandlers[opNeg] := OpcodeNeg;
    588   OpcodeHandlers[opJump] := OpcodeJump;
    589   OpcodeHandlers[opInc] := OpcodeInc;
    590   OpcodeHandlers[opDec] := OpcodeDec;
    591   {$IFDEF EXT_REL_JUMP}
    592   OpcodeHandlers[opJumpRel] := OpcodeJumpRel;
    593   {$ENDIF}
    594   {$IFDEF EXT_MEMORY}
    595   OpcodeHandlers[opLoadMem] := OpcodeLoadMem;
    596   OpcodeHandlers[opStoreMem] := OpcodeStoreMem;
    597   {$ENDIF}
    598   {$IFDEF EXT_GENERAL}
    599   OpcodeHandlers[opExchg] := OpcodeExchange;
    600   {$ENDIF}
    601   {$IFDEF EXT_LOGICAL}
    602   OpcodeHandlers[opAnd] := OpcodeAnd;
    603   OpcodeHandlers[opOr] := OpcodeOr;
    604   OpcodeHandlers[opXor] := OpcodeXor;
    605   {$ENDIF}
    606   {$IFDEF EXT_SHIFT}
    607   OpcodeHandlers[opShl] := OpcodeShl;
    608   OpcodeHandlers[opShr] := OpcodeShr;
    609   {$ENDIF}
    610   {$IFDEF EXT_STACK}
    611   OpcodeHandlers[opPush] := OpcodePush;
    612   OpcodeHandlers[opPop] := OpcodePop;
    613   {$ENDIF}
    614   {$IFDEF EXT_SUBROUTINE}
    615   OpcodeHandlers[opCall] := OpcodeCall;
    616   {$IFDEF EXT_REL_JUMP}
    617   OpcodeHandlers[opCallRel] := OpcodeCallRel;
    618   {$ENDIF}
    619   OpcodeHandlers[opRet] := OpcodeReturn;
    620   {$ENDIF}
    621   {$IFDEF EXT_ROTATION}
    622   OpcodeHandlers[opRor] := OpcodeRor;
    623   OpcodeHandlers[opRol] := OpcodeRol;
    624   {$ENDIF}
    625   {$IFDEF EXT_IO}
    626   OpcodeHandlers[opInput] := OpcodeInput;
    627   OpcodeHandlers[opOutput] := OpcodeOutput;
    628   {$ENDIF}
    629   {$IFDEF EXT_ARITHMETIC}
    630   OpcodeHandlers[opAdd] := OpcodeAdd;
    631   OpcodeHandlers[opSub] := OpcodeSub;
    632   {$ENDIF}
    633   {$IFDEF EXT_CONDITIONAL}
    634   OpcodeHandlers[opJumpZero] := OpcodeJumpCondZero;
    635   OpcodeHandlers[opJumpNotZero] := OpcodeJumpCondNotZero;
    636   {$IFDEF EXT_REL_JUMP}
    637   OpcodeHandlers[opJumpRelZero] := OpcodeJumpRelCondZero;
    638   OpcodeHandlers[opJumpRelNotZero] := OpcodeJumpRelCondNotZero;
    639   {$ENDIF}
    640   OpcodeHandlers[opTestEqual] := OpcodeTestEqual;
    641   OpcodeHandlers[opTestNotEqual] := OpcodeTestNotEqual;
    642   OpcodeHandlers[opTestLess] := OpcodeTestLess;
    643   OpcodeHandlers[opTestLessEqual] := OpcodeTestLessEqual;
    644   OpcodeHandlers[opTestGreater] := OpcodeTestGreat;
    645   OpcodeHandlers[opTestGreaterEqual] := OpcodeTestGreatEqual;
    646   {$ENDIF}
    647   {$IFDEF EXT_MULTIPLICATION}
    648   OpcodeHandlers[opMul] := OpcodeMul;
    649   OpcodeHandlers[opDiv] := OpcodeDiv;
    650   {$ENDIF}
     99  case Port of
     100    0: begin
     101      SerialBufferLock.Acquire;
     102      try
     103        SetLength(SerialBufferOutput, Length(SerialBufferOutput) + 1);
     104        SerialBufferOutput[High(SerialBufferOutput)] := Chr(Value);
     105      finally
     106        SerialBufferLock.Release;
     107      end;
     108      TThread.Synchronize(Cpu.Thread, DoSerialOutput);
     109    end;
     110  end;
     111end;
     112
     113procedure TMachine.DoSerialOutput;
     114begin
     115  if Assigned(FOnSerialOutput) then
     116    FOnSerialOutput(Self);
    651117end;
    652118

  • branches/virtcpu fixed int/virtcpu.lpi

    r166 r215  
    22<CONFIG>
    33  <ProjectOptions>
    4     <Version Value="10"/>
     4    <Version Value="11"/>
    55    <PathDelim Value="\"/>
    66    <General>
    … …  
    4747            </Options>
    4848          </Linking>
     49          <Other>
     50            <CustomOptions Value="-dUseCThreads"/>
     51          </Other>
    4952        </CompilerOptions>
    5053      </Item2>
    … …  
    5457    </PublishOptions>
    5558    <RunParams>
    56       <local>
    57         <FormatVersion Value="1"/>
    58       </local>
     59      <FormatVersion Value="2"/>
     60      <Modes Count="1">
     61        <Mode0 Name="default"/>
     62      </Modes>
    5963    </RunParams>
    6064    <RequiredPackages Count="1">
    … …  
    6367      </Item1>
    6468    </RequiredPackages>
    65     <Units Count="4">
     69    <Units Count="5">
    6670      <Unit0>
    6771        <Filename Value="virtcpu.lpr"/>
    … …  
    7680      </Unit1>
    7781      <Unit2>
    78         <Filename Value="UMachine.pas"/>
     82        <Filename Value="UCpu.pas"/>
    7983        <IsPartOfProject Value="True"/>
    8084      </Unit2>
    … …  
    8387        <IsPartOfProject Value="True"/>
    8488      </Unit3>
     89      <Unit4>
     90        <Filename Value="UMachine.pas"/>
     91        <IsPartOfProject Value="True"/>
     92      </Unit4>
    8593    </Units>
    8694  </ProjectOptions>
    … …  
    125133      </Options>
    126134    </Linking>
     135    <Other>
     136      <CustomOptions Value="-dUseCThreads"/>
     137    </Other>
    127138  </CompilerOptions>
    128139  <Debugging>

  • branches/virtcpu fixed int/virtcpu.lpr

    r163 r215  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain, UMachine, UInstructionWriter
     10  Forms, UFormMain, UCpu, UInstructionWriter, UMachine
    1111  { you can add units after this };
    1212
Note: See TracChangeset for help on using the changeset viewer.