source: trunk/Target/UTargetInterpretter.pas @ 114

Last change on this file since 114 was 114, checked in by chronos, 15 months ago
  • Modified: Improved stepping through source and target code. Each step has source, program and target index.
File size: 12.8 KB
Line 
1unit UTargetInterpretter;
2
3{$mode Delphi}{$H+}
4
5interface
6
7uses
8  Classes, SysUtils, Dialogs, Forms, UTarget, UBFTarget, Math;
9
10type
11  TTargetInterpretter = class;
12
13  { TTargetInterpretterThread }
14
15  TTargetInterpretterThread = class(TThread)
16  private
17    FNewState: TRunState;
18    procedure DoSetState;
19    procedure SetStateSafe(State: TRunState);
20  public
21    Parent: TTargetInterpretter;
22    procedure Execute; override;
23  end;
24
25  TCommandHandler = procedure of object;
26
27  { TTargetInterpretter }
28
29  TTargetInterpretter = class(TBFTarget)
30  private
31    FThreadState: Boolean;
32    FThread: TTargetInterpretterThread;
33    FStepCount: Integer;
34    FCommandTable: array[TMachineCommand] of TCommandHandler;
35    procedure SetThread(State: Boolean);
36    procedure PrepareJumpTable;
37    procedure CommandInc;
38    procedure CommandDec;
39    procedure CommandPointerInc;
40    procedure CommandPointerDec;
41    procedure CommandInput;
42    procedure CommandOutput;
43    procedure CommandLoopStart;
44    procedure CommandLoopEnd;
45    procedure CommandSet;
46    procedure CommandMultiply;
47    procedure PrepareBreakPoints;
48  protected
49    procedure SetState(AValue: TRunState); override;
50    function GetTargetCode: string; override;
51    function GetExecutionPosition: Integer; override;
52  public
53    FProgramBreakpoints: array of Boolean;
54    SourceBreakpoint: array of Boolean;
55    Memory: array of Integer;
56    MemoryPosition: Integer;
57    MemoryChanged: Boolean;
58    Output: string;
59    OutputPosition: Integer;
60    OutputChanged: Boolean;
61    Input: string;
62    InputPosition: Integer;
63    procedure OptimizeSource; override;
64    procedure Reset; override;
65    procedure Compile; override;
66    procedure Run; override;
67    procedure Pause; override;
68    procedure Stop; override;
69    procedure StepInto; override;
70    procedure StepOver; override;
71    procedure StepOut; override;
72    procedure RunToCursor(Pos: Integer); override;
73    constructor Create; override;
74    destructor Destroy; override;
75    property StepCount: Integer read FStepCount;
76  end;
77
78
79implementation
80
81resourcestring
82  SProgramLowerLimit = 'Program run over lower limit';
83  SProgramUpperLimit = 'Program run over upper limit';
84  SJumpTableInsistent = 'Jump table is inconsistent';
85  SJumpTableColision = 'Jump table colision';
86  SProgramNotRunning = 'Program not running';
87  SUnsupportedCommand = 'Unsupported command';
88
89{ TTargetInterpretterThread }
90
91procedure TTargetInterpretterThread.Execute;
92var
93  BreakPoint: TBreakPoint;
94begin
95  with Parent do
96  repeat
97    while (FProgramIndex < Length(FProgram)) and (State <> rsStopped) do begin
98      if State = rsRunning then begin
99        if FProgramBreakpoints[FProgramIndex] then begin
100          BreakPoint := BreakPoints.SearchByTargetPos(FProgramIndex);
101          if BreakPoint.System then BreakPoints.Delete(BreakPoints.IndexOf(BreakPoint));
102          SetStateSafe(rsPaused);
103        end else begin
104          if Assigned(FCommandTable[FProgram[FProgramIndex].Command]) then
105            FCommandTable[FProgram[FProgramIndex].Command]
106            else raise Exception.Create(SUnsupportedCommand);
107          Inc(FProgramIndex);
108          Inc(FStepCount);
109        end;
110      end else
111      if State = rsPaused then Sleep(1);
112    end;
113    if State <> rsStopped then SetStateSafe(rsStopped);
114  until Terminated or (State = rsStopped);
115end;
116
117procedure TTargetInterpretterThread.DoSetState;
118begin
119  Parent.State := FNewState;
120end;
121
122procedure TTargetInterpretterThread.SetStateSafe(State: TRunState);
123begin
124  FNewState := State;
125  Synchronize(DoSetState);
126end;
127
128{ TTargetInterpretter }
129
130procedure TTargetInterpretter.SetState(AValue: TRunState);
131begin
132  if FState = AValue then Exit;
133  FState := AValue;
134  if Assigned(FOnChangeState) then FOnChangeState(Self);
135end;
136
137procedure TTargetInterpretter.SetThread(State: Boolean);
138begin
139  if FThreadState = State then Exit;
140  FThreadState := State;
141  if State then begin
142    FThread := TTargetInterpretterThread.Create(True);
143    FThread.Parent := Self;
144    FThread.FreeOnTerminate := False;
145    FThread.Start;
146  end else begin
147    FreeAndNil(FThread);
148  end;
149end;
150
151procedure TTargetInterpretter.PrepareJumpTable;
152var
153  Loop: array of Integer;
154  I: Integer;
155begin
156  for I := 0 to Length(FProgram) - 1 do begin
157    case FProgram[I].Command of
158      cmLoopStart: FProgram[I].Parameter := 0;
159      cmLoopEnd: FProgram[I].Parameter := 0;
160    end;
161  end;
162
163  SetLength(Loop, 0);
164  for I := 0 to Length(FProgram) - 1 do begin
165    case FProgram[I].Command of
166      cmLoopStart: begin
167        SetLength(Loop, Length(Loop) + 1);
168        Loop[High(Loop)] := I;
169      end;
170      cmLoopEnd: begin
171        if FProgram[I].Parameter > 0 then
172          raise Exception.Create(SJumpTableColision);
173        FProgram[I].Parameter := Loop[High(Loop)];
174        if FProgram[Loop[High(Loop)]].Parameter > 0 then
175          raise Exception.Create(SJumpTableColision);
176        FProgram[Loop[High(Loop)]].Parameter := I;
177        SetLength(Loop, Length(Loop) - 1);
178      end;
179    end;
180  end;
181  if Length(Loop) > 0 then raise Exception.Create(SJumpTableInsistent);
182end;
183
184procedure TTargetInterpretter.CommandInput;
185var
186  Addr: Integer;
187begin
188  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
189  while (InputPosition > Length(Input)) and (FState <> rsStopped) do begin
190    Sleep(1);
191  end;
192  if InputPosition <= Length(Input) then begin
193    Memory[Addr] := Ord(Input[InputPosition]);
194    Inc(InputPosition);
195    MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
196    MemoryChanged := True;
197  end;
198end;
199
200procedure TTargetInterpretter.CommandOutput;
201begin
202  if OutputPosition > Length(Output) then
203    SetLength(Output, Length(Output) + 1);
204  Output[OutputPosition] := Char(Memory[MemoryPosition +
205    FProgram[FProgramIndex].RelIndex]);
206  Inc(OutputPosition);
207  OutputChanged := True;
208end;
209
210procedure TTargetInterpretter.CommandLoopStart;
211begin
212  if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] = 0 then
213    FProgramIndex := FProgram[FProgramIndex].Parameter;
214end;
215
216procedure TTargetInterpretter.CommandLoopEnd;
217begin
218  if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] > 0 then
219    FProgramIndex := FProgram[FProgramIndex].Parameter - 1;
220end;
221
222procedure TTargetInterpretter.CommandInc;
223var
224  Addr: Integer;
225begin
226  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
227  Memory[Addr] := ((Memory[Addr] + FProgram[FProgramIndex].Parameter) mod CellSize);
228  MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
229  MemoryChanged := True;
230end;
231
232procedure TTargetInterpretter.CommandDec;
233var
234  Addr: Integer;
235begin
236  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
237  Memory[Addr] := ((Memory[Addr] - FProgram[FProgramIndex].Parameter) mod CellSize);
238  MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
239  MemoryChanged := True;
240end;
241
242procedure TTargetInterpretter.CommandPointerInc;
243begin
244  if MemoryPosition < MemorySize then Inc(MemoryPosition, FProgram[FProgramIndex].Parameter)
245    else raise Exception.Create(SProgramUpperLimit);
246end;
247
248procedure TTargetInterpretter.CommandPointerDec;
249begin
250  if MemoryPosition > 0 then Dec(MemoryPosition, FProgram[FProgramIndex].Parameter)
251    else raise Exception.Create(SProgramLowerLimit);
252end;
253
254procedure TTargetInterpretter.CommandSet;
255var
256  Addr: Integer;
257begin
258  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
259  Memory[Addr] := FProgram[FProgramIndex].Parameter mod CellSize;
260  MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
261  MemoryChanged := True;
262end;
263
264procedure TTargetInterpretter.CommandMultiply;
265var
266  Addr: Integer;
267begin
268  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
269  Memory[Addr] := (Memory[Addr] + Memory[MemoryPosition] *
270    FProgram[FProgramIndex].Parameter) mod CellSize;
271  MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
272  MemoryChanged := True;
273end;
274
275procedure TTargetInterpretter.Reset;
276var
277  I: Integer;
278begin
279  inherited;
280  SetLength(Memory, MemorySize);
281  PrepareJumpTable;
282  FProgramIndex := 0;
283  InputPosition := 1;
284  Output := '';
285  OutputPosition := 1;
286  MemoryPosition := 0;
287  MemoryMaxUsedAddr := 0;
288  //FillChar(Pointer(Memory)^, Length(Memory), 0);
289  for I := 0 to Length(Memory) - 1 do
290    Memory[I] := 0;
291  MemoryChanged := True;
292  FStepCount := 0;
293  PrepareBreakPoints;
294end;
295
296procedure TTargetInterpretter.Compile;
297begin
298  inherited;
299end;
300
301procedure TTargetInterpretter.PrepareBreakPoints;
302var
303  I: Integer;
304begin
305  SetLength(FProgramBreakpoints, Length(FProgram));
306  for I := 0 to High(FProgramBreakpoints) do
307    FProgramBreakpoints[I] := False;
308  for I := 0 to BreakPoints.Count - 1 do
309    if TBreakPoint(BreakPoints[I]).TargetAddress < Length(FProgramBreakpoints) then
310      FProgramBreakpoints[TBreakPoint(BreakPoints[I]).TargetAddress] := True;
311end;
312
313function TTargetInterpretter.GetTargetCode: string;
314var
315  I: Integer;
316begin
317  Result := '';
318  for I := 0 to Length(FProgram) - 1 do begin
319    Result := Result + GetOperationText(FProgram[I]);
320  end;
321end;
322
323function TTargetInterpretter.GetExecutionPosition: Integer;
324begin
325  Result := FProgramIndex;
326end;
327
328procedure TTargetInterpretter.OptimizeSource;
329begin
330  inherited OptimizeSource;
331end;
332
333procedure TTargetInterpretter.Run;
334begin
335  PrepareBreakPoints;
336  if FState = rsStopped then begin
337    Reset;
338    SetThread(False);
339    SetThread(True);
340    State := rsRunning;
341  end else State := rsRunning;
342end;
343
344procedure TTargetInterpretter.Pause;
345begin
346  if State = rsRunning then State := rsPaused;
347end;
348
349procedure TTargetInterpretter.Stop;
350begin
351  State := rsStopped;
352  SetThread(False);
353end;
354
355procedure TTargetInterpretter.StepInto;
356var
357  Step: TDebugStep;
358begin
359  if State = rsPaused then begin
360    Step := DebugSteps.SearchByProgramPos(FProgramIndex);
361    if Step.Operation = soStepOut then begin
362      BreakPoints.SetSystem(Step.ProgramPosition + 1);
363      Step := DebugSteps.SearchByProgramPos(FProgram[Step.ProgramPosition].Parameter);
364      BreakPoints.AddSystem(Step.ProgramPosition);
365    end else
366    if Step.Operation = soStepIn then begin
367      BreakPoints.SetSystem(Step.ProgramPosition + 1);
368      Step := DebugSteps.SearchByProgramPos(FProgram[Step.ProgramPosition].Parameter);
369      BreakPoints.AddSystem(Step.ProgramPosition);
370    end else BreakPoints.SetSystem(Step.ProgramPosition + 1);
371    Run;
372  end else raise Exception.Create(SProgramNotRunning);
373end;
374
375procedure TTargetInterpretter.StepOver;
376var
377  Step: TDebugStep;
378begin
379  if State = rsPaused then begin
380    Step := DebugSteps.SearchByProgramPos(FProgramIndex);
381    if Step.Operation = soStepOut then begin
382      BreakPoints.SetSystem(Step.ProgramPosition + 1);
383      Step := DebugSteps.SearchByProgramPos(FProgram[Step.ProgramPosition].Parameter);
384      BreakPoints.AddSystem(Step.ProgramPosition);
385    end else
386    if Step.Operation = soStepIn then begin
387      Step := DebugSteps.SearchByProgramPos(FProgram[Step.ProgramPosition].Parameter);
388      BreakPoints.SetSystem(Step.ProgramPosition + 1);
389    end else BreakPoints.SetSystem(Step.ProgramPosition + 1);
390    Run;
391  end else raise Exception.Create(SProgramNotRunning);
392end;
393
394procedure TTargetInterpretter.StepOut;
395var
396  Step: TDebugStep;
397  StepIndex: Integer;
398  Nesting: Integer;
399begin
400  if State = rsPaused then begin
401    Step := DebugSteps.SearchByProgramPos(FProgramIndex);
402    StepIndex := DebugSteps.IndexOf(Step);
403    Nesting := 1;
404    while (StepIndex < DebugSteps.Count) and (Nesting > 0) do begin
405      if TDebugStep(DebugSteps[StepIndex]).Operation = soStepIn then Inc(Nesting);
406      if TDebugStep(DebugSteps[StepIndex]).Operation = soStepOut then Dec(Nesting);
407      Inc(StepIndex);
408    end;
409    if StepIndex < DebugSteps.Count then begin
410      Breakpoints.SetSystem(TDebugStep(DebugSteps[StepIndex]).ProgramPosition);
411    end;
412    Run;
413  end else raise Exception.Create(SProgramNotRunning);
414end;
415
416procedure TTargetInterpretter.RunToCursor(Pos: Integer);
417begin
418  Breakpoints.SetSystem(Pos);
419  Run;
420end;
421
422constructor TTargetInterpretter.Create;
423begin
424  inherited;
425  Name := 'Interpretter';
426  ImageIndex := 25;
427  Capabilities := [tcRun, tcPause, tcStop, tcCompile, tcStepOut, tcStepInto,
428    tcStepOver, tcRunToCursor];
429  // Base commands
430  FCommandTable[cmInc] := CommandInc;
431  FCommandTable[cmDec] := CommandDec;
432  FCommandTable[cmPointerInc] := CommandPointerInc;
433  FCommandTable[cmPointerDec] := CommandPointerDec;
434  FCommandTable[cmOutput] := CommandOutput;
435  FCommandTable[cmInput] := CommandInput;
436  FCommandTable[cmLoopStart] := CommandLoopStart;
437  FCommandTable[cmLoopEnd] := CommandLoopEnd;
438  // Extended commands
439  FCommandTable[cmSet] := CommandSet;
440  FCommandTable[cmMultipy] := CommandMultiply;
441end;
442
443destructor TTargetInterpretter.Destroy;
444begin
445  FState := rsStopped;
446  SetThread(False);
447  inherited Destroy;
448end;
449
450end.
451
Note: See TracBrowser for help on using the repository browser.