Changeset 86 for trunk


Ignore:
Timestamp:
Aug 29, 2017, 5:12:18 PM (7 years ago)
Author:
chronos
Message:
  • Added: New optimization using relative indexes to eliminate lots of pointer inc/dec operations.
  • Added: New command "multiply" extended command to replace while loops used for cell multiplication. Also added related optimization.
Location:
trunk
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/Target/UTargetC.pas

    r72 r86  
    1515  TTargetC = class(TBFTarget)
    1616  private
     17    function GetMemoryCell: string;
    1718  public
    1819    constructor Create; override;
    … …  
    4647end;
    4748
     49function TTargetC.GetMemoryCell: string;
     50begin
     51  Result := 'Memory[Pos';
     52  if FProgram[FProgramIndex].RelIndex > 0 then
     53    Result := Result + ' + ' + IntToStr(FProgram[FProgramIndex].RelIndex)
     54  else if FProgram[FProgramIndex].RelIndex < 0 then
     55    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
     56  Result := Result + ']';
     57end;
     58
    4859procedure TTargetC.Compile;
    4960begin
    … …  
    6778      cmPointerInc: AddLine('Pos = Pos + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    6879      cmPointerDec: AddLine('Pos = Pos - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    69       cmInc: AddLine('Memory[Pos] = Memory[Pos] + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    70       cmDec: AddLine('Memory[Pos] = Memory[Pos] - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    71       cmOutput: AddLine('putchar(Memory[Pos]);');
    72       cmInput: AddLine('Memory[Pos] = getchar();');
    73       cmSet: AddLine('Memory[Pos] = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     80      cmInc: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     81      cmDec: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     82      cmOutput: AddLine('putchar(' + GetMemoryCell + ');');
     83      cmInput: AddLine(GetMemoryCell + ' = getchar();');
     84      cmSet: AddLine(GetMemoryCell + ' = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     85      cmMultipy: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    7486      cmLoopStart: begin
    75         AddLine('while(Memory[Pos] != 0)');
     87        AddLine('while(' + GetMemoryCell + ' != 0)');
    7688        AddLine('{');
    7789        Inc(Indent);

  • trunk/Target/UTargetDelphi.pas

    r72 r86  
    1414  TTargetDelphi = class(TBFTarget)
    1515  private
     16    function GetMemoryCell: string;
    1617  public
    1718    constructor Create; override;
    … …  
    3839end;
    3940
     41function TTargetDelphi.GetMemoryCell: string;
     42begin
     43  Result := 'Memory[Pos';
     44  if FProgram[FProgramIndex].RelIndex > 0 then
     45    Result := Result + ' + ' + IntToStr(FProgram[FProgramIndex].RelIndex)
     46  else if FProgram[FProgramIndex].RelIndex < 0 then
     47    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
     48  Result := Result + ']';
     49end;
     50
    4051procedure TTargetDelphi.Compile;
    4152begin
    … …  
    6071      cmPointerInc: AddLine('Inc(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    6172      cmPointerDec: AddLine('Dec(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    62       cmInc: AddLine('Memory[Pos] := Memory[Pos] + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    63       cmDec: AddLine('Memory[Pos] := Memory[Pos] - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    64       cmSet: AddLine('Memory[Pos] := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    65       cmOutput: AddLine('Write(Chr(Memory[Pos]));');
    66       cmInput: AddLine('Read(ReadChar); Memory[Pos] := Ord(ReadChar);');
     73      cmInc: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     74      cmDec: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     75      cmSet: AddLine(GetMemoryCell + ' := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     76      cmMultipy: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     77      cmOutput: AddLine('Write(Chr(' + GetMemoryCell + '));');
     78      cmInput: AddLine('Read(ReadChar); ' + GetMemoryCell + ' := Ord(ReadChar);');
    6779      cmLoopStart: begin
    68         AddLine('while Memory[Pos] <> 0 do begin');
     80        AddLine('while ' + GetMemoryCell + ' <> 0 do begin');
    6981        Inc(Indent);
    7082      end;

  • trunk/Target/UTargetFPC.pas

    r66 r86  
    1414  TTargetFPC = class(TBFTarget)
    1515  private
     16    function GetMemoryCell: string;
    1617  public
    1718    constructor Create; override;
    … …  
    4344end;
    4445
     46function TTargetFPC.GetMemoryCell: string;
     47begin
     48  Result := 'Memory[Pos';
     49  if FProgram[FProgramIndex].RelIndex > 0 then
     50    Result := Result + ' + ' + IntToStr(FProgram[FProgramIndex].RelIndex)
     51  else if FProgram[FProgramIndex].RelIndex < 0 then
     52    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
     53  Result := Result + ']';
     54end;
     55
    4556procedure TTargetFPC.Compile;
    4657begin
    … …  
    5061
    5162  AddLine('program ' + ProgramName + ';');
    52   AddLine('');
    5363  AddLine('var');
    5464  AddLine('  Memory: array[0..30000] of Byte;');
    … …  
    6373      cmPointerInc: AddLine('Inc(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    6474      cmPointerDec: AddLine('Dec(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    65       cmInc: AddLine('Memory[Pos] := Memory[Pos] + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    66       cmDec: AddLine('Memory[Pos] := Memory[Pos] - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    67       cmSet: AddLine('Memory[Pos] := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    68       cmOutput: AddLine('Write(Chr(Memory[Pos]));');
    69       cmInput: AddLine('Read(ReadChar); Memory[Pos] := Ord(ReadChar);');
     75      cmInc: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     76      cmDec: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     77      cmSet: AddLine(GetMemoryCell + ' := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     78      cmMultipy: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     79      cmOutput: AddLine('Write(Chr(' + GetMemoryCell + '));');
     80      cmInput: AddLine('Read(ReadChar); ' + GetMemoryCell + ' := Ord(ReadChar);');
    7081      cmLoopStart: begin
    71         AddLine('while Memory[Pos] <> 0 do begin');
     82        AddLine('while ' + GetMemoryCell + ' <> 0 do begin');
    7283        Inc(Indent);
    7384      end;

  • trunk/Target/UTargetInterpretter.pas

    r80 r86  
    4444    procedure CommandLoopEnd;
    4545    procedure CommandSet;
     46    procedure CommandMultiply;
    4647    procedure PrepareBreakPoints;
    4748  protected
    … …  
    7576const
    7677  BrainFuckCommandText: array[TMachineCommand] of Char = (
    77     ' ', '+', '-', '>', '<', '.', ',', '[', ']', '@', '=');
     78    ' ', '+', '-', '>', '<', '.', ',', '[', ']', '@', '=', '*');
    7879
    7980
    … …  
    189190  end;
    190191  if InputPosition <= Length(Input) then begin
    191     Memory[MemoryPosition] := Ord(Input[InputPosition]);
     192    Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] :=
     193      Ord(Input[InputPosition]);
    192194    Inc(InputPosition);
    193195  end;
    … …  
    198200  if OutputPosition > Length(Output) then
    199201    SetLength(Output, Length(Output) + 1 + Length(Output) div 4);
    200   Output[OutputPosition] := Char(Memory[MemoryPosition]);
     202  Output[OutputPosition] := Char(Memory[MemoryPosition +
     203    FProgram[FProgramIndex].RelIndex]);
    201204  Inc(OutputPosition);
    202205end;
    … …  
    204207procedure TTargetInterpretter.CommandLoopStart;
    205208begin
    206   if Memory[MemoryPosition] = 0 then
     209  if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] = 0 then
    207210    FProgramIndex := FProgram[FProgramIndex].Parameter;
    208211end;
    … …  
    210213procedure TTargetInterpretter.CommandLoopEnd;
    211214begin
    212   if Memory[MemoryPosition] > 0 then
     215  if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] > 0 then
    213216    FProgramIndex := FProgram[FProgramIndex].Parameter - 1;
    214217end;
    … …  
    216219procedure TTargetInterpretter.CommandInc;
    217220begin
    218   Memory[MemoryPosition] := ((Memory[MemoryPosition] + FProgram[FProgramIndex].Parameter) mod CellSize);
     221  Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] :=
     222    ((Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] +
     223    FProgram[FProgramIndex].Parameter) mod CellSize);
    219224end;
    220225
    221226procedure TTargetInterpretter.CommandDec;
    222227begin
    223   Memory[MemoryPosition] := ((Memory[MemoryPosition] - FProgram[FProgramIndex].Parameter) mod CellSize);
     228  Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] :=
     229    ((Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] -
     230    FProgram[FProgramIndex].Parameter) mod CellSize);
    224231end;
    225232
    … …  
    240247procedure TTargetInterpretter.CommandSet;
    241248begin
    242   Memory[MemoryPosition] := FProgram[FProgramIndex].Parameter mod CellSize;
     249  Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] :=
     250    FProgram[FProgramIndex].Parameter mod CellSize;
     251end;
     252
     253procedure TTargetInterpretter.CommandMultiply;
     254begin
     255  Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] :=
     256    (Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] +
     257    Memory[MemoryPosition] * FProgram[FProgramIndex].Parameter) mod CellSize;
    243258end;
    244259
    … …  
    411426  // Extended commands
    412427  FCommandTable[cmSet] := CommandSet;
     428  FCommandTable[cmMultipy] := CommandMultiply;
    413429end;
    414430

  • trunk/Target/UTargetJava.pas

    r72 r86  
    1414  TTargetJava = class(TBFTarget)
    1515  private
     16    function GetMemoryCell: string;
    1617  public
    1718    constructor Create; override;
    … …  
    4445end;
    4546
     47function TTargetJava.GetMemoryCell: string;
     48begin
     49  Result := 'Memory[Pos';
     50  if FProgram[FProgramIndex].RelIndex > 0 then
     51    Result := Result + ' + ' + IntToStr(FProgram[FProgramIndex].RelIndex)
     52  else if FProgram[FProgramIndex].RelIndex < 0 then
     53    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
     54  Result := Result + ']';
     55end;
     56
    4657procedure TTargetJava.Compile;
    4758begin
    … …  
    6778      cmPointerInc: AddLine('Pos = Pos + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    6879      cmPointerDec: AddLine('Pos = Pos - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    69       cmInc: AddLine('Memory[Pos] = (char)((int)Memory[Pos] + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    70       cmDec: AddLine('Memory[Pos] = (char)((int)Memory[Pos] - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    71       cmOutput: AddLine('System.out.print(Memory[Pos]);');
    72       cmInput: AddLine('Memory[Pos] = (char)System.in.read();');
    73       cmSet: AddLine('Memory[Pos] = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     80      cmInc: AddLine(GetMemoryCell + ' = (char)((int)' + GetMemoryCell + ' + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     81      cmDec: AddLine(GetMemoryCell + ' = (char)((int)' + GetMemoryCell + ' - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     82      cmOutput: AddLine('System.out.print(' + GetMemoryCell + ');');
     83      cmInput: AddLine(GetMemoryCell + ' = (char)System.in.read();');
     84      cmSet: AddLine(GetMemoryCell + ' = (char)' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     85      cmMultipy: AddLine(GetMemoryCell + ' = (char)((int)' + GetMemoryCell + ' + (int)Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    7486      cmLoopStart: begin
    75         AddLine('while(Memory[Pos] != 0)');
     87        AddLine('while(' + GetMemoryCell + ' != 0)');
    7688        AddLine('{');
    7789        Inc(Indent);

  • trunk/Target/UTargetPHP.pas

    r72 r86  
    1414  TTargetPHP = class(TBFTarget)
    1515  private
     16    function GetMemoryCell: string;
    1617  public
    1718    constructor Create; override;
    … …  
    4445end;
    4546
     47function TTargetPHP.GetMemoryCell: string;
     48begin
     49  Result := '$Memory[$Position';
     50  if FProgram[FProgramIndex].RelIndex > 0 then
     51    Result := Result + ' + ' + IntToStr(FProgram[FProgramIndex].RelIndex)
     52  else if FProgram[FProgramIndex].RelIndex < 0 then
     53    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
     54  Result := Result + ']';
     55end;
     56
    4657procedure TTargetPHP.Compile;
    4758begin
    … …  
    5970      cmPointerInc: AddLine('$Position = $Position + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    6071      cmPointerDec: AddLine('$Position = $Position - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    61       cmInc: AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    62       cmDec: AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    63       cmOutput: AddLine('echo($Memory[$Position]);');
    64       cmInput: AddLine('$Memory[$Position] = fgetc(STDIN);');
    65       cmSet: AddLine('$Memory[$Position] = chr(' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     72      cmInc: AddLine(GetMemoryCell + ' = chr(ord(' + GetMemoryCell + ') + ' +
     73        IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     74      cmDec: AddLine(GetMemoryCell + ' = chr(ord(' + GetMemoryCell + ') - ' +
     75        IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     76      cmOutput: AddLine('echo(' + GetMemoryCell + ');');
     77      cmInput: AddLine(GetMemoryCell + ' = fgetc(STDIN);');
     78      cmSet: AddLine(GetMemoryCell + ' = chr(' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     79      cmMultipy: AddLine(GetMemoryCell + ' = chr(ord(' + GetMemoryCell + ') + ord($Memory[$Position]) * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    6680      cmLoopStart: begin
    67         AddLine('while($Memory[$Position] != "\0") {');
     81        AddLine('while(' + GetMemoryCell + ' != "\0") {');
    6882        Inc(Indent);
    6983      end;

  • trunk/Target/UTargetPython.pas

    r82 r86  
    1414  TTargetPython = class(TBFTarget)
    1515  private
     16    function GetMemoryCell: string;
    1617  public
    1718    constructor Create; override;
    … …  
    4243  ExecutorPath := '/usr/bin/python';
    4344  {$ENDIF}
     45end;
     46
     47function TTargetPython.GetMemoryCell: string;
     48begin
     49  Result := 'memory[position';
     50  if FProgram[FProgramIndex].RelIndex > 0 then
     51    Result := Result + ' + ' + IntToStr(FProgram[FProgramIndex].RelIndex)
     52  else if FProgram[FProgramIndex].RelIndex < 0 then
     53    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
     54  Result := Result + ']';
    4455end;
    4556
    … …  
    97108      cmPointerInc: AddLine('position += ' + IntToStr(FProgram[FProgramIndex].Parameter));
    98109      cmPointerDec: AddLine('position -= ' + IntToStr(FProgram[FProgramIndex].Parameter));
    99       cmInc: AddLine('memory[position] += ' + IntToStr(FProgram[FProgramIndex].Parameter));
    100       cmDec: AddLine('memory[position] -= ' + IntToStr(FProgram[FProgramIndex].Parameter));
     110      cmInc: AddLine(GetMemoryCell + ' += ' + IntToStr(FProgram[FProgramIndex].Parameter));
     111      cmDec: AddLine(GetMemoryCell + ' -= ' + IntToStr(FProgram[FProgramIndex].Parameter));
    101112      cmOutput: begin
    102         AddLine('sys.stdout.write(chr(memory[position]))');
     113        AddLine('sys.stdout.write(chr(' + GetMemoryCell + '))');
    103114        AddLine('sys.stdout.flush()');
    104115      end;
    105       cmInput: AddLine('memory[position] = ord(getchar())');
    106       cmSet: AddLine('memory[position] = ' + IntToStr(FProgram[FProgramIndex].Parameter));
     116      cmInput: AddLine(GetMemoryCell + ' = ord(getchar())');
     117      cmSet: AddLine(GetMemoryCell + ' = ' + IntToStr(FProgram[FProgramIndex].Parameter));
     118      cmMultipy: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + memory[position] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    107119      cmLoopStart: begin
    108         AddLine('while(memory[position] != 0):');
     120        AddLine('while(' + GetMemoryCell + ' != 0):');
    109121        Inc(Indent);
    110122      end;

  • trunk/UBFTarget.pas

    r80 r86  
    1111
    1212  TMachineCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
    13     cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug, cmSet);
     13    cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug, cmSet, cmMultipy);
    1414
    1515  TMachineOperation = record
    1616    Command: TMachineCommand;
    1717    Parameter: Integer;
     18    RelIndex: Integer;
    1819  end;
    1920
    … …  
    2829    procedure OptimizeMerge;
    2930    procedure OptimizeZeroInitMemory;
     31    procedure OptimizeRelativeIndexes;
     32    procedure OptimizeCopyMultiply;
    3033  protected
    3134    FProgram: array of TMachineOperation;
    … …  
    261264end;
    262265
     266procedure TBFTarget.OptimizeRelativeIndexes;
     267var
     268  NewProgram: array of TMachineOperation;
     269  NewProgramIndex: Integer;
     270  RelIndex: Integer;
     271begin
     272  NewProgramIndex := 0;
     273  SetLength(NewProgram, Length(FProgram));
     274
     275  RelIndex := 0;
     276  FProgramIndex := 0;
     277  while (FProgramIndex < Length(FProgram)) do begin
     278    case FProgram[FProgramIndex].Command of
     279      cmPointerInc: begin
     280        RelIndex := RelIndex + FProgram[FProgramIndex].Parameter;
     281        Dec(NewProgramIndex);
     282      end;
     283      cmPointerDec: begin
     284        RelIndex := RelIndex - FProgram[FProgramIndex].Parameter;
     285        Dec(NewProgramIndex);
     286      end;
     287      cmInc, cmDec, cmInput, cmOutput, cmSet: begin
     288        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     289        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     290        NewProgram[NewProgramIndex].RelIndex := RelIndex;
     291      end;
     292      cmLoopStart, cmLoopEnd: begin
     293        if RelIndex > 0 then begin
     294          NewProgram[NewProgramIndex].Command := cmPointerInc;
     295          NewProgram[NewProgramIndex].Parameter := RelIndex;
     296          NewProgram[NewProgramIndex].RelIndex := 0;
     297          Inc(NewProgramIndex);
     298          RelIndex := 0;
     299        end else
     300        if RelIndex < 0 then begin
     301          NewProgram[NewProgramIndex].Command := cmPointerDec;
     302          NewProgram[NewProgramIndex].Parameter := Abs(RelIndex);
     303          NewProgram[NewProgramIndex].RelIndex := 0;
     304          Inc(NewProgramIndex);
     305          RelIndex := 0;
     306        end;
     307        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     308        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     309        NewProgram[NewProgramIndex].RelIndex := 0;
     310      end;
     311    end;
     312    DebugSteps.UpdateTargetPos(FProgramIndex, NewProgramIndex);
     313    Inc(FProgramIndex);
     314    Inc(NewProgramIndex);
     315  end;
     316  SetLength(NewProgram, NewProgramIndex);
     317
     318  // Replace old program by new program
     319  SetLength(FProgram, Length(NewProgram));
     320  Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) *
     321    Length(NewProgram));
     322end;
     323
     324procedure TBFTarget.OptimizeCopyMultiply;
     325var
     326  NewProgram: array of TMachineOperation;
     327  NewProgramIndex: Integer;
     328  ProcessLoop: Boolean;
     329  PointerChange: Integer;
     330  NumberOfBaseDecrement: Integer;
     331  LoopStartIndex: Integer;
     332  LoopStartIndexNew: Integer;
     333begin
     334  NewProgramIndex := 0;
     335  SetLength(NewProgram, Length(FProgram));
     336
     337  NumberOfBaseDecrement := 0;
     338  ProcessLoop := False;
     339  FProgramIndex := 0;
     340  PointerChange := 0;
     341  while (FProgramIndex < Length(FProgram)) do begin
     342    case FProgram[FProgramIndex].Command of
     343      cmPointerInc: begin
     344        PointerChange := PointerChange + FProgram[FProgramIndex].Parameter;
     345        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     346        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     347        NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     348      end;
     349      cmPointerDec: begin
     350        PointerChange := PointerChange - FProgram[FProgramIndex].Parameter;
     351        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     352        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     353        NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     354      end;
     355      cmInc: begin
     356        if not ProcessLoop then begin
     357          NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     358          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     359          NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     360        end else begin
     361          if ((FProgram[FProgramIndex].RelIndex + PointerChange) <> 0) then begin
     362            NewProgram[NewProgramIndex].Command := cmMultipy;
     363            NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     364            NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     365          end else Dec(NewProgramIndex);
     366        end;
     367      end;
     368      cmDec: begin
     369        if not ProcessLoop then begin
     370          if (PointerChange = 0) and (FProgram[FProgramIndex].RelIndex = 0) and
     371            (FProgram[FProgramIndex].Parameter = 1) then
     372            Inc(NumberOfBaseDecrement);
     373          NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     374          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     375          NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     376        end else begin
     377          if ((FProgram[FProgramIndex].RelIndex + PointerChange) <> 0) then begin
     378            NewProgram[NewProgramIndex].Command := cmMultipy;
     379            NewProgram[NewProgramIndex].Parameter := -FProgram[FProgramIndex].Parameter;
     380            NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     381          end else Dec(NewProgramIndex);
     382        end;
     383      end;
     384      cmInput, cmOutput: begin
     385        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     386        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     387        NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     388        Inc(NumberOfBaseDecrement, 2);
     389      end;
     390      cmSet: begin
     391        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     392        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     393        NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     394        Inc(NumberOfBaseDecrement, 2);
     395      end;
     396      cmLoopStart: begin
     397        if not ProcessLoop then begin
     398          NumberOfBaseDecrement := 0;
     399          PointerChange := 0;
     400          LoopStartIndex := FProgramIndex;
     401          LoopStartIndexNew := NewProgramIndex;
     402          NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     403          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     404          NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     405        end else begin
     406          Dec(NewProgramIndex);
     407        end;
     408      end;
     409      cmLoopEnd: begin
     410        if not ProcessLoop then begin
     411          if (NumberOfBaseDecrement = 1) and (PointerChange = 0) then begin
     412            FProgramIndex := LoopstartIndex - 1;
     413            NewProgramIndex := LoopStartIndexNew - 1;
     414            ProcessLoop := True;
     415          end else begin
     416            NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     417            NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     418            NewProgram[NewProgramIndex].RelIndex := FProgram[FProgramIndex].RelIndex;
     419          end;
     420        end else begin
     421          NewProgram[NewProgramIndex].Command := cmSet;
     422          NewProgram[NewProgramIndex].Parameter := 0;
     423          NewProgram[NewProgramIndex].RelIndex := 0;
     424          ProcessLoop := False;
     425        end;
     426      end;
     427    end;
     428    DebugSteps.UpdateTargetPos(FProgramIndex, NewProgramIndex);
     429    Inc(FProgramIndex);
     430    Inc(NewProgramIndex);
     431  end;
     432  SetLength(NewProgram, NewProgramIndex);
     433
     434  // Replace old program by new program
     435  SetLength(FProgram, Length(NewProgram));
     436  Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) *
     437    Length(NewProgram));
     438end;
     439
    263440procedure TBFTarget.LoadProgram;
    264441var
    … …  
    274451        FProgram[FProgramIndex].Command := cmInc;
    275452        FProgram[FProgramIndex].Parameter := 1;
     453        FProgram[FProgramIndex].RelIndex := 0;
    276454        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    277455      end;
    … …  
    279457        FProgram[FProgramIndex].Command := cmDec;
    280458        FProgram[FProgramIndex].Parameter := 1;
     459        FProgram[FProgramIndex].RelIndex := 0;
    281460        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    282461      end;
    … …  
    284463        FProgram[FProgramIndex].Command := cmPointerInc;
    285464        FProgram[FProgramIndex].Parameter := 1;
     465        FProgram[FProgramIndex].RelIndex := 0;
    286466        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    287467      end;
    … …  
    289469        FProgram[FProgramIndex].Command := cmPointerDec;
    290470        FProgram[FProgramIndex].Parameter := 1;
     471        FProgram[FProgramIndex].RelIndex := 0;
    291472        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    292473      end;
    … …  
    294475        FProgram[FProgramIndex].Command := cmInput;
    295476        FProgram[FProgramIndex].Parameter := 0;
     477        FProgram[FProgramIndex].RelIndex := 0;
    296478        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    297479      end;
    … …  
    299481        FProgram[FProgramIndex].Command := cmOutput;
    300482        FProgram[FProgramIndex].Parameter := 0;
     483        FProgram[FProgramIndex].RelIndex := 0;
    301484        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    302485      end;
    … …  
    304487        FProgram[FProgramIndex].Command := cmLoopStart;
    305488        FProgram[FProgramIndex].Parameter := 0;
     489        FProgram[FProgramIndex].RelIndex := 0;
    306490        DebugSteps.AddStep(I - 1, FProgramIndex, soStepIn);
    307491      end;
    … …  
    309493        FProgram[FProgramIndex].Command := cmLoopEnd;
    310494        FProgram[FProgramIndex].Parameter := 0;
     495        FProgram[FProgramIndex].RelIndex := 0;
    311496        DebugSteps.AddStep(I - 1, FProgramIndex, soStepOut);
    312497      end
    … …  
    336521  until Length(FProgram) = OldLength;
    337522  OptimizeZeroInitMemory;
     523  OptimizeRelativeIndexes;
     524  OptimizeCopyMultiply;
    338525end;
    339526

  • trunk/UTarget.pas

    r84 r86  
    410410  I: Integer;
    411411begin
    412   if CompilerPath = '' then Exit;
    413 
    414412  CompiledFile := ExtractFilePath(ProjectFileName) +
    415413    'compiled' + DirectorySeparator + Name + DirectorySeparator +
Note: See TracChangeset for help on using the changeset viewer.