Changeset 126 for trunk/UBFTarget.pas


Ignore:
Timestamp:
Jan 14, 2022, 7:13:36 PM (3 years ago)
Author:
chronos
Message:
  • Modified: SetZero optimization made as separate step.
  • Fixed: Error during compilation in CopyMultiply optimization.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/UBFTarget.pas

    r125 r126  
    1111
    1212  TMachineCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
    13     cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug, cmSet, cmMultipy);
     13    cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug, cmSet, cmMultiply);
    1414
    1515  { TMachineOperation }
    … …  
    1919    Parameter: Integer;
    2020    RelIndex: Integer;
    21     class function Create(Command: TMachineCommand; Parameter, RelIndex: Integer): TMachineOperation; static;
     21    class function Create(Command: TMachineCommand; Parameter: Integer;
     22      RelIndex: Integer = 0): TMachineOperation; static;
     23  end;
     24
     25  TMachineOperations = array of TMachineOperation;
     26
     27  { TProgram }
     28
     29  TProgram = class
     30  private
     31    function GetCount: Integer;
     32    function GetItem(Index: Integer): TMachineOperation;
     33    procedure SetCount(AValue: Integer);
     34    procedure SetItem(Index: Integer; AValue: TMachineOperation);
     35  public
     36    Operations: TMachineOperations;
     37    Index: Integer;
     38    procedure Assign(Source: TProgram);
     39    property Count: Integer read GetCount write SetCount;
     40    property Items[Index: Integer]: TMachineOperation read GetItem write SetItem; default;
    2241  end;
    2342
    2443  TOptimizations = record
    2544    AddSub: Boolean;
     45    SetZero: Boolean;
    2646    Merge: Boolean;
    2747    RelativeIndexes: Boolean;
    … …  
    3353  TBFTarget = class(TTarget)
    3454  private
    35     function CheckClear: Boolean;
     55    function CheckLoopSetZero: Boolean;
    3656    function CheckOccurenceSumParam(C: TMachineCommand): Integer;
    3757    function CheckOccurence(C: TMachineCommand): Integer;
     58    function CheckLoopDecrementCount: Integer;
    3859    procedure OptimizeAddSub;
     60    procedure OptimizeSetZero;
    3961    procedure OptimizeMerge;
    4062    procedure OptimizeZeroInitMemory;
    … …  
    4264    procedure OptimizeCopyMultiply;
    4365  protected
    44     FProgram: array of TMachineOperation;
     66    FProgram: TProgram;
    4567    FProgramIndex: Integer;
    4668    function GetOperationText(Operation: TMachineOperation): string; virtual;
    … …  
    5274    Optimizations: TOptimizations;
    5375    constructor Create; override;
     76    destructor Destroy; override;
    5477    procedure OptimizeSource; override;
    5578    property ProgramIndex: Integer read FProgramIndex;
    … …  
    6689  SUnsupportedCommand = 'Unsupported command %d';
    6790
     91{ TProgram }
     92
     93function TProgram.GetCount: Integer;
     94begin
     95  Result := Length(Operations);
     96end;
     97
     98function TProgram.GetItem(Index: Integer): TMachineOperation;
     99begin
     100  Result := Operations[Index];
     101end;
     102
     103procedure TProgram.SetCount(AValue: Integer);
     104begin
     105  SetLength(Operations, AValue);
     106end;
     107
     108procedure TProgram.SetItem(Index: Integer; AValue: TMachineOperation);
     109begin
     110  Operations[Index] := AValue;
     111end;
     112
     113procedure TProgram.Assign(Source: TProgram);
     114begin
     115  Count := Source.Count;
     116  Move(Pointer(Source.Operations)^, Pointer(Operations)^, SizeOf(TMachineOperation) * Count);
     117end;
     118
    68119{ TMachineOperation }
    69120
    70 class function TMachineOperation.Create(Command: TMachineCommand; Parameter,
    71   RelIndex: Integer): TMachineOperation;
     121class function TMachineOperation.Create(Command: TMachineCommand;
     122  Parameter: Integer; RelIndex: Integer = 0): TMachineOperation;
    72123begin
    73124  Result.Command := Command;
    … …  
    76127end;
    77128
    78 function TBFTarget.CheckClear: Boolean;
    79 begin
    80   Result := (FProgram[FProgramIndex].Command = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and
     129function TBFTarget.CheckLoopSetZero: Boolean;
     130begin
     131  Result := (FProgram[FProgramIndex].Command = cmLoopStart) and (FProgram.Count >= FProgramIndex + 2) and
    81132    (((FProgram[FProgramIndex + 1].Command = cmDec) and (FProgram[FProgramIndex + 1].Parameter = 1)) or
    82133    ((FProgram[FProgramIndex + 1].Command = cmInc) and (FProgram[FProgramIndex + 1].Parameter = -1)))
    … …  
    87138begin
    88139  Result := 1;
    89   while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
     140  while ((FProgramIndex + 1) < FProgram.Count) and (FProgram[FProgramIndex + 1].Command = C) do begin
    90141    Inc(Result);
    91142    Inc(FProgramIndex);
    … …  
    96147begin
    97148  Result := FProgram[FProgramIndex].Parameter;
    98   while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
     149  while ((FProgramIndex + 1) < FProgram.Count) and (FProgram[FProgramIndex + 1].Command = C) do begin
    99150    Inc(Result, FProgram[FProgramIndex + 1].Parameter);
    100151    Inc(FProgramIndex);
    … …  
    102153end;
    103154
     155// Merge multiple sequential occurences of +/-/>/< operations into single fast
     156// operation with parameter value set to number of occurences
    104157procedure TBFTarget.OptimizeAddSub;
    105158var
    106   NewProgram: array of TMachineOperation;
    107   NewProgramIndex: Integer;
    108   NewTargetPos: Integer;
     159  NewProgram: TProgram;
     160  NewTargetIndex: Integer;
    109161  FirstIndex: Integer;
    110162begin
    111   NewProgramIndex := 0;
    112   NewTargetPos := 0;
    113   SetLength(NewProgram, Length(FProgram));
     163  NewTargetIndex := 0;
     164  NewProgram := TProgram.Create;
     165  NewProgram.Count := FProgram.Count;
    114166
    115167  FProgramIndex := 0;
    116   while (FProgramIndex < Length(FProgram)) do begin
     168  while FProgramIndex < FProgram.Count do begin
    117169    FirstIndex := FProgramIndex;
    118170    case FProgram[FProgramIndex].Command of
    119171      cmPointerInc: begin
    120         NewProgram[NewProgramIndex].Command := cmPointerInc;
    121         NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerInc);
     172        NewProgram[NewProgram.Index] := TMachineOperation.Create(cmPointerInc,
     173          CheckOccurenceSumParam(cmPointerInc));
    122174      end;
    123175      cmPointerDec: begin
    124         NewProgram[NewProgramIndex].Command := cmPointerDec;
    125         NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerDec);
     176        NewProgram[NewProgram.Index] := TMachineOperation.Create(cmPointerDec,
     177          CheckOccurenceSumParam(cmPointerDec));
    126178      end;
    127179      cmInc: begin
    128         NewProgram[NewProgramIndex].Command := cmInc;
    129         NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmInc);
     180        NewProgram[NewProgram.Index] := TMachineOperation.Create(cmInc,
     181          CheckOccurenceSumParam(cmInc));
    130182      end;
    131183      cmDec: begin
    132         NewProgram[NewProgramIndex].Command := cmDec;
    133         NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmDec);
    134       end;
    135       else NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     184        NewProgram[NewProgram.Index] := TMachineOperation.Create(cmDec,
     185          CheckOccurenceSumParam(cmDec));
     186      end;
     187      else NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    136188    end;
    137     DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgramIndex, NewTargetPos);
    138     Inc(NewTargetPos, Length(GetOperationText(NewProgram[NewProgramIndex])));
    139     Inc(FProgramIndex);
    140     Inc(NewProgramIndex);
    141   end;
    142   SetLength(NewProgram, NewProgramIndex);
    143 
    144   // Replace old program by new program
    145   SetLength(FProgram, Length(NewProgram));
    146   Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) * Length(NewProgram));
    147 end;
    148 
     189    DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgram.Index, NewTargetIndex);
     190    Inc(NewTargetIndex, Length(GetOperationText(NewProgram[NewProgram.Index])));
     191    Inc(FProgramIndex);
     192    Inc(NewProgram.Index);
     193  end;
     194
     195  NewProgram.Count := NewProgram.Index;
     196  FProgram.Assign(NewProgram);
     197  FreeAndNil(NewProgram);
     198end;
     199
     200// Converts [-] into mSet,0 (=0) command
     201procedure TBFTarget.OptimizeSetZero;
     202var
     203  NewProgram: TProgram;
     204  FirstIndex: Integer;
     205  NewTargetIndex: Integer;
     206begin
     207  NewTargetIndex := 0;
     208  NewProgram := TProgram.Create;
     209  NewProgram.Count := FProgram.Count;
     210
     211  FProgramIndex := 0;
     212  while FProgramIndex < FProgram.Count do begin
     213    FirstIndex := FProgramIndex;
     214    case FProgram[FProgramIndex].Command of
     215      cmLoopStart: begin
     216        if CheckLoopSetZero then begin
     217          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmSet, 0, 0);
     218          Inc(FProgramIndex, 2);
     219        end else begin
     220          NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
     221        end;
     222      end;
     223      else NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
     224    end;
     225    DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgram.Index, NewTargetIndex);
     226    Inc(NewTargetIndex, Length(GetOperationText(NewProgram[NewProgram.Index])));
     227    Inc(FProgramIndex);
     228    Inc(NewProgram.Index);
     229  end;
     230  NewProgram.Count := NewProgram.Index;
     231  FProgram.Assign(NewProgram);
     232  FreeAndNil(NewProgram);
     233end;
     234
     235// Merge together cmInc, cmDec, cmSet
     236// Merge together cmPointerInc, cmPointerDec
    149237procedure TBFTarget.OptimizeMerge;
    150238var
    151   NewProgram: array of TMachineOperation;
    152   NewProgramIndex: Integer;
     239  NewProgram: TProgram;
    153240  PreviousCommand: TMachineCommand;
    154241  FirstIndex: Integer;
    155242  NewTargetIndex: Integer;
    156243begin
    157   // Merge together cmInc, cmDec, cmSet
    158   // Merge together cmPointerInc, cmPointerDec
     244  NewTargetIndex := 0;
     245  NewProgram := TProgram.Create;
     246  NewProgram.Count := FProgram.Count;
     247
    159248  PreviousCommand := cmNoOperation;
    160   NewProgramIndex := 0;
    161   SetLength(NewProgram, Length(FProgram));
    162 
    163249  FProgramIndex := 0;
    164   NewTargetIndex := 0;
    165   while (FProgramIndex < Length(FProgram)) do begin
     250  while FProgramIndex < FProgram.Count do begin
    166251    FirstIndex := FProgramIndex;
    167252    case FProgram[FProgramIndex].Command of
    168253      cmPointerInc: begin
    169254        if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
    170           if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
    171             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
     255          if NewProgram[NewProgram.Index - 1].Command = cmPointerInc then
     256            NewProgram.Operations[NewProgram.Index - 1].Parameter := NewProgram[NewProgram.Index - 1].Parameter +
     257              FProgram[FProgram.Index].Parameter
     258          else
     259          if NewProgram[NewProgram.Index - 1].Command = cmPointerDec then
     260            NewProgram.Operations[NewProgram.Index - 1].Parameter := NewProgram[NewProgram.Index - 1].Parameter -
     261              FProgram[FProgram.Index].Parameter;
     262          // If value negative then change command
     263          if NewProgram[NewProgram.Index - 1].Parameter < 0 then begin
     264            NewProgram.Operations[NewProgram.Index - 1].Parameter := -NewProgram[NewProgram.Index - 1].Parameter;
     265            if NewProgram[NewProgram.Index - 1].Command = cmPointerInc then
     266              NewProgram.Operations[NewProgram.Index - 1].Command := cmPointerDec
     267              else NewProgram.Operations[NewProgram.Index - 1].Command := cmPointerInc;
     268          end;
     269          if NewProgram.Operations[NewProgram.Index - 1].Parameter = 0 then Dec(NewProgram.Index);
     270          Dec(NewProgram.Index);
     271        end else begin
     272          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmPointerInc,
     273            FProgram[FProgramIndex].Parameter);
     274        end;
     275      end;
     276      cmPointerDec: begin
     277        if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
     278          if NewProgram[NewProgram.Index - 1].Command = cmPointerDec then
     279            NewProgram.Operations[NewProgram.Index - 1].Parameter := NewProgram[NewProgram.Index - 1].Parameter +
    172280              FProgram[FProgramIndex].Parameter
    173           else if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
    174             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
     281          else if NewProgram[NewProgram.Index - 1].Command = cmPointerInc then
     282            NewProgram.Operations[NewProgram.Index - 1].Parameter := NewProgram[NewProgram.Index - 1].Parameter -
    175283              FProgram[FProgramIndex].Parameter;
    176284          // If value negative then change command
    177           if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
    178             NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
    179             if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
    180               NewProgram[NewProgramIndex - 1].Command := cmPointerDec
    181               else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
     285          if NewProgram[NewProgram.Index - 1].Parameter < 0 then begin
     286            NewProgram.Operations[NewProgram.Index - 1].Parameter := -NewProgram[NewProgram.Index - 1].Parameter;
     287            if NewProgram[NewProgram.Index - 1].Command = cmPointerInc then
     288              NewProgram.Operations[NewProgram.Index - 1].Command := cmPointerDec
     289              else NewProgram.Operations[NewProgram.Index - 1].Command := cmPointerInc;
    182290          end;
    183           if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
    184           Dec(NewProgramIndex);
    185         end else begin
    186           NewProgram[NewProgramIndex].Command := cmPointerInc;
    187           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    188         end;
    189       end;
    190       cmPointerDec: begin
    191         if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
    192           if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
    193             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
     291          if NewProgram[NewProgram.Index - 1].Parameter = 0 then Dec(NewProgram.Index);
     292          Dec(NewProgram.Index);
     293        end else begin
     294          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmPointerDec,
     295            FProgram[FProgramIndex].Parameter);
     296        end;
     297      end;
     298      cmInc: begin
     299        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
     300          if NewProgram[NewProgram.Index - 1].Command in [cmInc, cmSet] then
     301            NewProgram.Operations[NewProgram.Index - 1].Parameter := NewProgram[NewProgram.Index - 1].Parameter +
    194302              FProgram[FProgramIndex].Parameter
    195           else if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
    196             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
     303          else if NewProgram[NewProgram.Index - 1].Command = cmDec then
     304            NewProgram.Operations[NewProgram.Index - 1].Parameter := NewProgram[NewProgram.Index - 1].Parameter -
    197305              FProgram[FProgramIndex].Parameter;
    198306          // If value negative then change command
    199           if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
    200             NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
    201             if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
    202               NewProgram[NewProgramIndex - 1].Command := cmPointerDec
    203               else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
     307          if (NewProgram[NewProgram.Index - 1].Parameter < 0) and (NewProgram[NewProgram.Index - 1].Command <> cmSet) then begin
     308            NewProgram.Operations[NewProgram.Index - 1].Parameter := -NewProgram[NewProgram.Index - 1].Parameter;
     309            if NewProgram[NewProgram.Index - 1].Command = cmInc then
     310              NewProgram.Operations[NewProgram.Index - 1].Command := cmDec
     311              else NewProgram.Operations[NewProgram.Index - 1].Command := cmInc;
    204312          end;
    205           if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
    206           Dec(NewProgramIndex);
    207         end else begin
    208           NewProgram[NewProgramIndex].Command := cmPointerDec;
    209           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    210         end;
    211       end;
    212       cmInc: begin
     313          if NewProgram[NewProgram.Index - 1].Parameter = 0 then Dec(NewProgram.Index);
     314          Dec(NewProgram.Index);
     315        end else begin
     316          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmInc,
     317            FProgram[FProgramIndex].Parameter);
     318        end;
     319      end;
     320      cmDec: begin
    213321        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
    214           if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
    215             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
     322          if NewProgram[NewProgram.Index - 1].Command = cmDec then
     323            NewProgram.Operations[NewProgram.Index - 1].Parameter := NewProgram[NewProgram.Index - 1].Parameter +
    216324              FProgram[FProgramIndex].Parameter
    217           else if NewProgram[NewProgramIndex - 1].Command = cmDec then
    218             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
     325          else if NewProgram[NewProgram.Index - 1].Command in [cmInc, cmSet] then
     326            NewProgram.Operations[NewProgram.Index - 1].Parameter := NewProgram[NewProgram.Index - 1].Parameter -
    219327              FProgram[FProgramIndex].Parameter;
    220328          // If value negative then change command
    221           if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
    222             NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
    223             if NewProgram[NewProgramIndex - 1].Command = cmInc then
    224               NewProgram[NewProgramIndex - 1].Command := cmDec
    225               else NewProgram[NewProgramIndex - 1].Command := cmInc;
     329          if (NewProgram[NewProgram.Index - 1].Parameter < 0) and (NewProgram[NewProgram.Index - 1].Command <> cmSet) then begin
     330            NewProgram.Operations[NewProgram.Index - 1].Parameter := -NewProgram[NewProgram.Index - 1].Parameter;
     331            if NewProgram[NewProgram.Index - 1].Command = cmInc then
     332              NewProgram.Operations[NewProgram.Index - 1].Command := cmDec
     333              else NewProgram.Operations[NewProgram.Index - 1].Command := cmInc;
    226334          end;
    227           if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
    228           Dec(NewProgramIndex);
    229         end else begin
    230           NewProgram[NewProgramIndex].Command := cmInc;
    231           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    232         end;
    233       end;
    234       cmDec: begin
    235         if PreviousCommand in [cmInc, cmDec, cmSet] then begin
    236           if NewProgram[NewProgramIndex - 1].Command = cmDec then
    237             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
    238               FProgram[FProgramIndex].Parameter
    239           else if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
    240             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
    241               FProgram[FProgramIndex].Parameter;
    242           // If value negative then change command
    243           if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
    244             NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
    245             if NewProgram[NewProgramIndex - 1].Command = cmInc then
    246               NewProgram[NewProgramIndex - 1].Command := cmDec
    247               else NewProgram[NewProgramIndex - 1].Command := cmInc;
    248           end;
    249           if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
    250           Dec(NewProgramIndex);
    251         end else begin
    252           NewProgram[NewProgramIndex].Command := cmDec;
    253           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     335          if NewProgram[NewProgram.Index - 1].Parameter = 0 then Dec(NewProgram.Index);
     336          Dec(NewProgram.Index);
     337        end else begin
     338          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmDec,
     339            FProgram[FProgramIndex].Parameter);
    254340        end;
    255341      end;
    … …  
    257343        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
    258344          // Set overrides value of previous commands
    259           Dec(NewProgramIndex);
    260           NewProgram[NewProgramIndex].Command := cmSet;
    261           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    262         end else begin
    263           NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
    264         end;
    265       end;
    266       cmLoopStart: begin
    267         if CheckClear then begin
    268           NewProgram[NewProgramIndex] := TMachineOperation.Create(cmSet, 0, 0);
    269           Inc(FProgramIndex, 2);
    270         end else begin
    271           NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
    272         end;
    273       end;
    274       else NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     345          Dec(NewProgram.Index);
     346          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmSet,
     347            FProgram[FProgramIndex].Parameter);
     348        end else begin
     349          NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
     350        end;
     351      end;
     352      else NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    275353    end;
    276354    PreviousCommand := FProgram[FProgramIndex].Command;
    277     DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgramIndex, NewTargetIndex);
    278     Inc(NewTargetIndex, Length(GetOperationText(NewProgram[NewProgramIndex])));
    279     Inc(FProgramIndex);
    280     Inc(NewProgramIndex);
    281   end;
    282   SetLength(NewProgram, NewProgramIndex);
    283 
    284   // Replace old program by new program
    285   SetLength(FProgram, Length(NewProgram));
    286   Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) * Length(NewProgram));
     355    DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgram.Index, NewTargetIndex);
     356    Inc(NewTargetIndex, Length(GetOperationText(NewProgram[NewProgram.Index])));
     357    Inc(FProgramIndex);
     358    Inc(NewProgram.Index);
     359  end;
     360
     361  NewProgram.Count := NewProgram.Index;
     362  FProgram.Assign(NewProgram);
     363  FreeAndNil(NewProgram);
    287364end;
    288365
    … …  
    296373procedure TBFTarget.OptimizeRelativeIndexes;
    297374var
    298   NewProgram: array of TMachineOperation;
    299   NewProgramIndex: Integer;
     375  NewProgram: TProgram;
    300376  RelIndex: Integer;
    301377  FirstIndex: Integer;
    302378  NewTargetIndex: Integer;
    303379begin
    304   NewProgramIndex := 0;
    305   SetLength(NewProgram, Length(FProgram));
     380  NewTargetIndex := 0;
     381  NewProgram := TProgram.Create;
     382  NewProgram.Count := FProgram.Count;
    306383
    307384  RelIndex := 0;
    308385  FProgramIndex := 0;
    309   NewTargetIndex := 0;
    310   while (FProgramIndex < Length(FProgram)) do begin
     386  while FProgramIndex < FProgram.Count do begin
    311387    FirstIndex := FProgramIndex;
    312388    case FProgram[FProgramIndex].Command of
    313389      cmPointerInc: begin
    314390        RelIndex := RelIndex + FProgram[FProgramIndex].Parameter;
    315         Dec(NewProgramIndex);
     391        Dec(NewProgram.Index);
    316392      end;
    317393      cmPointerDec: begin
    318394        RelIndex := RelIndex - FProgram[FProgramIndex].Parameter;
    319         Dec(NewProgramIndex);
     395        Dec(NewProgram.Index);
    320396      end;
    321397      cmInc, cmDec, cmInput, cmOutput, cmSet: begin
    322         NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
    323         NewProgram[NewProgramIndex].RelIndex :=
    324           NewProgram[NewProgramIndex].RelIndex + RelIndex;
     398        NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
     399        NewProgram.Operations[NewProgram.Index].RelIndex :=
     400          NewProgram[NewProgram.Index].RelIndex + RelIndex;
    325401      end;
    326402      cmLoopStart, cmLoopEnd: begin
    327403        if RelIndex > 0 then begin
    328           NewProgram[NewProgramIndex] := TMachineOperation.Create(cmPointerInc,
     404          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmPointerInc,
    329405            RelIndex, 0);
    330           Inc(NewProgramIndex);
     406          Inc(NewProgram.Index);
    331407          RelIndex := 0;
    332408        end else
    333409        if RelIndex < 0 then begin
    334           NewProgram[NewProgramIndex] := TMachineOperation.Create(cmPointerDec,
     410          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmPointerDec,
    335411            Abs(RelIndex), 0);
    336           Inc(NewProgramIndex);
     412          Inc(NewProgram.Index);
    337413          RelIndex := 0;
    338414        end;
    339         NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     415        NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    340416      end;
    341417      else raise Exception.Create(Format(SUnsupportedCommand, [FProgram[FProgramIndex].Command]));
    342418    end;
    343     DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgramIndex, NewTargetIndex);
    344     Inc(NewTargetIndex, Length(GetOperationText(NewProgram[NewProgramIndex])));
    345     Inc(FProgramIndex);
    346     Inc(NewProgramIndex);
    347   end;
    348   SetLength(NewProgram, NewProgramIndex);
    349 
    350   // Replace old program by new program
    351   SetLength(FProgram, Length(NewProgram));
    352   Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) *
    353     Length(NewProgram));
    354 end;
    355 
     419    DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgram.Index, NewTargetIndex);
     420    Inc(NewTargetIndex, Length(GetOperationText(NewProgram[NewProgram.Index])));
     421    Inc(FProgramIndex);
     422    Inc(NewProgram.Index);
     423  end;
     424
     425  NewProgram.Count := NewProgram.Index;
     426  FProgram.Assign(NewProgram);
     427  FreeAndNil(NewProgram);
     428end;
     429
     430function TBFTarget.CheckLoopDecrementCount: Integer;
     431var
     432  I: Integer;
     433  PointerChange: Integer;
     434begin
     435  Result := 0;
     436  PointerChange := 0;
     437  I := FProgramIndex + 1;
     438  while I < FProgram.Count do begin
     439    case FProgram[I].Command of
     440      cmPointerInc: begin
     441        Inc(PointerChange, FProgram[I].Parameter);
     442      end;
     443      cmPointerDec: begin
     444        Dec(PointerChange, FProgram[I].Parameter);
     445      end;
     446      cmInc: begin
     447      end;
     448      cmDec: begin
     449        if (PointerChange = 0) and (FProgram[I].RelIndex = 0) and
     450          (FProgram[I].Parameter = 1) then
     451          Inc(Result);
     452      end;
     453      cmLoopEnd: begin
     454        if (Result = 1) and (PointerChange = 0) then begin
     455          Break;
     456        end;
     457      end;
     458      else begin
     459        // The loop can't be optimized as there are other operations inside
     460        Result := 0;
     461        Break;
     462      end;
     463    end;
     464    Inc(I);
     465  end;
     466end;
     467
     468// Optimize copy and multiply loops like [>+<-] or [>++<-] or [>+>+<<-]
    356469procedure TBFTarget.OptimizeCopyMultiply;
    357470var
    358   NewProgram: array of TMachineOperation;
    359   NewProgramIndex: Integer;
    360   ProcessLoop: Boolean;
     471  NewProgram: TProgram;
     472  ProcessingLoop: Boolean;
    361473  PointerChange: Integer;
    362474  NumberOfBaseDecrement: Integer;
    363   LoopStartIndex: Integer;
    364   LoopStartIndexNew: Integer;
    365475  FirstIndex: Integer;
    366476  NewTextIndex: Integer;
    367 begin
    368   NewProgramIndex := 0;
    369   SetLength(NewProgram, Length(FProgram));
     477  NoNewCode: Boolean;
     478begin
     479  NewProgram := TProgram.Create;
     480  NewProgram.Count := FProgram.Count;
    370481
    371482  NumberOfBaseDecrement := 0;
    372   ProcessLoop := False;
     483  ProcessingLoop := False;
    373484  FProgramIndex := 0;
    374485  NewTextIndex := 0;
    375486  PointerChange := 0;
    376   while (FProgramIndex < Length(FProgram)) do begin
     487  while FProgramIndex < FProgram.Count do begin
    377488    FirstIndex := FProgramIndex;
     489    NoNewCode := False;
    378490    case FProgram[FProgramIndex].Command of
    379491      cmPointerInc: begin
    380         PointerChange := PointerChange + FProgram[FProgramIndex].Parameter;
    381         NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     492        Inc(PointerChange, FProgram[FProgramIndex].Parameter);
     493        NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    382494      end;
    383495      cmPointerDec: begin
    384         PointerChange := PointerChange - FProgram[FProgramIndex].Parameter;
    385         NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     496        Dec(PointerChange, FProgram[FProgramIndex].Parameter);
     497        NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    386498      end;
    387499      cmInc: begin
    388         if not ProcessLoop then begin
    389           NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     500        if not ProcessingLoop then begin
     501          NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    390502        end else begin
    391503          if ((FProgram[FProgramIndex].RelIndex + PointerChange) <> 0) then begin
    392             NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
    393             NewProgram[NewProgramIndex].Command := cmMultipy;
    394           end else Dec(NewProgramIndex);
     504            NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
     505            NewProgram.Operations[NewProgram.Index].Command := cmMultiply;
     506          end else NoNewCode := True;
    395507        end;
    396508      end;
    397509      cmDec: begin
    398         if not ProcessLoop then begin
     510        if not ProcessingLoop then begin
    399511          if (PointerChange = 0) and (FProgram[FProgramIndex].RelIndex = 0) and
    400512            (FProgram[FProgramIndex].Parameter = 1) then
    401513            Inc(NumberOfBaseDecrement);
    402           NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     514          NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    403515        end else begin
    404516          if ((FProgram[FProgramIndex].RelIndex + PointerChange) <> 0) then begin
    405             NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
    406             NewProgram[NewProgramIndex].Command := cmMultipy;
    407             NewProgram[NewProgramIndex].Parameter := -FProgram[FProgramIndex].Parameter;
    408           end else Dec(NewProgramIndex);
     517            NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
     518            NewProgram.Operations[NewProgram.Index].Command := cmMultiply;
     519            NewProgram.Operations[NewProgram.Index].Parameter := -FProgram[FProgramIndex].Parameter;
     520          end else NoNewCode := True;
    409521        end;
    410522      end;
    411523      cmInput, cmOutput: begin
    412         NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     524        NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    413525        Inc(NumberOfBaseDecrement, 2);
    414526      end;
    415527      cmSet: begin
    416         NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
     528        NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
    417529        Inc(NumberOfBaseDecrement, 2);
    418530      end;
    419531      cmLoopStart: begin
    420         if not ProcessLoop then begin
    421           NumberOfBaseDecrement := 0;
    422           PointerChange := 0;
    423           LoopStartIndex := FProgramIndex;
    424           LoopStartIndexNew := NewProgramIndex;
    425           NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
    426         end else begin
    427           Dec(NewProgramIndex);
     532        if not ProcessingLoop then begin
     533          if CheckLoopDecrementCount = 1 then begin
     534            PointerChange := 0;
     535            ProcessingLoop := True;
     536            NoNewCode := True;
     537          end else
     538            NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
     539        end else begin
     540          NoNewCode := True;
    428541        end;
    429542      end;
    430543      cmLoopEnd: begin
    431         if not ProcessLoop then begin
    432           if (NumberOfBaseDecrement = 1) and (PointerChange = 0) then begin
    433             FProgramIndex := LoopstartIndex - 1;
    434             NewProgramIndex := LoopStartIndexNew - 1;
    435             ProcessLoop := True;
    436           end else begin
    437             NewProgram[NewProgramIndex] := FProgram[FProgramIndex];
    438           end;
    439         end else begin
    440           NewProgram[NewProgramIndex] := TMachineOperation.Create(cmSet, 0, 0);
    441           ProcessLoop := False;
    442           NumberOfBaseDecrement := 0;
     544        if not ProcessingLoop then begin
     545          NewProgram[NewProgram.Index] := FProgram[FProgramIndex];
     546        end else begin
     547          // Finally set decrementing cell to zero
     548          NewProgram[NewProgram.Index] := TMachineOperation.Create(cmSet, 0, 0);
     549          ProcessingLoop := False;
    443550        end;
    444551      end;
    445552      else raise Exception.Create(Format(SUnsupportedCommand, [FProgram[FProgramIndex].Command]));
    446553    end;
    447     DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgramIndex, NewTextIndex);
    448     Inc(NewTextIndex, Length(GetOperationText(NewProgram[NewProgramIndex])));
    449     Inc(FProgramIndex);
    450     Inc(NewProgramIndex);
    451   end;
    452   SetLength(NewProgram, NewProgramIndex);
    453 
    454   // Replace old program by new program
    455   SetLength(FProgram, Length(NewProgram));
    456   Move(Pointer(NewProgram)^, Pointer(FProgram)^, SizeOf(TMachineOperation) *
    457     Length(NewProgram));
     554    if NoNewCode then DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, -1, NewTextIndex)
     555      else begin
     556        DebugSteps.UpdateTargetPos(FirstIndex, FProgramIndex, NewProgram.Index, NewTextIndex);
     557        Inc(NewTextIndex, Length(GetOperationText(NewProgram[NewProgram.Index])));
     558      end;
     559    Inc(FProgramIndex);
     560    if not NoNewCode then Inc(NewProgram.Index);
     561  end;
     562
     563  NewProgram.Count := NewProgram.Index;
     564  FProgram.Assign(NewProgram);
     565  FreeAndNil(NewProgram);
    458566end;
    459567
    … …  
    462570  Result := BrainFuckCommandText[Operation.Command];
    463571  if Operation.Command in [cmInc, cmDec, cmPointerInc, cmPointerDec,
    464     cmSet, cmMultipy] then begin
     572    cmSet, cmMultiply] then begin
    465573  if Operation.Parameter <> 1 then
    466574    Result := Result + IntToStr(Operation.Parameter);
    … …  
    476584  inherited;
    477585  DebugSteps.Clear;
    478   SetLength(FProgram, Length(FSourceCode));
     586  FProgram.Count := Length(FSourceCode);
    479587  FProgramIndex := 0;
    480588  for I := 1 to Length(FSourceCode) do begin
    … …  
    516624    Inc(FProgramIndex);
    517625  end;
    518   SetLength(FProgram, FProgramIndex);
     626  FProgram.Count := FProgramIndex;
    519627end;
    520628
    … …  
    524632  MemorySize := 30000;
    525633  CellSize := 256;
     634  FProgram := TProgram.Create;
     635end;
     636
     637destructor TBFTarget.Destroy;
     638begin
     639  FreeAndNil(FProgram);
     640  inherited;
    526641end;
    527642
    … …  
    532647  inherited;
    533648  if Optimizations.AddSub then OptimizeAddSub;
     649  if Optimizations.SetZero then OptimizeSetZero;
    534650  if Optimizations.Merge then
    535651  repeat
    536     OldLength := Length(FProgram);
     652    OldLength := FProgram.Count;
    537653    OptimizeMerge;
    538   until Length(FProgram) = OldLength;
     654  until FProgram.Count = OldLength;
    539655  OptimizeZeroInitMemory;
    540656  if Optimizations.RelativeIndexes then OptimizeRelativeIndexes;
Note: See TracChangeset for help on using the changeset viewer.