source: tags/1.0.0/UBFTarget.pas

Last change on this file was 96, checked in by chronos, 6 years ago
  • Added: Theming support.
  • Modified: Items in Options dialog divided to two pages.
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 MemoryMaxUsed: 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.