Ignore:
Timestamp:
Sep 22, 2019, 9:31:49 PM (5 years ago)
Author:
chronos
Message:
  • Modified: All parts of virtual machine have own form in Forms subdirectory.
  • Modified: Main form moved to Forms subdirectory.
  • Modified: TCpu class moved to UCpu unit.
  • Added: Assembler and dissasembler forms.
Location:
branches/virtcpu varint
Files:
17 added
5 edited
2 moved

Legend:

Unmodified
Added
Removed

  • branches/virtcpu varint/Forms/UFormMain.lfm

    r196 r197  
    1010  OnCreate = FormCreate
    1111  OnDestroy = FormDestroy
    12   OnKeyPress = FormKeyPress
    1312  OnShow = FormShow
    1413  LCLVersion = '2.0.2.0'
    15   object ListViewMemory: TListView
    16     Left = 618
    17     Height = 824
    18     Top = 48
    19     Width = 880
    20     Columns = <   
    21       item
    22         Caption = 'Address'
    23         Width = 120
    24       end   
    25       item
    26         Width = 745
    27       end>
    28     Font.Name = 'Liberation Mono'
    29     OwnerData = True
    30     ParentFont = False
    31     TabOrder = 0
    32     ViewStyle = vsReport
    33     OnData = ListViewMemoryData
    34   end
    35   object ListViewRegisters: TListView
    36     Left = 374
    37     Height = 824
    38     Top = 49
    39     Width = 230
    40     Columns = <   
    41       item
    42         Caption = 'Register'
    43         Width = 96
    44       end   
    45       item
    46         Width = 120
    47       end>
    48     Font.Name = 'Liberation Mono'
    49     OwnerData = True
    50     ParentFont = False
    51     TabOrder = 1
    52     ViewStyle = vsReport
    53     OnData = ListViewRegistersData
    54   end
    55   object Memo1: TMemo
    56     Left = 19
    57     Height = 637
    58     Top = 29
    59     Width = 341
    60     OnKeyPress = Memo1KeyPress
    61     ParentFont = False
    62     ReadOnly = True
    63     TabOrder = 2
    64   end
    65   object Button1: TButton
     14  object ButtonStart: TButton
    6615    Left = 247
    6716    Height = 37
    … …  
    6918    Width = 113
    7019    Caption = 'Start'
    71     OnClick = Button1Click
     20    OnClick = ButtonStartClick
    7221    ParentFont = False
    73     TabOrder = 3
     22    TabOrder = 0
    7423  end
    75   object Button2: TButton
     24  object ButtonStop: TButton
    7625    Left = 106
    7726    Height = 37
    … …  
    7928    Width = 113
    8029    Caption = 'Stop'
    81     OnClick = Button2Click
     30    OnClick = ButtonStopClick
    8231    ParentFont = False
     32    TabOrder = 1
     33  end
     34  object ButtonConsole: TButton
     35    Left = 44
     36    Height = 38
     37    Top = 37
     38    Width = 113
     39    Caption = 'Console'
     40    OnClick = ButtonConsoleClick
     41    TabOrder = 2
     42  end
     43  object ButtonMemory: TButton
     44    Left = 46
     45    Height = 38
     46    Top = 86
     47    Width = 113
     48    Caption = 'Memory'
     49    OnClick = ButtonMemoryClick
     50    TabOrder = 3
     51  end
     52  object ButtonScreen: TButton
     53    Left = 47
     54    Height = 38
     55    Top = 139
     56    Width = 113
     57    Caption = 'Screen'
     58    OnClick = ButtonScreenClick
    8359    TabOrder = 4
    8460  end
    85   object LabelTicks: TLabel
    86     Left = 19
    87     Height = 26
    88     Top = 734
    89     Width = 48
    90     Caption = 'Ticks:'
    91     ParentColor = False
    92     ParentFont = False
     61  object ButtonCpuState: TButton
     62    Left = 44
     63    Height = 38
     64    Top = 192
     65    Width = 113
     66    Caption = 'CPU state'
     67    OnClick = ButtonCpuStateClick
     68    TabOrder = 5
     69  end
     70  object ButtonAssembler: TButton
     71    Left = 358
     72    Height = 38
     73    Top = 48
     74    Width = 169
     75    Caption = 'Assembler'
     76    OnClick = ButtonAssemblerClick
     77    TabOrder = 6
     78  end
     79  object ButtonDisassembler: TButton
     80    Left = 358
     81    Height = 38
     82    Top = 104
     83    Width = 170
     84    Caption = 'Disassembler'
     85    OnClick = ButtonDisassemblerClick
     86    TabOrder = 7
    9387  end
    9488  object Timer1: TTimer
    9589    Interval = 500
    96     OnTimer = Timer1Timer
    9790    left = 271
    9891    top = 810

  • branches/virtcpu varint/Forms/UFormMain.pas

    r196 r197  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   StdCtrls, ExtCtrls, UMachine, UInstructionWriter;
     9  StdCtrls, ExtCtrls, UMachine, UInstructionWriter, UCpu;
    1010
    1111type
    … …  
    1414
    1515  TFormMain = class(TForm)
    16     Button1: TButton;
    17     Button2: TButton;
    18     LabelTicks: TLabel;
    19     ListViewMemory: TListView;
    20     ListViewRegisters: TListView;
    21     Memo1: TMemo;
     16    ButtonStart: TButton;
     17    ButtonStop: TButton;
     18    ButtonAssembler: TButton;
     19    ButtonDisassembler: TButton;
     20    ButtonCpuState: TButton;
     21    ButtonScreen: TButton;
     22    ButtonMemory: TButton;
     23    ButtonConsole: TButton;
    2224    Timer1: TTimer;
    23     procedure Button1Click(Sender: TObject);
    24     procedure Button2Click(Sender: TObject);
     25    procedure ButtonStartClick(Sender: TObject);
     26    procedure ButtonStopClick(Sender: TObject);
     27    procedure ButtonAssemblerClick(Sender: TObject);
     28    procedure ButtonConsoleClick(Sender: TObject);
     29    procedure ButtonCpuStateClick(Sender: TObject);
     30    procedure ButtonDisassemblerClick(Sender: TObject);
     31    procedure ButtonMemoryClick(Sender: TObject);
     32    procedure ButtonScreenClick(Sender: TObject);
    2533    procedure FormCreate(Sender: TObject);
    2634    procedure FormDestroy(Sender: TObject);
    27     procedure FormKeyPress(Sender: TObject; var Key: char);
    2835    procedure FormShow(Sender: TObject);
    29     procedure ListViewMemoryData(Sender: TObject; Item: TListItem);
    30     procedure ListViewRegistersData(Sender: TObject; Item: TListItem);
    31     procedure Memo1KeyPress(Sender: TObject; var Key: char);
    32     procedure Timer1Timer(Sender: TObject);
    3336  private
    34     KeyInputBuffer: array of Char;
    35     procedure ReloadMemoryDump;
    36     procedure ReloadRegisterDump;
    37     function CpuInput(Port: T): T;
    38     procedure CpuOutput(Port, Value: T);
    3937  public
    4038    Machine: TMachine;
    … …  
    4543  FormMain: TFormMain;
    4644
    47 const
    48   ItemsPerLine = 16;
    49 
    5045
    5146implementation
    5247
    5348{$R *.lfm}
     49
     50uses
     51  UFormConsole, UFormMemory, UFormScreen, UFormCpuState, UFormAssembler,
     52  UFormDisassembler;
    5453
    5554{ TFormMain }
    … …  
    110109end;
    111110
    112 procedure TFormMain.FormKeyPress(Sender: TObject; var Key: char);
    113 begin
    114 end;
    115 
    116111procedure TFormMain.FormCreate(Sender: TObject);
    117112begin
    118113  Machine := TMachine.Create(nil);
    119   Machine.Cpu.OnInput := CpuInput;
    120   Machine.Cpu.OnOutput := CpuOutput;
    121114  InstructionWriter := TInstructionWriter.Create;
    122   InstructionWriter.Cpu := Machine.Cpu;
    123115end;
    124116
    125 procedure TFormMain.Button1Click(Sender: TObject);
     117procedure TFormMain.ButtonStartClick(Sender: TObject);
    126118begin
    127119  Machine.Cpu.Start;
    128120end;
    129121
    130 procedure TFormMain.Button2Click(Sender: TObject);
     122procedure TFormMain.ButtonStopClick(Sender: TObject);
    131123begin
    132124  Machine.Cpu.Stop;
    133125end;
    134126
    135 procedure TFormMain.ListViewMemoryData(Sender: TObject; Item: TListItem);
    136 var
    137   Line: string;
    138   I: Integer;
     127procedure TFormMain.ButtonAssemblerClick(Sender: TObject);
    139128begin
    140   if Item.Index < Machine.MemorySize div ItemsPerLine then begin
    141     Line := '';
    142     for I := 0 to ItemsPerLine - 1 do
    143       Line := Line + IntToHex(PByte(NativeUInt(Machine.Memory) + Item.Index * ItemsPerLine + I)^, 2) + ' ';
    144     Item.Caption := IntToHex(Item.Index * ItemsPerLine, 8);
    145     Item.SubItems.Add(Line);
    146   end;
     129  if not Assigned(FormAssembler) then
     130    FormAssembler := TFormAssembler.Create(Self);
     131  FormAssembler.Assembler.InstructionWriter.Memory := Machine.Memory;
     132  FormAssembler.Show;
    147133end;
    148134
    149 procedure TFormMain.ListViewRegistersData(Sender: TObject; Item: TListItem);
     135procedure TFormMain.ButtonConsoleClick(Sender: TObject);
    150136begin
    151   if Item.Index < Length(Machine.Cpu.Registers) + 1 then begin
    152     if Item.Index = 0 then begin
    153       Item.Caption := 'IP';
    154       Item.SubItems.Add(IntToHex(Int64(Machine.Cpu.IP), 8));
    155     end else
    156     if Item.Index = 1 then begin
    157       Item.Caption := 'SP';
    158       Item.SubItems.Add(IntToHex(Int64(Machine.Cpu.SP), 8));
    159     end else begin
    160       Item.Caption := 'R' + IntToStr(Item.Index - 2);
    161       Item.SubItems.Add(IntToHex(Int64(Machine.Cpu.Registers[Item.Index - 2]), 8));
    162     end;
    163   end;
     137  if not Assigned(FormConsole) then
     138    FormConsole := TFormConsole.Create(nil);
     139  FormConsole.Machine := Machine;
     140  FormConsole.Show;
    164141end;
    165142
    166 procedure TFormMain.Memo1KeyPress(Sender: TObject; var Key: char);
     143procedure TFormMain.ButtonCpuStateClick(Sender: TObject);
    167144begin
    168   SetLength(KeyInputBuffer, Length(KeyInputBuffer) + 1);
    169   KeyInputBuffer[High(KeyInputBuffer)] := Key;
     145  if not Assigned(FormCpuState) then
     146     FormCpuState := TFormCpuState.Create(Self);
     147   FormCpuState.Machine := Machine;
     148   FormCpuState.Show;
     149   FormCpuState.Reload;
    170150end;
    171151
    172 procedure TFormMain.Timer1Timer(Sender: TObject);
     152procedure TFormMain.ButtonDisassemblerClick(Sender: TObject);
    173153begin
    174   ReloadMemoryDump;
    175   ReloadRegisterDump;
    176   LabelTicks.Caption := 'Ticks: ' + IntToStr(Machine.Cpu.Ticks);
     154  if not Assigned(FormDisassembler) then
     155    FormDisassembler := TFormDisassembler.Create(Self);
     156  FormDisassembler.Disassembler.Cpu := Machine.Cpu;
     157  FormDisassembler.Show;
     158  FormDisassembler.Reload;
    177159end;
    178160
    179 procedure TFormMain.ReloadMemoryDump;
     161procedure TFormMain.ButtonMemoryClick(Sender: TObject);
    180162begin
    181   ListViewMemory.Items.Count := Machine.MemorySize div ItemsPerLine;
    182   ListViewMemory.Refresh;
     163  if not Assigned(FormMemory) then
     164    FormMemory := TFormMemory.Create(Self);
     165  FormMemory.Machine := Machine;
     166  FormMemory.Show;
     167  FormMemory.Reload;
    183168end;
    184169
    185 procedure TFormMain.ReloadRegisterDump;
     170procedure TFormMain.ButtonScreenClick(Sender: TObject);
    186171begin
    187   ListViewRegisters.Items.Count := Length(Machine.Cpu.Registers);
    188   ListViewRegisters.Refresh;
    189 end;
    190 
    191 function TFormMain.CpuInput(Port: T): T;
    192 begin
    193   Result := 0;
    194   case Integer(Port) of
    195     0: begin
    196       while (Length(KeyInputBuffer) = 0) and not Machine.Cpu.Terminated do begin
    197         Sleep(100);
    198         Application.ProcessMessages;
    199       end;
    200       if Length(KeyInputBuffer) > 0 then begin
    201         Result := Ord(KeyInputBuffer[0]);
    202         if Length(KeyInputBuffer) > 1 then
    203           Move(KeyInputBuffer[1], KeyInputBuffer[0], Length(KeyInputBuffer) - 1);
    204         SetLength(KeyInputBuffer, Length(KeyInputBuffer) - 1);
    205       end else Result := 0;
    206     end;
    207   end;
    208 end;
    209 
    210 procedure TFormMain.CpuOutput(Port, Value: T);
    211 begin
    212   case Integer(Port) of
    213     0: Memo1.Lines.Text := Memo1.Lines.Text + Char(Value);
    214   end;
     172  if not Assigned(FormScreen) then
     173    FormScreen := TFormScreen.Create(Self);
     174  FormScreen.Machine := Machine;
     175  FormScreen.Show;
     176  FormScreen.Reload;
    215177end;
    216178

  • branches/virtcpu varint/UInstructionWriter.pas

    r196 r197  
    66
    77uses
    8   Classes, SysUtils, UMachine;
     8  Classes, SysUtils, UCpu;
    99
    1010type
    … …  
    1414  private
    1515  public
    16     Cpu: TCpu;
     16    Memory: Pointer;
    1717    IP: T;
     18    function GetRelativeAddr(BaseIP, TargetAddr: T): T;
    1819    procedure Write(Value: T);
     20    procedure WriteSigned(Value: T);
    1921    procedure WriteOpcode(Value: TOpcode);
     22    procedure WriteString(Text: string);
    2023    procedure NoOperation;
    2124    procedure Load(R1, R2: Integer);
    … …  
    3033    procedure Jump(Addr: Integer);
    3134    procedure JumpCond(Addr: Integer);
    32     {$IFDEF EXT_REL_JUMP}
    3335    procedure JumpRelative(R1: Integer; Addr: Integer);
    3436    procedure JumpRelativeCond(Addr: Integer);
    35     {$ENDIF}
    3637    procedure TestEqual(R1, R2: Integer);
    3738    procedure Increment(R: Integer);
    3839    procedure Decrement(R: Integer);
    3940    constructor Create;
     41    procedure Init;
    4042  end;
    4143
    … …  
    4446
    4547{ TInstructionWriter }
     48
     49function TInstructionWriter.GetRelativeAddr(BaseIP, TargetAddr: T): T;
     50begin
     51  Result := TargetAddr - (BaseIP + 1 + T.GetByteSize);
     52end;
     53
     54procedure TInstructionWriter.WriteString(Text: string);
     55var
     56  I: Integer;
     57begin
     58  for I := 1 to Length(Text) do
     59    Write(Ord(Text[I]));
     60end;
    4661
    4762procedure TInstructionWriter.NoOperation;
    … …  
    129144end;
    130145
    131 {$IFDEF EXT_REL_JUMP}
    132146procedure TInstructionWriter.JumpRelative(R1: Integer; Addr: Integer);
    133147begin
    … …  
    139153procedure TInstructionWriter.JumpRelativeCond(Addr: Integer);
    140154begin
    141   Write(T(opJumpRelCond));
     155  WriteOpcode(opJumpRelCond);
    142156  Write(Addr - IP - 1);
    143157end;
    144 {$ENDIF}
    145158
    146159procedure TInstructionWriter.Increment(R: Integer);
    … …  
    158171constructor TInstructionWriter.Create;
    159172begin
     173  Memory := nil;
     174  Init;
     175end;
     176
     177procedure TInstructionWriter.Init;
     178begin
    160179  IP := 0;
    161   Cpu := nil;
    162180end;
    163181
    … …  
    166184  C: Integer;
    167185begin
    168   C := Value.WriteToAddr(Pointer(NativeInt(Cpu.Memory) + IP));
     186  C := Value.WriteToAddr(Pointer(NativeUInt(Memory) + IP));
    169187  Inc(IP, C);
    170188end;
    171189
     190procedure TInstructionWriter.WriteSigned(Value: T);
     191var
     192  C: Integer;
     193begin
     194  C := Value.WriteToAddr(Pointer(NativeUInt(Memory) + IP));
     195  Inc(IP, C);
     196end;
     197
    172198procedure TInstructionWriter.WriteOpcode(Value: TOpcode);
    173199begin

  • branches/virtcpu varint/UMachine.pas

    r196 r197  
    66
    77uses
    8   Classes, SysUtils, UVarInt;
     8  Classes, SysUtils, UVarInt, UCpu, syncobjs;
    99
    1010type
    11 
    12   T = TVarInt;
    13 
    14   TOpcode = (opNop, opLoad, opLoadConst, opNeg,
    15     opJump, opJumpRel,
    16     opInc, opDec,
    17     opLoadMem, opStoreMem,
    18     opAdd, opSub,
    19     opInput, opOutput,
    20     opCall, opCallRel, opRet,
    21     opExchg,
    22     opAnd, opOr, opXor,
    23     opShl, opShr,
    24     opRor, opRol,
    25     opPush, opPop,
    26     opJumpRelCond,
    27     opLdir, opLddr,
    28     opJumpCond, opTestEqual, opTestNotEqual, opTestLess,
    29     opTestLessEqual, opTestGreater, opTestGreaterEqual,
    30     opMul, opDiv, opHalt
    31   );
    32 
    33   TOpcodeHandler = procedure of object;
    34   TInputEvent = function (Port: T): T of object;
    35   TOutputEvent = procedure (Port, Value: T) of object;
    36 
    37   { TCPU }
    38 
    39   TCPU = class(TComponent)
    40   private
    41     FOnInput: TInputEvent;
    42     FOnOutput: TOutputEvent;
    43     OpcodeHandlers: array[TOpcode] of TOpcodeHandler;
    44     function ReadNext: T; inline;
    45     procedure OpcodeNop;
    46     procedure OpcodeHalt;
    47     procedure OpcodeLoad;
    48     procedure OpcodeLoadConst;
    49     procedure OpcodeJump;
    50     procedure OpcodeJumpRel;
    51     procedure OpcodeNeg;
    52     procedure OpcodeInc;
    53     procedure OpcodeDec;
    54     procedure OpcodeLoadMem;
    55     procedure OpcodeStoreMem;
    56     procedure OpcodeExchange;
    57     procedure OpcodeTestEqual;
    58     procedure OpcodeTestNotEqual;
    59     procedure OpcodeTestGreatEqual;
    60     procedure OpcodeTestGreat;
    61     procedure OpcodeTestLessEqual;
    62     procedure OpcodeTestLess;
    63     procedure OpcodeJumpCond;
    64     procedure OpcodeJumpRelCond;
    65     procedure OpcodeShl;
    66     procedure OpcodeShr;
    67     procedure OpcodeRor;
    68     procedure OpcodeRol;
    69     procedure OpcodeAnd;
    70     procedure OpcodeOr;
    71     procedure OpcodeXor;
    72     procedure OpcodePush;
    73     procedure OpcodePop;
    74     procedure OpcodeCall;
    75     procedure OpcodeReturn;
    76     procedure OpcodeCallRel;
    77     procedure OpcodeOutput;
    78     procedure OpcodeInput;
    79     procedure OpcodeAdd;
    80     procedure OpcodeSub;
    81     procedure OpcodeMul;
    82     procedure OpcodeDiv;
    83     procedure OpcodeLdir;
    84     procedure OpcodeLddr;
    85   public
    86     Memory: Pointer;
    87     Registers: array of T;
    88     IP: T;
    89     SP: T;
    90     Condition: Boolean;
    91     Terminated: Boolean;
    92     Ticks: Integer;
    93     procedure Start;
    94     procedure Stop;
    95     procedure Step; inline;
    96     constructor Create(AOwner: TComponent); override;
    97   published
    98     property OnInput: TInputEvent read FOnInput write FOnInput;
    99     property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
     11  TScreen = class
     12    Size: TPoint;
     13    MemoryBase: Integer;
     14    MemorySize: Integer;
     15    ChangedAreaFrom: Integer;
     16    ChangedAreaTo: Integer;
    10017  end;
    10118
    … …  
    10623    FMemorySize: Integer;
    10724    procedure SetMemorySize(AValue: Integer);
     25    function CpuInput(Port: T): T;
     26    procedure CpuOutput(Port: T; Value: T);
    10827  public
    10928    Cpu: TCpu;
    11029    Memory: Pointer;
     30    Screen: TScreen;
     31    InputBuffer: string;
     32    OutputBuffer: string;
     33    LockInput: TCriticalSection;
     34    LockOutput: TCriticalSection;
    11135    property MemorySize: Integer read FMemorySize write SetMemorySize;
    11236    constructor Create(AOwner: TComponent); override;
    … …  
    12549  Memory := ReAllocMem(Memory, FMemorySize);
    12650  Cpu.Memory := Memory;
     51  Cpu.OnOutput := CpuOutput;
     52  Cpu.OnInput := CpuInput;
     53end;
     54
     55function TMachine.CpuInput(Port: T): T;
     56begin
     57  Result := 0;
     58  case Integer(Port) of
     59    0: begin
     60      LockInput.Acquire;
     61      while (Length(InputBuffer) = 0) and not Cpu.Terminated do begin
     62        LockInput.Release;
     63        Sleep(100);
     64        LockInput.Acquire;
     65      end;
     66      if Length(InputBuffer) > 0 then begin
     67        Result := Ord(InputBuffer[1]);
     68        Delete(InputBuffer, 1, 1);
     69      end else Result := 0;
     70      LockInput.Release;
     71    end;
     72    1: Result := Screen.Size.X;
     73    2: Result := Screen.Size.Y;
     74    3: Result := Screen.MemoryBase;
     75  end;
     76end;
     77
     78procedure TMachine.CpuOutput(Port: T; Value: T);
     79begin
     80  case Integer(Port) of
     81    0: begin
     82      LockOutput.Acquire;
     83      OutputBuffer := OutputBuffer + Char(Value);
     84      LockOutput.Release;
     85    end;
     86    1: Screen.Size.X := Value;
     87    2: Screen.Size.Y := Value;
     88    3: Screen.MemoryBase := Value;
     89    4: Screen.ChangedAreaFrom := Value;
     90    5: Screen.ChangedAreaTo := Value;
     91  end;
    12792end;
    12893
    … …  
    13095begin
    13196  inherited;
     97  LockInput := TCriticalSection.Create;
     98  LockOutput := TCriticalSection.Create;
    13299  Cpu := TCpu.Create(nil);
    133100  MemorySize := 1000;
     101  Screen := TScreen.Create;
     102  Screen.Size := Point(320, 240);
     103  Screen.MemoryBase := $200;
    134104end;
    135105
    … …  
    137107begin
    138108  MemorySize := 0;
     109  FreeAndNil(Screen);
    139110  FreeAndNil(Cpu);
    140111  inherited Destroy;
    141112end;
    142113
    143 { TCPU }
    144 
    145 function TCPU.ReadNext: T;
    146 begin
    147   IP := IP + Result.ReadFromAddr(Pointer(NativeUInt(Memory) + IP));
    148 end;
    149 
    150 procedure TCPU.OpcodeHalt;
    151 begin
    152   Terminated := True;
    153 end;
    154 
    155 procedure TCPU.OpcodeNop;
    156 begin
    157   // Do nothing
    158 end;
    159 
    160 procedure TCPU.OpcodeLoad;
    161 var
    162   P1: T;
    163   P2: T;
    164 begin
    165   P1 := ReadNext;
    166   P2 := ReadNext;
    167   Registers[P1] := Registers[P2];
    168 end;
    169 
    170 procedure TCPU.OpcodeLoadConst;
    171 var
    172   P1: T;
    173   P2: T;
    174 begin
    175   P1 := ReadNext;
    176   P2 := ReadNext;
    177   Registers[P1] := P2;
    178 end;
    179 
    180 procedure TCPU.OpcodeLoadMem;
    181 var
    182   P1: T;
    183   P2: T;
    184 begin
    185   P1 := ReadNext;
    186   P2 := ReadNext;
    187   Registers[P1].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(Registers[P2])));
    188 end;
    189 
    190 procedure TCPU.OpcodeStoreMem;
    191 var
    192   P1: T;
    193   P2: T;
    194 begin
    195   P1 := ReadNext;
    196   P2 := ReadNext;
    197   Registers[P2].WriteToAddr(Pointer(NativeUInt(Memory) + Registers[P1]));
    198 end;
    199 
    200 procedure TCPU.OpcodeNeg;
    201 var
    202   P1: T;
    203 begin
    204   P1 := ReadNext;
    205   Registers[P1] := -Registers[P1];
    206 end;
    207 
    208 procedure TCPU.OpcodeExchange;
    209 var
    210   P1, P2, Temp: T;
    211 begin
    212   P1 := ReadNext;
    213   P2 := ReadNext;
    214   Temp := Registers[P1];
    215   Registers[P1] := Registers[P2];
    216   Registers[P2] := Temp;
    217 end;
    218 
    219 procedure TCPU.OpcodeJump;
    220 begin
    221   IP := ReadNext;
    222 end;
    223 
    224 procedure TCPU.OpcodeJumpRel;
    225 begin
    226   IP := IP + ReadNext;
    227 end;
    228 
    229 procedure TCPU.OpcodeTestEqual;
    230 begin
    231   Condition := ReadNext = ReadNext;
    232 end;
    233 
    234 procedure TCPU.OpcodeTestNotEqual;
    235 begin
    236   Condition := ReadNext <> ReadNext;
    237 end;
    238 
    239 procedure TCPU.OpcodeTestGreatEqual;
    240 begin
    241   Condition := ReadNext >= ReadNext;
    242 end;
    243 
    244 procedure TCPU.OpcodeTestGreat;
    245 begin
    246   Condition := ReadNext > ReadNext;
    247 end;
    248 
    249 procedure TCPU.OpcodeTestLessEqual;
    250 begin
    251   Condition := ReadNext <= ReadNext;
    252 end;
    253 
    254 procedure TCPU.OpcodeTestLess;
    255 begin
    256   Condition := ReadNext < ReadNext;
    257 end;
    258 
    259 procedure TCPU.OpcodeJumpCond;
    260 var
    261   Addr: T;
    262 begin
    263   Addr := ReadNext;
    264   if Condition then IP := Addr;
    265 end;
    266 
    267 
    268 procedure TCPU.OpcodeJumpRelCond;
    269 var
    270   Addr: T;
    271 begin
    272   Addr := ReadNext;
    273   if Condition then IP := IP + Addr;
    274 end;
    275 
    276 procedure TCPU.OpcodeRor;
    277 var
    278   P1, P2: T;
    279 begin
    280   P1 := ReadNext;
    281   P2 := ReadNext;
    282   Registers[P1] := (Registers[P1] shr Registers[P2]) or
    283     ((Registers[P1] and ((1 shl Registers[P2]) - 1)) shl (SizeOf(T) * 8 - Registers[P2]));
    284 end;
    285 
    286 procedure TCPU.OpcodeRol;
    287 var
    288   P1, P2: T;
    289 begin
    290   P1 := ReadNext;
    291   P2 := ReadNext;
    292   Registers[P1] := (Registers[P1] shl Registers[P2]) or
    293     ((Registers[P1] shr (SizeOf(T) * 8 - Registers[P2])) and ((1 shl Registers[P2]) - 1));
    294 end;
    295 
    296 procedure TCPU.OpcodeShl;
    297 var
    298   P1, P2: T;
    299 begin
    300   P1 := ReadNext;
    301   P2 := ReadNext;
    302   Registers[P1] := Registers[P1] shl Registers[P2];
    303 end;
    304 
    305 procedure TCPU.OpcodeShr;
    306 var
    307   P1, P2: T;
    308 begin
    309   P1 := ReadNext;
    310   P2 := ReadNext;
    311   Registers[P1] := Registers[P1] shr Registers[P2];
    312 end;
    313 
    314 procedure TCPU.OpcodeAnd;
    315 var
    316   P1, P2: T;
    317 begin
    318   P1 := ReadNext;
    319   P2 := ReadNext;
    320   Registers[P1] := Registers[P1] and Registers[P2];
    321 end;
    322 
    323 procedure TCPU.OpcodeOr;
    324 var
    325   P1, P2: T;
    326 begin
    327   P1 := ReadNext;
    328   P2 := ReadNext;
    329   Registers[P1] := Registers[P1] or Registers[P2];
    330 end;
    331 
    332 procedure TCPU.OpcodeXor;
    333 var
    334   P1, P2: T;
    335 begin
    336   P1 := ReadNext;
    337   P2 := ReadNext;
    338   Registers[P1] := Registers[P1] xor Registers[P2];
    339 end;
    340 
    341 procedure TCPU.OpcodePush;
    342 var
    343   P1: T;
    344 begin
    345   P1 := ReadNext;
    346   SP := SP - Registers[P1].GetByteSize;
    347   Registers[P1].WriteToAddr(Pointer(NativeUInt(Memory) + Integer(SP)));
    348 end;
    349 
    350 procedure TCPU.OpcodePop;
    351 begin
    352   SP := SP + Registers[ReadNext].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(SP)));
    353 end;
    354 
    355 procedure TCPU.OpcodeCall;
    356 var
    357   Addr: T;
    358 begin
    359   Addr := ReadNext;
    360   SP := SP - IP.GetByteSize;
    361   IP.WriteToAddr(Pointer(NativeUInt(Memory) + SP));
    362   IP := Addr;
    363 end;
    364 
    365 procedure TCPU.OpcodeCallRel;
    366 var
    367   Addr: T;
    368 begin
    369   Addr := ReadNext;
    370   SP := SP - IP.GetByteSize;
    371   IP.WriteToAddr(Pointer(NativeUInt(Memory) + SP));
    372   IP := IP + Addr;
    373 end;
    374 
    375 procedure TCPU.OpcodeReturn;
    376 begin
    377   SP := SP + IP.ReadFromAddr(Pointer(NativeUInt(Memory) + SP));
    378 end;
    379 
    380 procedure TCPU.OpcodeOutput;
    381 var
    382   R1: T;
    383   R2: T;
    384 begin
    385   R1 := ReadNext;
    386   R2 := ReadNext;
    387   if Assigned(FOnOutput) then
    388     FOnOutput(Registers[R1], Registers[R2]);
    389 end;
    390 
    391 procedure TCPU.OpcodeInput;
    392 var
    393   R1: T;
    394   R2: T;
    395 begin
    396   R1 := ReadNext;
    397   R2 := ReadNext;
    398   if Assigned(FOnInput) then
    399     Registers[R1] := FOnInput(Registers[R2]);
    400 end;
    401 
    402 procedure TCPU.OpcodeInc;
    403 var
    404   R: T;
    405 begin
    406   R := ReadNext;
    407   Registers[R] := Registers[R] + 1;
    408 end;
    409 
    410 procedure TCPU.OpcodeDec;
    411 var
    412   R: T;
    413 begin
    414   R := ReadNext;
    415   Registers[R] := Registers[R] - 1;
    416 end;
    417 
    418 procedure TCPU.OpcodeAdd;
    419 var
    420   R1: T;
    421   R2: T;
    422 begin
    423   R1 := ReadNext;
    424   R2 := ReadNext;
    425   Registers[R1] := Registers[R1] + Registers[R2];
    426 end;
    427 
    428 procedure TCPU.OpcodeSub;
    429 var
    430   R1: T;
    431   R2: T;
    432 begin
    433   R1 := ReadNext;
    434   R2 := ReadNext;
    435   Registers[R1] := Registers[R1] - Registers[R2];
    436 end;
    437 
    438 procedure TCPU.OpcodeMul;
    439 var
    440   R1: T;
    441   R2: T;
    442 begin
    443   R1 := ReadNext;
    444   R2 := ReadNext;
    445   Registers[R1] := Registers[R1] * Registers[R2];
    446 end;
    447 
    448 procedure TCPU.OpcodeDiv;
    449 var
    450   R1: T;
    451   R2: T;
    452 begin
    453   R1 := ReadNext;
    454   R2 := ReadNext;
    455   Registers[R1] := Registers[R1] div Registers[R2];
    456 end;
    457 
    458 procedure TCPU.OpcodeLdir;
    459 var
    460   Src: T;
    461   Dst: T;
    462   Count: T;
    463   Bytes: T;
    464 begin
    465   Src := ReadNext;
    466   Dst := ReadNext;
    467   Count := ReadNext;
    468   Bytes := ReadNext;
    469   while Registers[Count] > 0 do begin
    470     Move(Pointer(NativeUInt(Memory) + Registers[Src])^,
    471       Pointer(NativeUInt(Memory) + Registers[Dst])^, Bytes);
    472     Inc(Registers[Src], Bytes);
    473     Inc(Registers[Dst], Bytes);
    474     Dec(Registers[Count]);
    475   end;
    476 end;
    477 
    478 procedure TCPU.OpcodeLddr;
    479 var
    480   Src: T;
    481   Dst: T;
    482   Count: T;
    483   Bytes: T;
    484 begin
    485   Src := ReadNext;
    486   Dst := ReadNext;
    487   Count := ReadNext;
    488   Bytes := ReadNext;
    489   while Registers[Count] > 0 do begin
    490     Move(Pointer(NativeUInt(Memory) + Registers[Src])^,
    491       Pointer(NativeUInt(Memory) + Registers[Dst])^, Bytes);
    492     Dec(Registers[Src], Bytes);
    493     Dec(Registers[Dst], Bytes);
    494     Dec(Registers[Count]);
    495   end;
    496 end;
    497 
    498 procedure TCPU.Start;
    499 begin
    500   Terminated := False;
    501   Ticks := 0;
    502   IP := 0;
    503   SP := MemSize(Memory);
    504   while not Terminated do
    505     Step;
    506 end;
    507 
    508 procedure TCPU.Stop;
    509 begin
    510   Terminated := True;
    511 end;
    512 
    513 procedure TCPU.Step;
    514 var
    515   Opcode: T;
    516 begin
    517   Opcode := ReadNext;
    518   if (Opcode >= 0) and (Opcode <= T(Integer(High(TOpcode)))) then
    519     OpcodeHandlers[TOpcode(Byte(Opcode))]
    520     else raise Exception.Create(Format('Unsupported instruction %d on address %x', [Int64(Opcode), Int64(IP)]));
    521   Inc(Ticks);
    522 end;
    523 
    524 constructor TCPU.Create(AOwner: TComponent);
    525 begin
    526   inherited;
    527   SetLength(Registers, 16);
    528   OpcodeHandlers[opNop] := OpcodeNop;
    529   OpcodeHandlers[opHalt] := OpcodeHalt;
    530   OpcodeHandlers[opLoad] := OpcodeLoad;
    531   OpcodeHandlers[opLoadConst] := OpcodeLoadConst;
    532   OpcodeHandlers[opNeg] := OpcodeNeg;
    533   OpcodeHandlers[opJump] := OpcodeJump;
    534   OpcodeHandlers[opInc] := OpcodeInc;
    535   OpcodeHandlers[opDec] := OpcodeDec;
    536   OpcodeHandlers[opJumpRel] := OpcodeJumpRel;
    537   OpcodeHandlers[opLoadMem] := OpcodeLoadMem;
    538   OpcodeHandlers[opStoreMem] := OpcodeStoreMem;
    539   OpcodeHandlers[opExchg] := OpcodeExchange;
    540   OpcodeHandlers[opAnd] := OpcodeAnd;
    541   OpcodeHandlers[opOr] := OpcodeOr;
    542   OpcodeHandlers[opXor] := OpcodeXor;
    543   OpcodeHandlers[opShl] := OpcodeShl;
    544   OpcodeHandlers[opShr] := OpcodeShr;
    545   OpcodeHandlers[opPush] := OpcodePush;
    546   OpcodeHandlers[opPop] := OpcodePop;
    547   OpcodeHandlers[opCall] := OpcodeCall;
    548   OpcodeHandlers[opCallRel] := OpcodeCallRel;
    549   OpcodeHandlers[opRet] := OpcodeReturn;
    550   OpcodeHandlers[opRor] := OpcodeRor;
    551   OpcodeHandlers[opRol] := OpcodeRol;
    552   OpcodeHandlers[opInput] := OpcodeInput;
    553   OpcodeHandlers[opOutput] := OpcodeOutput;
    554   OpcodeHandlers[opAdd] := OpcodeAdd;
    555   OpcodeHandlers[opSub] := OpcodeSub;
    556   OpcodeHandlers[opLdir] := OpcodeLdir;
    557   OpcodeHandlers[opLddr] := OpcodeLddr;
    558   OpcodeHandlers[opJumpCond] := OpcodeJumpCond;
    559   OpcodeHandlers[opJumpRelCond] := OpcodeJumpRelCond;
    560   OpcodeHandlers[opTestEqual] := OpcodeTestEqual;
    561   OpcodeHandlers[opTestNotEqual] := OpcodeTestNotEqual;
    562   OpcodeHandlers[opTestLess] := OpcodeTestLess;
    563   OpcodeHandlers[opTestLessEqual] := OpcodeTestLessEqual;
    564   OpcodeHandlers[opTestGreater] := OpcodeTestGreat;
    565   OpcodeHandlers[opTestGreaterEqual] := OpcodeTestGreatEqual;
    566   OpcodeHandlers[opMul] := OpcodeMul;
    567   OpcodeHandlers[opDiv] := OpcodeDiv;
    568 end;
    569 
    570114end.
    571115

  • branches/virtcpu varint/UVarInt.pas

    r196 r197  
    3939    class operator Multiply(A: TVarInt; B: TVarInt): TVarInt;
    4040    class operator IntDivide(A: TVarInt; B: TVarInt): TVarInt;
     41    class operator Modulus(A: TVarInt; B: TVarInt): TVarInt;
    4142    class operator Subtract(A: TVarInt; B: TVarInt): TVarInt;
    4243    class operator Equal(A: TVarInt; B: TVarInt): Boolean;
    … …  
    6768    class operator Implicit(A: TVarUInt): Byte;
    6869    class operator Implicit(A: TVarUInt): Char;
     70    class operator Implicit(A: TVarUInt): TVarInt;
    6971    class operator Implicit(A: Byte): TVarUInt;
    7072    class operator Implicit(A: Integer): TVarUInt;
    7173    class operator Implicit(A: Int64): TVarUInt;
    7274    class operator Implicit(A: QWord): TVarUInt;
     75    class operator Implicit(A: TVarInt): TVarUInt;
    7376    class operator Explicit(A: Byte): TVarUInt;
    7477    class operator Explicit(A: Integer): TVarUInt;
    … …  
    8386    class operator Multiply(A: TVarUInt; B: TVarUInt): TVarUInt;
    8487    class operator IntDivide(A: TVarUInt; B: TVarUInt): TVarUInt;
     88    class operator Modulus(A: TVarUInt; B: TVarUInt): TVarUInt;
    8589    class operator Subtract(A: TVarUInt; B: TVarUInt): TVarUInt;
    8690    class operator Equal(A: TVarUInt; B: TVarUInt): Boolean;
    … …  
    148152end;
    149153
     154class operator TVarUInt.Implicit(A: TVarUInt): TVarInt;
     155begin
     156  Result.Value := A.Value;
     157end;
     158
    150159class operator TVarUInt.Implicit(A: Byte): TVarUInt;
    151160begin
    … …  
    168177end;
    169178
     179class operator TVarUInt.Implicit(A: TVarInt): TVarUInt;
     180begin
     181  Result.Value := A.Value;
     182end;
     183
    170184class operator TVarUInt.Explicit(A: Byte): TVarUInt;
    171185begin
    … …  
    226240begin
    227241  Result.Value := A.Value div B.Value;
     242end;
     243
     244class operator TVarUInt.Modulus(A: TVarUInt; B: TVarUInt): TVarUInt;
     245begin
     246  Result.Value := A.Value mod B.Value;
    228247end;
    229248
    … …  
    466485end;
    467486
     487class operator TVarInt.Modulus(A: TVarInt; B: TVarInt): TVarInt;
     488begin
     489  Result.Value := A.Value mod B.Value;
     490end;
     491
    468492class operator TVarInt.Subtract(A: TVarInt; B: TVarInt): TVarInt;
    469493begin
    470   Result.Value := A.Value - B.Value
     494  Result.Value := A.Value - B.Value;
    471495end;
    472496

  • branches/virtcpu varint/virtcpu.lpi

    r196 r197  
    2323          <SearchPaths>
    2424            <IncludeFiles Value="$(ProjOutDir)"/>
     25            <OtherUnitFiles Value="Forms"/>
    2526            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    2627          </SearchPaths>
    … …  
    6465      </Item1>
    6566    </RequiredPackages>
    66     <Units Count="5">
     67    <Units Count="16">
    6768      <Unit0>
    6869        <Filename Value="virtcpu.lpr"/>
    … …  
    7071      </Unit0>
    7172      <Unit1>
    72         <Filename Value="UFormMain.pas"/>
    73         <IsPartOfProject Value="True"/>
    74         <ComponentName Value="FormMain"/>
    75         <HasResources Value="True"/>
    76         <ResourceBaseClass Value="Form"/>
     73        <Filename Value="UMachine.pas"/>
     74        <IsPartOfProject Value="True"/>
    7775      </Unit1>
    7876      <Unit2>
    79         <Filename Value="UMachine.pas"/>
     77        <Filename Value="UInstructionWriter.pas"/>
    8078        <IsPartOfProject Value="True"/>
    8179      </Unit2>
    8280      <Unit3>
    83         <Filename Value="UInstructionWriter.pas"/>
     81        <Filename Value="UVarInt.pas"/>
    8482        <IsPartOfProject Value="True"/>
    8583      </Unit3>
    8684      <Unit4>
    87         <Filename Value="UVarInt.pas"/>
    88         <IsPartOfProject Value="True"/>
     85        <Filename Value="Forms\UFormAssembler.pas"/>
     86        <IsPartOfProject Value="True"/>
     87        <ComponentName Value="FormAssembler"/>
     88        <HasResources Value="True"/>
     89        <ResourceBaseClass Value="Form"/>
    8990      </Unit4>
     91      <Unit5>
     92        <Filename Value="Forms\UFormConsole.pas"/>
     93        <IsPartOfProject Value="True"/>
     94        <ComponentName Value="FormConsole"/>
     95        <HasResources Value="True"/>
     96        <ResourceBaseClass Value="Form"/>
     97      </Unit5>
     98      <Unit6>
     99        <Filename Value="Forms\UFormCpuState.pas"/>
     100        <IsPartOfProject Value="True"/>
     101        <ComponentName Value="FormCpuState"/>
     102        <HasResources Value="True"/>
     103        <ResourceBaseClass Value="Form"/>
     104      </Unit6>
     105      <Unit7>
     106        <Filename Value="Forms\UFormMain.pas"/>
     107        <IsPartOfProject Value="True"/>
     108        <ComponentName Value="FormMain"/>
     109        <HasResources Value="True"/>
     110        <ResourceBaseClass Value="Form"/>
     111      </Unit7>
     112      <Unit8>
     113        <Filename Value="Forms\UFormMemory.pas"/>
     114        <IsPartOfProject Value="True"/>
     115        <ComponentName Value="FormMemory"/>
     116        <HasResources Value="True"/>
     117        <ResourceBaseClass Value="Form"/>
     118      </Unit8>
     119      <Unit9>
     120        <Filename Value="Forms\UFormScreen.pas"/>
     121        <IsPartOfProject Value="True"/>
     122        <ComponentName Value="FormScreen"/>
     123        <HasResources Value="True"/>
     124        <ResourceBaseClass Value="Form"/>
     125      </Unit9>
     126      <Unit10>
     127        <Filename Value="Forms\UFormDisassembler.pas"/>
     128        <IsPartOfProject Value="True"/>
     129        <HasResources Value="True"/>
     130      </Unit10>
     131      <Unit11>
     132        <Filename Value="UInstructionReader.pas"/>
     133        <IsPartOfProject Value="True"/>
     134      </Unit11>
     135      <Unit12>
     136        <Filename Value="UAssembler.pas"/>
     137        <IsPartOfProject Value="True"/>
     138      </Unit12>
     139      <Unit13>
     140        <Filename Value="UDisassembler.pas"/>
     141        <IsPartOfProject Value="True"/>
     142      </Unit13>
     143      <Unit14>
     144        <Filename Value="UCpu.pas"/>
     145        <IsPartOfProject Value="True"/>
     146      </Unit14>
     147      <Unit15>
     148        <Filename Value="UOpcode.pas"/>
     149        <IsPartOfProject Value="True"/>
     150      </Unit15>
    90151    </Units>
    91152  </ProjectOptions>
    … …  
    98159    <SearchPaths>
    99160      <IncludeFiles Value="$(ProjOutDir)"/>
     161      <OtherUnitFiles Value="Forms"/>
    100162      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    101163    </SearchPaths>

  • branches/virtcpu varint/virtcpu.lpr

    r196 r197  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain, UMachine, UInstructionWriter, UVarInt
    11   { you can add units after this };
     10  Forms, UMachine, UInstructionWriter, UVarInt
     11  { you can add units after this },
     12  UFormMain, UCpu;
    1213
    1314{$R *.res}
    1415
    1516begin
    16   RequireDerivedFormResource:=True;
     17  RequireDerivedFormResource := True;
    1718  Application.Initialize;
    1819  Application.CreateForm(TFormMain, FormMain);
Note: See TracChangeset for help on using the changeset viewer.