source: trunk/Target/UTargetInterpretter.pas @ 112

Last change on this file since 112 was 112, checked in by chronos, 15 months ago
  • Modified: Redraw output form content only if output instruction was used in interpretter mode.
  • Modified: Redraw memory form content only if memory was written in interpretter mode.
  • Fixed: Replace windows newlines by unix newlines in interpretter output under Linux.
File size: 13.3 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
78const
79  BrainFuckCommandText: array[TMachineCommand] of Char = (
80    ' ', '+', '-', '>', '<', '.', ',', '[', ']', '@', '=', '*');
81
82
83implementation
84
85resourcestring
86  SProgramLowerLimit = 'Program run over lower limit';
87  SProgramUpperLimit = 'Program run over upper limit';
88  SJumpTableInsistent = 'Jump table is inconsistent';
89  SJumpTableColision = 'Jump table colision';
90  SProgramNotRunning = 'Program not running';
91  SUnsupportedCommand = 'Unsupported command';
92
93{ TTargetInterpretterThread }
94
95procedure TTargetInterpretterThread.Execute;
96var
97  BreakPoint: TBreakPoint;
98begin
99  with Parent do
100  repeat
101    while (FProgramIndex < Length(FProgram)) and (State <> rsStopped) do begin
102      if State = rsRunning then begin
103        if FProgramBreakpoints[FProgramIndex] then begin
104          BreakPoint := BreakPoints.SearchByTargetPos(FProgramIndex);
105          if BreakPoint.System then BreakPoints.Delete(BreakPoints.IndexOf(BreakPoint));
106          SetStateSafe(rsPaused);
107        end else begin
108          if Assigned(FCommandTable[FProgram[FProgramIndex].Command]) then
109            FCommandTable[FProgram[FProgramIndex].Command]
110            else raise Exception.Create(SUnsupportedCommand);
111          Inc(FProgramIndex);
112          Inc(FStepCount);
113        end;
114      end else
115      if State = rsPaused then Sleep(1);
116    end;
117    if State <> rsStopped then SetStateSafe(rsStopped);
118  until Terminated or (State = rsStopped);
119end;
120
121procedure TTargetInterpretterThread.DoSetState;
122begin
123  Parent.State := FNewState;
124end;
125
126procedure TTargetInterpretterThread.SetStateSafe(State: TRunState);
127begin
128  FNewState := State;
129  Synchronize(DoSetState);
130end;
131
132{ TTargetInterpretter }
133
134procedure TTargetInterpretter.SetState(AValue: TRunState);
135begin
136  if FState = AValue then Exit;
137  FState := AValue;
138  if Assigned(FOnChangeState) then FOnChangeState(Self);
139end;
140
141procedure TTargetInterpretter.SetThread(State: Boolean);
142begin
143  if FThreadState = State then Exit;
144  FThreadState := State;
145  if State then begin
146    FThread := TTargetInterpretterThread.Create(True);
147    FThread.Parent := Self;
148    FThread.FreeOnTerminate := False;
149    FThread.Start;
150  end else begin
151    FreeAndNil(FThread);
152  end;
153end;
154
155procedure TTargetInterpretter.PrepareJumpTable;
156var
157  Loop: array of Integer;
158  I: Integer;
159begin
160  for I := 0 to Length(FProgram) - 1 do begin
161    case FProgram[I].Command of
162      cmLoopStart: FProgram[I].Parameter := 0;
163      cmLoopEnd: FProgram[I].Parameter := 0;
164    end;
165  end;
166
167  SetLength(Loop, 0);
168  for I := 0 to Length(FProgram) - 1 do begin
169    case FProgram[I].Command of
170      cmLoopStart: begin
171        SetLength(Loop, Length(Loop) + 1);
172        Loop[High(Loop)] := I;
173      end;
174      cmLoopEnd: begin
175        if FProgram[I].Parameter > 0 then
176          raise Exception.Create(SJumpTableColision);
177        FProgram[I].Parameter := Loop[High(Loop)];
178        if FProgram[Loop[High(Loop)]].Parameter > 0 then
179          raise Exception.Create(SJumpTableColision);
180        FProgram[Loop[High(Loop)]].Parameter := I;
181        SetLength(Loop, Length(Loop) - 1);
182      end;
183    end;
184  end;
185  if Length(Loop) > 0 then raise Exception.Create(SJumpTableInsistent);
186end;
187
188procedure TTargetInterpretter.CommandInput;
189var
190  Addr: Integer;
191begin
192  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
193  while (InputPosition > Length(Input)) and (FState <> rsStopped) do begin
194    Sleep(1);
195  end;
196  if InputPosition <= Length(Input) then begin
197    Memory[Addr] := Ord(Input[InputPosition]);
198    Inc(InputPosition);
199    MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
200    MemoryChanged := True;
201  end;
202end;
203
204procedure TTargetInterpretter.CommandOutput;
205begin
206  if OutputPosition > Length(Output) then
207    SetLength(Output, Length(Output) + 1);
208  Output[OutputPosition] := Char(Memory[MemoryPosition +
209    FProgram[FProgramIndex].RelIndex]);
210  Inc(OutputPosition);
211  OutputChanged := True;
212end;
213
214procedure TTargetInterpretter.CommandLoopStart;
215begin
216  if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] = 0 then
217    FProgramIndex := FProgram[FProgramIndex].Parameter;
218end;
219
220procedure TTargetInterpretter.CommandLoopEnd;
221begin
222  if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] > 0 then
223    FProgramIndex := FProgram[FProgramIndex].Parameter - 1;
224end;
225
226procedure TTargetInterpretter.CommandInc;
227var
228  Addr: Integer;
229begin
230  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
231  Memory[Addr] := ((Memory[Addr] + FProgram[FProgramIndex].Parameter) mod CellSize);
232  MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
233  MemoryChanged := True;
234end;
235
236procedure TTargetInterpretter.CommandDec;
237var
238  Addr: Integer;
239begin
240  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
241  Memory[Addr] := ((Memory[Addr] - FProgram[FProgramIndex].Parameter) mod CellSize);
242  MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
243  MemoryChanged := True;
244end;
245
246procedure TTargetInterpretter.CommandPointerInc;
247begin
248  if MemoryPosition < MemorySize then Inc(MemoryPosition, FProgram[FProgramIndex].Parameter)
249    else raise Exception.Create(SProgramUpperLimit);
250end;
251
252procedure TTargetInterpretter.CommandPointerDec;
253begin
254  if MemoryPosition > 0 then Dec(MemoryPosition, FProgram[FProgramIndex].Parameter)
255    else raise Exception.Create(SProgramLowerLimit);
256end;
257
258procedure TTargetInterpretter.CommandSet;
259var
260  Addr: Integer;
261begin
262  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
263  Memory[Addr] := FProgram[FProgramIndex].Parameter mod CellSize;
264  MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
265  MemoryChanged := True;
266end;
267
268procedure TTargetInterpretter.CommandMultiply;
269var
270  Addr: Integer;
271begin
272  Addr := MemoryPosition + FProgram[FProgramIndex].RelIndex;
273  Memory[Addr] := (Memory[Addr] + Memory[MemoryPosition] *
274    FProgram[FProgramIndex].Parameter) mod CellSize;
275  MemoryMaxUsedAddr := Max(Addr, MemoryMaxUsedAddr);
276  MemoryChanged := True;
277end;
278
279procedure TTargetInterpretter.Reset;
280var
281  I: Integer;
282begin
283  inherited;
284  SetLength(Memory, MemorySize);
285  PrepareJumpTable;
286  FProgramIndex := 0;
287  InputPosition := 1;
288  Output := '';
289  OutputPosition := 1;
290  MemoryPosition := 0;
291  MemoryMaxUsedAddr := 0;
292  //FillChar(Pointer(Memory)^, Length(Memory), 0);
293  for I := 0 to Length(Memory) - 1 do
294    Memory[I] := 0;
295  MemoryChanged := True;
296  FStepCount := 0;
297  PrepareBreakPoints;
298end;
299
300procedure TTargetInterpretter.Compile;
301begin
302  inherited;
303end;
304
305procedure TTargetInterpretter.PrepareBreakPoints;
306var
307  I: Integer;
308begin
309  SetLength(FProgramBreakpoints, Length(FProgram));
310  for I := 0 to High(FProgramBreakpoints) do
311    FProgramBreakpoints[I] := False;
312  for I := 0 to BreakPoints.Count - 1 do
313    if TBreakPoint(BreakPoints[I]).TargetAddress < Length(FProgramBreakpoints) then
314      FProgramBreakpoints[TBreakPoint(BreakPoints[I]).TargetAddress] := True;
315end;
316
317function TTargetInterpretter.GetTargetCode: string;
318var
319  I: Integer;
320begin
321  Result := '';
322  for I := 0 to Length(FProgram) - 1 do begin
323    Result := Result + BrainFuckCommandText[FProgram[I].Command];
324    if FProgram[I].Command in [cmInc, cmDec, cmPointerInc, cmPointerDec,
325      cmSet, cmMultipy] then begin
326      if FProgram[I].Parameter <> 1 then
327        Result := Result + IntToStr(FProgram[I].Parameter);
328    end;
329    if FProgram[I].RelIndex <> 0 then
330      Result := Result + 'R' + IntToStr(FProgram[I].RelIndex);
331  end;
332end;
333
334function TTargetInterpretter.GetExecutionPosition: Integer;
335begin
336  Result := FProgramIndex;
337end;
338
339procedure TTargetInterpretter.OptimizeSource;
340begin
341  inherited OptimizeSource;
342end;
343
344procedure TTargetInterpretter.Run;
345begin
346  PrepareBreakPoints;
347  if FState = rsStopped then begin
348    Reset;
349    SetThread(False);
350    SetThread(True);
351    State := rsRunning;
352  end else State := rsRunning;
353end;
354
355procedure TTargetInterpretter.Pause;
356begin
357  if State = rsRunning then State := rsPaused;
358end;
359
360procedure TTargetInterpretter.Stop;
361begin
362  State := rsStopped;
363  SetThread(False);
364end;
365
366procedure TTargetInterpretter.StepInto;
367var
368  Step: TDebugStep;
369begin
370  if State = rsPaused then begin
371    Step := DebugSteps.SearchByTargetPos(FProgramIndex);
372    if Step.Operation = soStepOut then begin
373      BreakPoints.SetSystem(Step.TargetPosition + 1);
374      Step := DebugSteps.SearchByTargetPos(FProgram[Step.TargetPosition].Parameter);
375      BreakPoints.AddSystem(Step.TargetPosition);
376    end else
377    if Step.Operation = soStepIn then begin
378      BreakPoints.SetSystem(Step.TargetPosition + 1);
379      Step := DebugSteps.SearchByTargetPos(FProgram[Step.TargetPosition].Parameter);
380      BreakPoints.AddSystem(Step.TargetPosition);
381    end else BreakPoints.SetSystem(Step.TargetPosition + 1);
382    Run;
383  end else raise Exception.Create(SProgramNotRunning);
384end;
385
386procedure TTargetInterpretter.StepOver;
387var
388  Step: TDebugStep;
389begin
390  if State = rsPaused then begin
391    Step := DebugSteps.SearchByTargetPos(FProgramIndex);
392    if Step.Operation = soStepOut then begin
393      BreakPoints.SetSystem(Step.TargetPosition + 1);
394      Step := DebugSteps.SearchByTargetPos(FProgram[Step.TargetPosition].Parameter);
395      BreakPoints.AddSystem(Step.TargetPosition);
396    end else
397    if Step.Operation = soStepIn then begin
398      Step := DebugSteps.SearchByTargetPos(FProgram[Step.TargetPosition].Parameter);
399      BreakPoints.SetSystem(Step.TargetPosition + 1);
400    end else BreakPoints.SetSystem(Step.TargetPosition + 1);
401    Run;
402  end else raise Exception.Create(SProgramNotRunning);
403end;
404
405procedure TTargetInterpretter.StepOut;
406var
407  Step: TDebugStep;
408  StepIndex: Integer;
409  Nesting: Integer;
410begin
411  if State = rsPaused then begin
412    Step := DebugSteps.SearchByTargetPos(FProgramIndex);
413    StepIndex := DebugSteps.IndexOf(Step);
414    Nesting := 1;
415    while (StepIndex < DebugSteps.Count) and (Nesting > 0) do begin
416      if TDebugStep(DebugSteps[StepIndex]).Operation = soStepIn then Inc(Nesting);
417      if TDebugStep(DebugSteps[StepIndex]).Operation = soStepOut then Dec(Nesting);
418      Inc(StepIndex);
419    end;
420    if StepIndex < DebugSteps.Count then begin
421      Breakpoints.SetSystem(TDebugStep(DebugSteps[StepIndex]).TargetPosition);
422    end;
423    Run;
424  end else raise Exception.Create(SProgramNotRunning);
425end;
426
427procedure TTargetInterpretter.RunToCursor(Pos: Integer);
428begin
429  Breakpoints.SetSystem(Pos);
430  Run;
431end;
432
433constructor TTargetInterpretter.Create;
434begin
435  inherited;
436  Name := 'Interpretter';
437  ImageIndex := 25;
438  Capabilities := [tcRun, tcPause, tcStop, tcCompile, tcStepOut, tcStepInto,
439    tcStepOver, tcRunToCursor];
440  // Base commands
441  FCommandTable[cmInc] := CommandInc;
442  FCommandTable[cmDec] := CommandDec;
443  FCommandTable[cmPointerInc] := CommandPointerInc;
444  FCommandTable[cmPointerDec] := CommandPointerDec;
445  FCommandTable[cmOutput] := CommandOutput;
446  FCommandTable[cmInput] := CommandInput;
447  FCommandTable[cmLoopStart] := CommandLoopStart;
448  FCommandTable[cmLoopEnd] := CommandLoopEnd;
449  // Extended commands
450  FCommandTable[cmSet] := CommandSet;
451  FCommandTable[cmMultipy] := CommandMultiply;
452end;
453
454destructor TTargetInterpretter.Destroy;
455begin
456  FState := rsStopped;
457  SetThread(False);
458  inherited Destroy;
459end;
460
461end.
462
Note: See TracBrowser for help on using the repository browser.