Changeset 152 for trunk/Target
- Timestamp:
- Jun 6, 2024, 9:10:15 PM (7 months ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/Target/TargetInterpreter.pas
r151 r152 1 unit TargetInterpret ter;1 unit TargetInterpreter; 2 2 3 3 interface … … 7 7 8 8 type 9 TTargetInterpret ter = class;10 11 { TTargetInterpret terThread }12 13 TTargetInterpret terThread = class(TThread)9 TTargetInterpreter = class; 10 11 { TTargetInterpreterThread } 12 13 TTargetInterpreterThread = class(TThread) 14 14 private 15 15 FNewState: TRunState; … … 19 19 procedure SetStateSafe(State: TRunState); 20 20 public 21 Parent: TTargetInterpret ter;21 Parent: TTargetInterpreter; 22 22 procedure Execute; override; 23 23 end; … … 25 25 TCommandHandler = procedure of object; 26 26 27 { TTargetInterpret ter }28 29 TTargetInterpret ter = class(TBFTarget)27 { TTargetInterpreter } 28 29 TTargetInterpreter = class(TBFTarget) 30 30 private 31 31 FThreadState: Boolean; 32 FThread: TTargetInterpret terThread;32 FThread: TTargetInterpreterThread; 33 33 FStepCount: Integer; 34 34 FCommandTable: array[TMachineCommand] of TCommandHandler; … … 89 89 SBreakPointIndexError = 'Break point index error: %d'; 90 90 91 { TTargetInterpret terThread }92 93 procedure TTargetInterpret terThread.Execute;91 { TTargetInterpreterThread } 92 93 procedure TTargetInterpreterThread.Execute; 94 94 var 95 95 BreakPoint: TBreakPoint; … … 130 130 end; 131 131 132 procedure TTargetInterpret terThread.DoMessage;132 procedure TTargetInterpreterThread.DoMessage; 133 133 begin 134 134 Parent.SendMessage(FMessage); 135 135 end; 136 136 137 procedure TTargetInterpret terThread.DoSetState;137 procedure TTargetInterpreterThread.DoSetState; 138 138 begin 139 139 Parent.State := FNewState; 140 140 end; 141 141 142 procedure TTargetInterpret terThread.SetStateSafe(State: TRunState);142 procedure TTargetInterpreterThread.SetStateSafe(State: TRunState); 143 143 begin 144 144 if Parent.State = State then Exit; … … 147 147 end; 148 148 149 { TTargetInterpret ter }150 151 procedure TTargetInterpret ter.SetState(AValue: TRunState);149 { TTargetInterpreter } 150 151 procedure TTargetInterpreter.SetState(AValue: TRunState); 152 152 begin 153 153 if FState = AValue then Exit; … … 156 156 end; 157 157 158 procedure TTargetInterpret ter.SetThread(State: Boolean);158 procedure TTargetInterpreter.SetThread(State: Boolean); 159 159 begin 160 160 if FThreadState = State then Exit; 161 161 FThreadState := State; 162 162 if State then begin 163 FThread := TTargetInterpret terThread.Create(True);163 FThread := TTargetInterpreterThread.Create(True); 164 164 FThread.Parent := Self; 165 165 FThread.FreeOnTerminate := False; … … 170 170 end; 171 171 172 procedure TTargetInterpret ter.PrepareJumpTable;172 procedure TTargetInterpreter.PrepareJumpTable; 173 173 type 174 174 TArrayOfInteger = array of Integer; … … 205 205 end; 206 206 207 procedure TTargetInterpret ter.CommandInput;207 procedure TTargetInterpreter.CommandInput; 208 208 var 209 209 Addr: Integer; … … 221 221 end; 222 222 223 procedure TTargetInterpret ter.CommandOutput;223 procedure TTargetInterpreter.CommandOutput; 224 224 begin 225 225 if OutputPosition > Length(Output) then … … 231 231 end; 232 232 233 procedure TTargetInterpret ter.CommandLoopStart;233 procedure TTargetInterpreter.CommandLoopStart; 234 234 begin 235 235 if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] = 0 then … … 237 237 end; 238 238 239 procedure TTargetInterpret ter.CommandLoopEnd;239 procedure TTargetInterpreter.CommandLoopEnd; 240 240 begin 241 241 if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] > 0 then … … 243 243 end; 244 244 245 procedure TTargetInterpret ter.CommandInc;245 procedure TTargetInterpreter.CommandInc; 246 246 var 247 247 Addr: Integer; … … 253 253 end; 254 254 255 procedure TTargetInterpret ter.CommandDec;255 procedure TTargetInterpreter.CommandDec; 256 256 var 257 257 Addr: Integer; … … 263 263 end; 264 264 265 procedure TTargetInterpret ter.CommandPointerInc;265 procedure TTargetInterpreter.CommandPointerInc; 266 266 begin 267 267 if MemoryPosition < MemorySize then … … 270 270 end; 271 271 272 procedure TTargetInterpret ter.CommandPointerDec;272 procedure TTargetInterpreter.CommandPointerDec; 273 273 begin 274 274 if MemoryPosition > 0 then … … 277 277 end; 278 278 279 procedure TTargetInterpret ter.CommandSet;279 procedure TTargetInterpreter.CommandSet; 280 280 var 281 281 Addr: Integer; … … 288 288 end; 289 289 290 procedure TTargetInterpret ter.CommandMultiply;290 procedure TTargetInterpreter.CommandMultiply; 291 291 var 292 292 Addr: Integer; … … 300 300 end; 301 301 302 procedure TTargetInterpret ter.Reset;302 procedure TTargetInterpreter.Reset; 303 303 var 304 304 I: Integer; … … 322 322 end; 323 323 324 procedure TTargetInterpret ter.Compile;324 procedure TTargetInterpreter.Compile; 325 325 begin 326 326 inherited; … … 328 328 end; 329 329 330 procedure TTargetInterpret ter.PrepareBreakPoints;330 procedure TTargetInterpreter.PrepareBreakPoints; 331 331 var 332 332 I: Integer; … … 340 340 end; 341 341 342 procedure TTargetInterpret ter.CheckMemoryBounds(Address: Integer);342 procedure TTargetInterpreter.CheckMemoryBounds(Address: Integer); 343 343 begin 344 344 if Address < 0 then raise Exception.Create(SProgramLowerMemoryLimit); … … 346 346 end; 347 347 348 procedure TTargetInterpret ter.EmitTargetCode;348 procedure TTargetInterpreter.EmitTargetCode; 349 349 var 350 350 I: Integer; … … 369 369 end; 370 370 371 function TTargetInterpret ter.GetExecutionPosition: Integer;371 function TTargetInterpreter.GetExecutionPosition: Integer; 372 372 begin 373 373 Result := FProgramIndex; 374 374 end; 375 375 376 procedure TTargetInterpret ter.OptimizeSource;376 procedure TTargetInterpreter.OptimizeSource; 377 377 begin 378 378 inherited; 379 379 end; 380 380 381 procedure TTargetInterpret ter.Run;381 procedure TTargetInterpreter.Run; 382 382 begin 383 383 PrepareBreakPoints; … … 390 390 end; 391 391 392 procedure TTargetInterpret ter.Pause;392 procedure TTargetInterpreter.Pause; 393 393 begin 394 394 if State = rsRunning then State := rsPaused; 395 395 end; 396 396 397 procedure TTargetInterpret ter.Stop;397 procedure TTargetInterpreter.Stop; 398 398 begin 399 399 State := rsStopped; … … 401 401 end; 402 402 403 procedure TTargetInterpret ter.StepInto;403 procedure TTargetInterpreter.StepInto; 404 404 var 405 405 Step: TDebugStep; … … 421 421 end; 422 422 423 procedure TTargetInterpret ter.StepOver;423 procedure TTargetInterpreter.StepOver; 424 424 var 425 425 Step: TDebugStep; … … 440 440 end; 441 441 442 procedure TTargetInterpret ter.StepOut;442 procedure TTargetInterpreter.StepOut; 443 443 var 444 444 Step: TDebugStep; … … 462 462 end; 463 463 464 procedure TTargetInterpret ter.RunToCursor(Pos: Integer);464 procedure TTargetInterpreter.RunToCursor(Pos: Integer); 465 465 begin 466 466 Breakpoints.SetSystem(Pos); … … 468 468 end; 469 469 470 constructor TTargetInterpret ter.Create;470 constructor TTargetInterpreter.Create; 471 471 begin 472 472 inherited; 473 FName := 'Interpret ter';473 FName := 'Interpreter'; 474 474 FImageIndex := 25; 475 475 FCapabilities := [tcRun, tcPause, tcStop, tcCompile, tcStepOut, tcStepInto, … … 489 489 end; 490 490 491 destructor TTargetInterpret ter.Destroy;491 destructor TTargetInterpreter.Destroy; 492 492 begin 493 493 FState := rsStopped;
Note:
See TracChangeset
for help on using the changeset viewer.