- Timestamp:
- Sep 22, 2019, 9:31:49 PM (5 years ago)
- Location:
- branches/virtcpu varint
- Files:
-
- 17 added
- 5 edited
- 2 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/virtcpu varint/Forms/UFormMain.lfm
r196 r197 10 10 OnCreate = FormCreate 11 11 OnDestroy = FormDestroy 12 OnKeyPress = FormKeyPress13 12 OnShow = FormShow 14 13 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 66 15 Left = 247 67 16 Height = 37 … … 69 18 Width = 113 70 19 Caption = 'Start' 71 OnClick = Button 1Click20 OnClick = ButtonStartClick 72 21 ParentFont = False 73 TabOrder = 322 TabOrder = 0 74 23 end 75 object Button 2: TButton24 object ButtonStop: TButton 76 25 Left = 106 77 26 Height = 37 … … 79 28 Width = 113 80 29 Caption = 'Stop' 81 OnClick = Button 2Click30 OnClick = ButtonStopClick 82 31 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 83 59 TabOrder = 4 84 60 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 93 87 end 94 88 object Timer1: TTimer 95 89 Interval = 500 96 OnTimer = Timer1Timer97 90 left = 271 98 91 top = 810 -
branches/virtcpu varint/Forms/UFormMain.pas
r196 r197 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, 9 StdCtrls, ExtCtrls, UMachine, UInstructionWriter ;9 StdCtrls, ExtCtrls, UMachine, UInstructionWriter, UCpu; 10 10 11 11 type … … 14 14 15 15 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; 22 24 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); 25 33 procedure FormCreate(Sender: TObject); 26 34 procedure FormDestroy(Sender: TObject); 27 procedure FormKeyPress(Sender: TObject; var Key: char);28 35 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);33 36 private 34 KeyInputBuffer: array of Char;35 procedure ReloadMemoryDump;36 procedure ReloadRegisterDump;37 function CpuInput(Port: T): T;38 procedure CpuOutput(Port, Value: T);39 37 public 40 38 Machine: TMachine; … … 45 43 FormMain: TFormMain; 46 44 47 const48 ItemsPerLine = 16;49 50 45 51 46 implementation 52 47 53 48 {$R *.lfm} 49 50 uses 51 UFormConsole, UFormMemory, UFormScreen, UFormCpuState, UFormAssembler, 52 UFormDisassembler; 54 53 55 54 { TFormMain } … … 110 109 end; 111 110 112 procedure TFormMain.FormKeyPress(Sender: TObject; var Key: char);113 begin114 end;115 116 111 procedure TFormMain.FormCreate(Sender: TObject); 117 112 begin 118 113 Machine := TMachine.Create(nil); 119 Machine.Cpu.OnInput := CpuInput;120 Machine.Cpu.OnOutput := CpuOutput;121 114 InstructionWriter := TInstructionWriter.Create; 122 InstructionWriter.Cpu := Machine.Cpu;123 115 end; 124 116 125 procedure TFormMain.Button 1Click(Sender: TObject);117 procedure TFormMain.ButtonStartClick(Sender: TObject); 126 118 begin 127 119 Machine.Cpu.Start; 128 120 end; 129 121 130 procedure TFormMain.Button 2Click(Sender: TObject);122 procedure TFormMain.ButtonStopClick(Sender: TObject); 131 123 begin 132 124 Machine.Cpu.Stop; 133 125 end; 134 126 135 procedure TFormMain.ListViewMemoryData(Sender: TObject; Item: TListItem); 136 var 137 Line: string; 138 I: Integer; 127 procedure TFormMain.ButtonAssemblerClick(Sender: TObject); 139 128 begin 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; 147 133 end; 148 134 149 procedure TFormMain. ListViewRegistersData(Sender: TObject; Item: TListItem);135 procedure TFormMain.ButtonConsoleClick(Sender: TObject); 150 136 begin 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; 164 141 end; 165 142 166 procedure TFormMain. Memo1KeyPress(Sender: TObject; var Key: char);143 procedure TFormMain.ButtonCpuStateClick(Sender: TObject); 167 144 begin 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; 170 150 end; 171 151 172 procedure TFormMain. Timer1Timer(Sender: TObject);152 procedure TFormMain.ButtonDisassemblerClick(Sender: TObject); 173 153 begin 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; 177 159 end; 178 160 179 procedure TFormMain. ReloadMemoryDump;161 procedure TFormMain.ButtonMemoryClick(Sender: TObject); 180 162 begin 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; 183 168 end; 184 169 185 procedure TFormMain. ReloadRegisterDump;170 procedure TFormMain.ButtonScreenClick(Sender: TObject); 186 171 begin 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; 215 177 end; 216 178 -
branches/virtcpu varint/UInstructionWriter.pas
r196 r197 6 6 7 7 uses 8 Classes, SysUtils, U Machine;8 Classes, SysUtils, UCpu; 9 9 10 10 type … … 14 14 private 15 15 public 16 Cpu: TCpu;16 Memory: Pointer; 17 17 IP: T; 18 function GetRelativeAddr(BaseIP, TargetAddr: T): T; 18 19 procedure Write(Value: T); 20 procedure WriteSigned(Value: T); 19 21 procedure WriteOpcode(Value: TOpcode); 22 procedure WriteString(Text: string); 20 23 procedure NoOperation; 21 24 procedure Load(R1, R2: Integer); … … 30 33 procedure Jump(Addr: Integer); 31 34 procedure JumpCond(Addr: Integer); 32 {$IFDEF EXT_REL_JUMP}33 35 procedure JumpRelative(R1: Integer; Addr: Integer); 34 36 procedure JumpRelativeCond(Addr: Integer); 35 {$ENDIF}36 37 procedure TestEqual(R1, R2: Integer); 37 38 procedure Increment(R: Integer); 38 39 procedure Decrement(R: Integer); 39 40 constructor Create; 41 procedure Init; 40 42 end; 41 43 … … 44 46 45 47 { TInstructionWriter } 48 49 function TInstructionWriter.GetRelativeAddr(BaseIP, TargetAddr: T): T; 50 begin 51 Result := TargetAddr - (BaseIP + 1 + T.GetByteSize); 52 end; 53 54 procedure TInstructionWriter.WriteString(Text: string); 55 var 56 I: Integer; 57 begin 58 for I := 1 to Length(Text) do 59 Write(Ord(Text[I])); 60 end; 46 61 47 62 procedure TInstructionWriter.NoOperation; … … 129 144 end; 130 145 131 {$IFDEF EXT_REL_JUMP}132 146 procedure TInstructionWriter.JumpRelative(R1: Integer; Addr: Integer); 133 147 begin … … 139 153 procedure TInstructionWriter.JumpRelativeCond(Addr: Integer); 140 154 begin 141 Write (T(opJumpRelCond));155 WriteOpcode(opJumpRelCond); 142 156 Write(Addr - IP - 1); 143 157 end; 144 {$ENDIF}145 158 146 159 procedure TInstructionWriter.Increment(R: Integer); … … 158 171 constructor TInstructionWriter.Create; 159 172 begin 173 Memory := nil; 174 Init; 175 end; 176 177 procedure TInstructionWriter.Init; 178 begin 160 179 IP := 0; 161 Cpu := nil;162 180 end; 163 181 … … 166 184 C: Integer; 167 185 begin 168 C := Value.WriteToAddr(Pointer(Native Int(Cpu.Memory) + IP));186 C := Value.WriteToAddr(Pointer(NativeUInt(Memory) + IP)); 169 187 Inc(IP, C); 170 188 end; 171 189 190 procedure TInstructionWriter.WriteSigned(Value: T); 191 var 192 C: Integer; 193 begin 194 C := Value.WriteToAddr(Pointer(NativeUInt(Memory) + IP)); 195 Inc(IP, C); 196 end; 197 172 198 procedure TInstructionWriter.WriteOpcode(Value: TOpcode); 173 199 begin -
branches/virtcpu varint/UMachine.pas
r196 r197 6 6 7 7 uses 8 Classes, SysUtils, UVarInt ;8 Classes, SysUtils, UVarInt, UCpu, syncobjs; 9 9 10 10 type 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; 100 17 end; 101 18 … … 106 23 FMemorySize: Integer; 107 24 procedure SetMemorySize(AValue: Integer); 25 function CpuInput(Port: T): T; 26 procedure CpuOutput(Port: T; Value: T); 108 27 public 109 28 Cpu: TCpu; 110 29 Memory: Pointer; 30 Screen: TScreen; 31 InputBuffer: string; 32 OutputBuffer: string; 33 LockInput: TCriticalSection; 34 LockOutput: TCriticalSection; 111 35 property MemorySize: Integer read FMemorySize write SetMemorySize; 112 36 constructor Create(AOwner: TComponent); override; … … 125 49 Memory := ReAllocMem(Memory, FMemorySize); 126 50 Cpu.Memory := Memory; 51 Cpu.OnOutput := CpuOutput; 52 Cpu.OnInput := CpuInput; 53 end; 54 55 function TMachine.CpuInput(Port: T): T; 56 begin 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; 76 end; 77 78 procedure TMachine.CpuOutput(Port: T; Value: T); 79 begin 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; 127 92 end; 128 93 … … 130 95 begin 131 96 inherited; 97 LockInput := TCriticalSection.Create; 98 LockOutput := TCriticalSection.Create; 132 99 Cpu := TCpu.Create(nil); 133 100 MemorySize := 1000; 101 Screen := TScreen.Create; 102 Screen.Size := Point(320, 240); 103 Screen.MemoryBase := $200; 134 104 end; 135 105 … … 137 107 begin 138 108 MemorySize := 0; 109 FreeAndNil(Screen); 139 110 FreeAndNil(Cpu); 140 111 inherited Destroy; 141 112 end; 142 113 143 { TCPU }144 145 function TCPU.ReadNext: T;146 begin147 IP := IP + Result.ReadFromAddr(Pointer(NativeUInt(Memory) + IP));148 end;149 150 procedure TCPU.OpcodeHalt;151 begin152 Terminated := True;153 end;154 155 procedure TCPU.OpcodeNop;156 begin157 // Do nothing158 end;159 160 procedure TCPU.OpcodeLoad;161 var162 P1: T;163 P2: T;164 begin165 P1 := ReadNext;166 P2 := ReadNext;167 Registers[P1] := Registers[P2];168 end;169 170 procedure TCPU.OpcodeLoadConst;171 var172 P1: T;173 P2: T;174 begin175 P1 := ReadNext;176 P2 := ReadNext;177 Registers[P1] := P2;178 end;179 180 procedure TCPU.OpcodeLoadMem;181 var182 P1: T;183 P2: T;184 begin185 P1 := ReadNext;186 P2 := ReadNext;187 Registers[P1].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(Registers[P2])));188 end;189 190 procedure TCPU.OpcodeStoreMem;191 var192 P1: T;193 P2: T;194 begin195 P1 := ReadNext;196 P2 := ReadNext;197 Registers[P2].WriteToAddr(Pointer(NativeUInt(Memory) + Registers[P1]));198 end;199 200 procedure TCPU.OpcodeNeg;201 var202 P1: T;203 begin204 P1 := ReadNext;205 Registers[P1] := -Registers[P1];206 end;207 208 procedure TCPU.OpcodeExchange;209 var210 P1, P2, Temp: T;211 begin212 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 begin221 IP := ReadNext;222 end;223 224 procedure TCPU.OpcodeJumpRel;225 begin226 IP := IP + ReadNext;227 end;228 229 procedure TCPU.OpcodeTestEqual;230 begin231 Condition := ReadNext = ReadNext;232 end;233 234 procedure TCPU.OpcodeTestNotEqual;235 begin236 Condition := ReadNext <> ReadNext;237 end;238 239 procedure TCPU.OpcodeTestGreatEqual;240 begin241 Condition := ReadNext >= ReadNext;242 end;243 244 procedure TCPU.OpcodeTestGreat;245 begin246 Condition := ReadNext > ReadNext;247 end;248 249 procedure TCPU.OpcodeTestLessEqual;250 begin251 Condition := ReadNext <= ReadNext;252 end;253 254 procedure TCPU.OpcodeTestLess;255 begin256 Condition := ReadNext < ReadNext;257 end;258 259 procedure TCPU.OpcodeJumpCond;260 var261 Addr: T;262 begin263 Addr := ReadNext;264 if Condition then IP := Addr;265 end;266 267 268 procedure TCPU.OpcodeJumpRelCond;269 var270 Addr: T;271 begin272 Addr := ReadNext;273 if Condition then IP := IP + Addr;274 end;275 276 procedure TCPU.OpcodeRor;277 var278 P1, P2: T;279 begin280 P1 := ReadNext;281 P2 := ReadNext;282 Registers[P1] := (Registers[P1] shr Registers[P2]) or283 ((Registers[P1] and ((1 shl Registers[P2]) - 1)) shl (SizeOf(T) * 8 - Registers[P2]));284 end;285 286 procedure TCPU.OpcodeRol;287 var288 P1, P2: T;289 begin290 P1 := ReadNext;291 P2 := ReadNext;292 Registers[P1] := (Registers[P1] shl Registers[P2]) or293 ((Registers[P1] shr (SizeOf(T) * 8 - Registers[P2])) and ((1 shl Registers[P2]) - 1));294 end;295 296 procedure TCPU.OpcodeShl;297 var298 P1, P2: T;299 begin300 P1 := ReadNext;301 P2 := ReadNext;302 Registers[P1] := Registers[P1] shl Registers[P2];303 end;304 305 procedure TCPU.OpcodeShr;306 var307 P1, P2: T;308 begin309 P1 := ReadNext;310 P2 := ReadNext;311 Registers[P1] := Registers[P1] shr Registers[P2];312 end;313 314 procedure TCPU.OpcodeAnd;315 var316 P1, P2: T;317 begin318 P1 := ReadNext;319 P2 := ReadNext;320 Registers[P1] := Registers[P1] and Registers[P2];321 end;322 323 procedure TCPU.OpcodeOr;324 var325 P1, P2: T;326 begin327 P1 := ReadNext;328 P2 := ReadNext;329 Registers[P1] := Registers[P1] or Registers[P2];330 end;331 332 procedure TCPU.OpcodeXor;333 var334 P1, P2: T;335 begin336 P1 := ReadNext;337 P2 := ReadNext;338 Registers[P1] := Registers[P1] xor Registers[P2];339 end;340 341 procedure TCPU.OpcodePush;342 var343 P1: T;344 begin345 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 begin352 SP := SP + Registers[ReadNext].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(SP)));353 end;354 355 procedure TCPU.OpcodeCall;356 var357 Addr: T;358 begin359 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 var367 Addr: T;368 begin369 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 begin377 SP := SP + IP.ReadFromAddr(Pointer(NativeUInt(Memory) + SP));378 end;379 380 procedure TCPU.OpcodeOutput;381 var382 R1: T;383 R2: T;384 begin385 R1 := ReadNext;386 R2 := ReadNext;387 if Assigned(FOnOutput) then388 FOnOutput(Registers[R1], Registers[R2]);389 end;390 391 procedure TCPU.OpcodeInput;392 var393 R1: T;394 R2: T;395 begin396 R1 := ReadNext;397 R2 := ReadNext;398 if Assigned(FOnInput) then399 Registers[R1] := FOnInput(Registers[R2]);400 end;401 402 procedure TCPU.OpcodeInc;403 var404 R: T;405 begin406 R := ReadNext;407 Registers[R] := Registers[R] + 1;408 end;409 410 procedure TCPU.OpcodeDec;411 var412 R: T;413 begin414 R := ReadNext;415 Registers[R] := Registers[R] - 1;416 end;417 418 procedure TCPU.OpcodeAdd;419 var420 R1: T;421 R2: T;422 begin423 R1 := ReadNext;424 R2 := ReadNext;425 Registers[R1] := Registers[R1] + Registers[R2];426 end;427 428 procedure TCPU.OpcodeSub;429 var430 R1: T;431 R2: T;432 begin433 R1 := ReadNext;434 R2 := ReadNext;435 Registers[R1] := Registers[R1] - Registers[R2];436 end;437 438 procedure TCPU.OpcodeMul;439 var440 R1: T;441 R2: T;442 begin443 R1 := ReadNext;444 R2 := ReadNext;445 Registers[R1] := Registers[R1] * Registers[R2];446 end;447 448 procedure TCPU.OpcodeDiv;449 var450 R1: T;451 R2: T;452 begin453 R1 := ReadNext;454 R2 := ReadNext;455 Registers[R1] := Registers[R1] div Registers[R2];456 end;457 458 procedure TCPU.OpcodeLdir;459 var460 Src: T;461 Dst: T;462 Count: T;463 Bytes: T;464 begin465 Src := ReadNext;466 Dst := ReadNext;467 Count := ReadNext;468 Bytes := ReadNext;469 while Registers[Count] > 0 do begin470 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 var480 Src: T;481 Dst: T;482 Count: T;483 Bytes: T;484 begin485 Src := ReadNext;486 Dst := ReadNext;487 Count := ReadNext;488 Bytes := ReadNext;489 while Registers[Count] > 0 do begin490 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 begin500 Terminated := False;501 Ticks := 0;502 IP := 0;503 SP := MemSize(Memory);504 while not Terminated do505 Step;506 end;507 508 procedure TCPU.Stop;509 begin510 Terminated := True;511 end;512 513 procedure TCPU.Step;514 var515 Opcode: T;516 begin517 Opcode := ReadNext;518 if (Opcode >= 0) and (Opcode <= T(Integer(High(TOpcode)))) then519 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 begin526 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 570 114 end. 571 115 -
branches/virtcpu varint/UVarInt.pas
r196 r197 39 39 class operator Multiply(A: TVarInt; B: TVarInt): TVarInt; 40 40 class operator IntDivide(A: TVarInt; B: TVarInt): TVarInt; 41 class operator Modulus(A: TVarInt; B: TVarInt): TVarInt; 41 42 class operator Subtract(A: TVarInt; B: TVarInt): TVarInt; 42 43 class operator Equal(A: TVarInt; B: TVarInt): Boolean; … … 67 68 class operator Implicit(A: TVarUInt): Byte; 68 69 class operator Implicit(A: TVarUInt): Char; 70 class operator Implicit(A: TVarUInt): TVarInt; 69 71 class operator Implicit(A: Byte): TVarUInt; 70 72 class operator Implicit(A: Integer): TVarUInt; 71 73 class operator Implicit(A: Int64): TVarUInt; 72 74 class operator Implicit(A: QWord): TVarUInt; 75 class operator Implicit(A: TVarInt): TVarUInt; 73 76 class operator Explicit(A: Byte): TVarUInt; 74 77 class operator Explicit(A: Integer): TVarUInt; … … 83 86 class operator Multiply(A: TVarUInt; B: TVarUInt): TVarUInt; 84 87 class operator IntDivide(A: TVarUInt; B: TVarUInt): TVarUInt; 88 class operator Modulus(A: TVarUInt; B: TVarUInt): TVarUInt; 85 89 class operator Subtract(A: TVarUInt; B: TVarUInt): TVarUInt; 86 90 class operator Equal(A: TVarUInt; B: TVarUInt): Boolean; … … 148 152 end; 149 153 154 class operator TVarUInt.Implicit(A: TVarUInt): TVarInt; 155 begin 156 Result.Value := A.Value; 157 end; 158 150 159 class operator TVarUInt.Implicit(A: Byte): TVarUInt; 151 160 begin … … 168 177 end; 169 178 179 class operator TVarUInt.Implicit(A: TVarInt): TVarUInt; 180 begin 181 Result.Value := A.Value; 182 end; 183 170 184 class operator TVarUInt.Explicit(A: Byte): TVarUInt; 171 185 begin … … 226 240 begin 227 241 Result.Value := A.Value div B.Value; 242 end; 243 244 class operator TVarUInt.Modulus(A: TVarUInt; B: TVarUInt): TVarUInt; 245 begin 246 Result.Value := A.Value mod B.Value; 228 247 end; 229 248 … … 466 485 end; 467 486 487 class operator TVarInt.Modulus(A: TVarInt; B: TVarInt): TVarInt; 488 begin 489 Result.Value := A.Value mod B.Value; 490 end; 491 468 492 class operator TVarInt.Subtract(A: TVarInt; B: TVarInt): TVarInt; 469 493 begin 470 Result.Value := A.Value - B.Value 494 Result.Value := A.Value - B.Value; 471 495 end; 472 496 -
branches/virtcpu varint/virtcpu.lpi
r196 r197 23 23 <SearchPaths> 24 24 <IncludeFiles Value="$(ProjOutDir)"/> 25 <OtherUnitFiles Value="Forms"/> 25 26 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 26 27 </SearchPaths> … … 64 65 </Item1> 65 66 </RequiredPackages> 66 <Units Count=" 5">67 <Units Count="16"> 67 68 <Unit0> 68 69 <Filename Value="virtcpu.lpr"/> … … 70 71 </Unit0> 71 72 <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"/> 77 75 </Unit1> 78 76 <Unit2> 79 <Filename Value="U Machine.pas"/>77 <Filename Value="UInstructionWriter.pas"/> 80 78 <IsPartOfProject Value="True"/> 81 79 </Unit2> 82 80 <Unit3> 83 <Filename Value="U InstructionWriter.pas"/>81 <Filename Value="UVarInt.pas"/> 84 82 <IsPartOfProject Value="True"/> 85 83 </Unit3> 86 84 <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"/> 89 90 </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> 90 151 </Units> 91 152 </ProjectOptions> … … 98 159 <SearchPaths> 99 160 <IncludeFiles Value="$(ProjOutDir)"/> 161 <OtherUnitFiles Value="Forms"/> 100 162 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 101 163 </SearchPaths> -
branches/virtcpu varint/virtcpu.lpr
r196 r197 8 8 {$ENDIF}{$ENDIF} 9 9 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; 12 13 13 14 {$R *.res} 14 15 15 16 begin 16 RequireDerivedFormResource :=True;17 RequireDerivedFormResource := True; 17 18 Application.Initialize; 18 19 Application.CreateForm(TFormMain, FormMain);
Note:
See TracChangeset
for help on using the changeset viewer.