source: trunk/UBFTarget.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: 18.6 KB
Line 
1unit UBFTarget;
2
3{$mode delphi}
4
5interface
6
7uses
8  Classes, SysUtils, UTarget;
9
10type
11
12  TMachineCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
13    cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug, cmSet, cmMultipy);
14
15  { TMachineOperation }
16
17  TMachineOperation = record
18    Command: TMachineCommand;
19    Parameter: Integer;
20    RelIndex: Integer;
21    function Create(Command: TMachineCommand; Parameter, RelIndex: Integer): TMachineOperation;
22  end;
23
24  TOptimizations = record
25    AddSub: Boolean;
26    Merge: Boolean;
27    RelativeIndexes: Boolean;
28    CopyMultiply: Boolean;
29  end;
30
31  { TBFTarget }
32
33  TBFTarget = class(TTarget)
34  private
35    function CheckClear: Boolean;
36    function CheckOccurenceSumParam(C: TMachineCommand): Integer;
37    function CheckOccurence(C: TMachineCommand): Integer;
38    procedure OptimizeAddSub;
39    procedure OptimizeMerge;
40    procedure OptimizeZeroInitMemory;
41    procedure OptimizeRelativeIndexes;
42    procedure OptimizeCopyMultiply;
43  protected
44    FProgram: array of TMachineOperation;
45    FProgramIndex: Integer;
46    procedure LoadProgram; override;
47  public
48    MemorySize: Integer;
49    MemoryMaxUsedAddr: Integer;
50    CellSize: Integer;
51    Optimizations: TOptimizations;
52    constructor Create; override;
53    procedure OptimizeSource; override;
54    property ProgramIndex: Integer read FProgramIndex;
55  end;
56
57
58implementation
59
60{ TMachineOperation }
61
62function TMachineOperation.Create(Command: TMachineCommand; Parameter,
63  RelIndex: Integer): TMachineOperation;
64begin
65  Result.Command := Command;
66  Result.Parameter := Parameter;
67  Result.RelIndex := RelIndex;
68end;
69
70function TBFTarget.CheckClear: Boolean;
71begin
72  Result := (FProgram[FProgramIndex].Command = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and
73    (((FProgram[FProgramIndex + 1].Command = cmDec) and (FProgram[FProgramIndex + 1].Parameter = 1)) or
74    ((FProgram[FProgramIndex + 1].Command = cmInc) and (FProgram[FProgramIndex + 1].Parameter = -1)))
75    and (FProgram[FProgramIndex + 2].Command = cmLoopEnd);
76end;
77
78function TBFTarget.CheckOccurence(C: TMachineCommand): Integer;
79begin
80  Result := 1;
81  while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
82    Inc(Result);
83    Inc(FProgramIndex);
84  end;
85end;
86
87function TBFTarget.CheckOccurenceSumParam(C: TMachineCommand): Integer;
88begin
89  Result := FProgram[FProgramIndex].Parameter;
90  while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
91    Inc(Result, FProgram[FProgramIndex + 1].Parameter);
92    Inc(FProgramIndex);
93  end;
94end;
95
96procedure TBFTarget.OptimizeAddSub;
97var
98  NewProgram: array of TMachineOperation;
99  NewProgramIndex: Integer;
100begin
101  NewProgramIndex := 0;
102  SetLength(NewProgram, Length(FProgram));
103
104  FProgramIndex := 0;
105  while (FProgramIndex < Length(FProgram)) do begin
106    case FProgram[FProgramIndex].Command of
107      cmPointerInc: begin
108        NewProgram[NewProgramIndex].Command := cmPointerInc;
109        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerInc);
110      end;
111      cmPointerDec: begin
112        NewProgram[NewProgramIndex].Command := cmPointerDec;
113        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerDec);
114      end;
115      cmInc: begin
116        NewProgram[NewProgramIndex].Command := cmInc;
117        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmInc);
118      end;
119      cmDec: begin
120        NewProgram[NewProgramIndex].Command := cmDec;
121        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmDec);
122      end;
123      else NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
124    end;
125    DebugSteps.UpdateTargetPos(FProgramIndex, NewProgramIndex);
126    Inc(FProgramIndex);
127    Inc(NewProgramIndex);
128  end;
129  SetLength(NewProgram, NewProgramIndex);
130
131  // Replace old program by new program
132  SetLength(FProgram, Length(NewProgram));
133  Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) * Length(NewProgram));
134end;
135
136procedure TBFTarget.OptimizeMerge;
137var
138  NewProgram: array of TMachineOperation;
139  NewProgramIndex: Integer;
140  PreviousCommand: TMachineCommand;
141begin
142  // Merge together cmInc, cmDec, cmSet
143  // Merge together cmPointerInc, cmPointerDec
144  PreviousCommand := cmNoOperation;
145  NewProgramIndex := 0;
146  SetLength(NewProgram, Length(FProgram));
147
148  FProgramIndex := 0;
149  while (FProgramIndex < Length(FProgram)) do begin
150    case FProgram[FProgramIndex].Command of
151      cmPointerInc: begin
152        if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
153          if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
154            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
155              FProgram[FProgramIndex].Parameter
156          else if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
157            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
158              FProgram[FProgramIndex].Parameter;
159          // If value negative then change command
160          if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
161            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
162            if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
163              NewProgram[NewProgramIndex - 1].Command := cmPointerDec
164              else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
165          end;
166          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
167          Dec(NewProgramIndex);
168        end else begin
169          NewProgram[NewProgramIndex].Command := cmPointerInc;
170          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
171        end;
172      end;
173      cmPointerDec: begin
174        if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
175          if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
176            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
177              FProgram[FProgramIndex].Parameter
178          else if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
179            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
180              FProgram[FProgramIndex].Parameter;
181          // If value negative then change command
182          if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
183            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
184            if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
185              NewProgram[NewProgramIndex - 1].Command := cmPointerDec
186              else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
187          end;
188          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
189          Dec(NewProgramIndex);
190        end else begin
191          NewProgram[NewProgramIndex].Command := cmPointerDec;
192          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
193        end;
194      end;
195      cmInc: begin
196        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
197          if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
198            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
199              FProgram[FProgramIndex].Parameter
200          else if NewProgram[NewProgramIndex - 1].Command = cmDec then
201            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
202              FProgram[FProgramIndex].Parameter;
203          // If value negative then change command
204          if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
205            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
206            if NewProgram[NewProgramIndex - 1].Command = cmInc then
207              NewProgram[NewProgramIndex - 1].Command := cmDec
208              else NewProgram[NewProgramIndex - 1].Command := cmInc;
209          end;
210          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
211          Dec(NewProgramIndex);
212        end else begin
213          NewProgram[NewProgramIndex].Command := cmInc;
214          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
215        end;
216      end;
217      cmDec: begin
218        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
219          if NewProgram[NewProgramIndex - 1].Command = cmDec then
220            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
221              FProgram[FProgramIndex].Parameter
222          else if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
223            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
224              FProgram[FProgramIndex].Parameter;
225          // If value negative then change command
226          if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
227            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
228            if NewProgram[NewProgramIndex - 1].Command = cmInc then
229              NewProgram[NewProgramIndex - 1].Command := cmDec
230              else NewProgram[NewProgramIndex - 1].Command := cmInc;
231          end;
232          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
233          Dec(NewProgramIndex);
234        end else begin
235          NewProgram[NewProgramIndex].Command := cmDec;
236          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
237        end;
238      end;
239      cmSet: begin
240        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
241          // Set overrides value of previous commands
242          Dec(NewProgramIndex);
243          NewProgram[NewProgramIndex].Command := cmSet;
244          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
245        end else begin
246          NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
247        end;
248      end;
249      cmLoopStart: begin
250        if CheckClear then begin
251          NewProgram[NewProgramIndex] := TMachineOperation.Create(cmSet, 0, 0);
252          Inc(FProgramIndex, 2);
253        end else begin
254          NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
255        end;
256      end;
257      else NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
258    end;
259    PreviousCommand := FProgram[FProgramIndex].Command;
260    DebugSteps.UpdateTargetPos(FProgramIndex, NewProgramIndex);
261    Inc(FProgramIndex);
262    Inc(NewProgramIndex);
263  end;
264  SetLength(NewProgram, NewProgramIndex);
265
266  // Replace old program by new program
267  SetLength(FProgram, Length(NewProgram));
268  Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) * Length(NewProgram));
269end;
270
271procedure TBFTarget.OptimizeZeroInitMemory;
272begin
273  // Here Optimizations related to assumption that initial memory is filled with zeroes
274  // Then code for constants preparation can be translated to cmSet commands
275  // To eliminate also loops for building constants code need to be somehow interpretted partialy
276end;
277
278procedure TBFTarget.OptimizeRelativeIndexes;
279var
280  NewProgram: array of TMachineOperation;
281  NewProgramIndex: Integer;
282  RelIndex: Integer;
283begin
284  NewProgramIndex := 0;
285  SetLength(NewProgram, Length(FProgram));
286
287  RelIndex := 0;
288  FProgramIndex := 0;
289  while (FProgramIndex < Length(FProgram)) do begin
290    case FProgram[FProgramIndex].Command of
291      cmPointerInc: begin
292        RelIndex := RelIndex + FProgram[FProgramIndex].Parameter;
293        Dec(NewProgramIndex);
294      end;
295      cmPointerDec: begin
296        RelIndex := RelIndex - FProgram[FProgramIndex].Parameter;
297        Dec(NewProgramIndex);
298      end;
299      cmInc, cmDec, cmInput, cmOutput, cmSet: begin
300        NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
301        NewProgram[NewProgramIndex].RelIndex :=
302          NewProgram[NewProgramIndex].RelIndex + RelIndex;
303      end;
304      cmLoopStart, cmLoopEnd: begin
305        if RelIndex > 0 then begin
306          NewProgram[NewProgramIndex] := TMachineOperation.Create(cmPointerInc,
307            RelIndex, 0);
308          Inc(NewProgramIndex);
309          RelIndex := 0;
310        end else
311        if RelIndex < 0 then begin
312          NewProgram[NewProgramIndex] := TMachineOperation.Create(cmPointerDec,
313            Abs(RelIndex), 0);
314          Inc(NewProgramIndex);
315          RelIndex := 0;
316        end;
317        NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
318      end;
319      else raise Exception.Create(Format('Unsupported command %d', [FProgram[FProgramIndex].Command]));
320    end;
321    DebugSteps.UpdateTargetPos(FProgramIndex, NewProgramIndex);
322    Inc(FProgramIndex);
323    Inc(NewProgramIndex);
324  end;
325  SetLength(NewProgram, NewProgramIndex);
326
327  // Replace old program by new program
328  SetLength(FProgram, Length(NewProgram));
329  Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) *
330    Length(NewProgram));
331end;
332
333procedure TBFTarget.OptimizeCopyMultiply;
334var
335  NewProgram: array of TMachineOperation;
336  NewProgramIndex: Integer;
337  ProcessLoop: Boolean;
338  PointerChange: Integer;
339  NumberOfBaseDecrement: Integer;
340  LoopStartIndex: Integer;
341  LoopStartIndexNew: Integer;
342begin
343  NewProgramIndex := 0;
344  SetLength(NewProgram, Length(FProgram));
345
346  NumberOfBaseDecrement := 0;
347  ProcessLoop := False;
348  FProgramIndex := 0;
349  PointerChange := 0;
350  while (FProgramIndex < Length(FProgram)) do begin
351    case FProgram[FProgramIndex].Command of
352      cmPointerInc: begin
353        PointerChange := PointerChange + FProgram[FProgramIndex].Parameter;
354        NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
355      end;
356      cmPointerDec: begin
357        PointerChange := PointerChange - FProgram[FProgramIndex].Parameter;
358        NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
359      end;
360      cmInc: begin
361        if not ProcessLoop then begin
362          NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
363        end else begin
364          if ((FProgram[FProgramIndex].RelIndex + PointerChange) <> 0) then begin
365            NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
366            NewProgram[NewProgramIndex].Command := cmMultipy;
367          end else Dec(NewProgramIndex);
368        end;
369      end;
370      cmDec: begin
371        if not ProcessLoop then begin
372          if (PointerChange = 0) and (FProgram[FProgramIndex].RelIndex = 0) and
373            (FProgram[FProgramIndex].Parameter = 1) then
374            Inc(NumberOfBaseDecrement);
375          NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
376        end else begin
377          if ((FProgram[FProgramIndex].RelIndex + PointerChange) <> 0) then begin
378            NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
379            NewProgram[NewProgramIndex].Command := cmMultipy;
380            NewProgram[NewProgramIndex].Parameter := -FProgram[FProgramIndex].Parameter;
381          end else Dec(NewProgramIndex);
382        end;
383      end;
384      cmInput, cmOutput: begin
385        NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
386        Inc(NumberOfBaseDecrement, 2);
387      end;
388      cmSet: begin
389        NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
390        Inc(NumberOfBaseDecrement, 2);
391      end;
392      cmLoopStart: begin
393        if not ProcessLoop then begin
394          NumberOfBaseDecrement := 0;
395          PointerChange := 0;
396          LoopStartIndex := FProgramIndex;
397          LoopStartIndexNew := NewProgramIndex;
398          NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
399        end else begin
400          Dec(NewProgramIndex);
401        end;
402      end;
403      cmLoopEnd: begin
404        if not ProcessLoop then begin
405          if (NumberOfBaseDecrement = 1) and (PointerChange = 0) then begin
406            FProgramIndex := LoopstartIndex - 1;
407            NewProgramIndex := LoopStartIndexNew - 1;
408            ProcessLoop := True;
409          end else begin
410            NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
411          end;
412        end else begin
413          NewProgram[NewProgramIndex] := TMachineOperation.Create(cmSet, 0, 0);
414          ProcessLoop := False;
415          NumberOfBaseDecrement := 0;
416        end;
417      end;
418      else raise Exception.Create(Format('Unsupported command %d', [FProgram[FProgramIndex].Command]));
419    end;
420    DebugSteps.UpdateTargetPos(FProgramIndex, NewProgramIndex);
421    Inc(FProgramIndex);
422    Inc(NewProgramIndex);
423  end;
424  SetLength(NewProgram, NewProgramIndex);
425
426  // Replace old program by new program
427  SetLength(FProgram, Length(NewProgram));
428  Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) *
429    Length(NewProgram));
430end;
431
432procedure TBFTarget.LoadProgram;
433var
434  I: Integer;
435begin
436  inherited;
437  DebugSteps.Clear;
438  SetLength(FProgram, Length(FSourceCode));
439  FProgramIndex := 0;
440  for I := 1 to Length(FSourceCode) do begin
441    case FSourceCode[I] of
442      '+': begin
443        FProgram[FProgramIndex] := TMachineOperation.Create(cmInc, 1, 0);
444        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
445      end;
446      '-': begin
447        FProgram[FProgramIndex] := TMachineOperation.Create(cmDec, 1, 0);
448        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
449      end;
450      '>': begin
451        FProgram[FProgramIndex] := TMachineOperation.Create(cmPointerInc, 1, 0);
452        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
453      end;
454      '<': begin
455        FProgram[FProgramIndex] := TMachineOperation.Create(cmPointerDec, 1, 0);
456        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
457      end;
458      ',': begin
459        FProgram[FProgramIndex] := TMachineOperation.Create(cmInput, 0, 0);
460        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
461      end;
462      '.': begin
463        FProgram[FProgramIndex] := TMachineOperation.Create(cmOutput, 0, 0);
464        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
465      end;
466      '[': begin
467        FProgram[FProgramIndex] := TMachineOperation.Create(cmLoopStart, 0, 0);
468        DebugSteps.AddStep(I - 1, FProgramIndex, soStepIn);
469      end;
470      ']': begin
471        FProgram[FProgramIndex] := TMachineOperation.Create(cmLoopEnd, 0 ,0);
472        DebugSteps.AddStep(I - 1, FProgramIndex, soStepOut);
473      end
474      else Dec(FProgramIndex);
475    end;
476    Inc(FProgramIndex);
477  end;
478  SetLength(FProgram, FProgramIndex);
479end;
480
481constructor TBFTarget.Create;
482begin
483  inherited Create;
484  MemorySize := 30000;
485  CellSize := 256;
486end;
487
488procedure TBFTarget.OptimizeSource;
489var
490  OldLength: Integer;
491begin
492  inherited;
493  if Optimizations.AddSub then OptimizeAddSub;
494  if Optimizations.Merge then
495  repeat
496    OldLength := Length(FProgram);
497    OptimizeMerge;
498  until Length(FProgram) = OldLength;
499  OptimizeZeroInitMemory;
500  if Optimizations.RelativeIndexes then OptimizeRelativeIndexes;
501  if Optimizations.CopyMultiply then OptimizeCopyMultiply;
502end;
503
504
505
506end.
507
Note: See TracBrowser for help on using the repository browser.