Changeset 126


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.
Location:
trunk
Files:
17 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.pas

    r116 r126  
    306306      Core.CurrentTarget := TTarget(Core.Targets[0]);
    307307    Core.Optimizations.AddSub := ReadBoolWithDefault('OptimizationAddSubEnabled', True);
     308    Core.Optimizations.SetZero := ReadBoolWithDefault('OptimizationSetZeroEnabled', True);
    308309    Core.Optimizations.Merge := ReadBoolWithDefault('OptimizationMerge', True);
    309310    Core.Optimizations.CopyMultiply := ReadBoolWithDefault('OptimizationCopyMultiplyEnabled', True);
    … …  
    321322    WriteString('TargetName', Core.CurrentTarget.Name);
    322323    WriteBool('OptimizationAddSubEnabled', Core.Optimizations.AddSub);
     324    WriteBool('OptimizationSetZeroEnabled', Core.Optimizations.SetZero);
    323325    WriteBool('OptimizationMerge', Core.Optimizations.Merge);
    324326    WriteBool('OptimizationCopyMultiplyEnabled', Core.Optimizations.CopyMultiply);

  • trunk/Forms/UFormOptions.lfm

    r103 r126  
    1111  OnCreate = FormCreate
    1212  OnShow = FormShow
    13   LCLVersion = '2.0.0.4'
     13  LCLVersion = '2.2.0.4'
    1414  object ButtonOk: TButton
    1515    Left = 631
    … …  
    4646    object TabSheetGeneral: TTabSheet
    4747      Caption = 'General'
    48       ClientHeight = 277
    49       ClientWidth = 585
     48      ClientHeight = 331
     49      ClientWidth = 701
    5050      ParentFont = False
    5151      object Panel1: TPanel
    5252        Left = 0
    53         Height = 277
     53        Height = 331
    5454        Top = 0
    55         Width = 585
     55        Width = 701
    5656        Align = alClient
    5757        BevelOuter = bvNone
    58         ClientHeight = 277
    59         ClientWidth = 585
     58        ClientHeight = 331
     59        ClientWidth = 701
    6060        ParentFont = False
    6161        TabOrder = 0
    6262        object Label3: TLabel
    6363          Left = 10
    64           Height = 20
     64          Height = 26
    6565          Top = 58
    66           Width = 127
     66          Width = 164
    6767          Caption = 'Interface language:'
    68           ParentColor = False
    6968          ParentFont = False
    7069        end
    7170        object ComboBoxLanguage: TComboBox
    7271          Left = 307
    73           Height = 33
     72          Height = 41
    7473          Top = 58
    7574          Width = 226
    76           ItemHeight = 25
     75          ItemHeight = 0
    7776          ParentFont = False
    7877          Style = csDropDownList
    … …  
    8382          Height = 32
    8483          Top = 102
    85           Width = 1144
     84          Width = 1260
    8685          Anchors = [akTop, akLeft, akRight]
    8786          AutoSize = False
    … …  
    9493          Height = 32
    9594          Top = 150
    96           Width = 1134
     95          Width = 1250
    9796          Anchors = [akTop, akLeft, akRight]
    9897          AutoSize = False
    … …  
    104103        object LabelDPI: TLabel
    105104          Left = 36
    106           Height = 20
    107           Top = 192
    108           Width = 26
     105          Height = 26
     106          Top = 192
     107          Width = 35
    109108          Caption = 'DPI:'
    110           ParentColor = False
    111109          ParentFont = False
    112110        end
    113111        object SpinEditDPIX: TSpinEdit
    114112          Left = 134
    115           Height = 28
     113          Height = 42
    116114          Top = 190
    117115          Width = 96
    … …  
    124122        object SpinEditDPIY: TSpinEdit
    125123          Left = 259
    126           Height = 28
     124          Height = 42
    127125          Top = 192
    128126          Width = 96
    … …  
    135133        object LabelX: TLabel
    136134          Left = 240
    137           Height = 20
    138           Top = 192
    139           Width = 7
     135          Height = 26
     136          Top = 192
     137          Width = 10
    140138          Caption = 'x'
    141           ParentColor = False
    142139          ParentFont = False
    143140        end
    144141        object LabelTheme: TLabel
    145142          Left = 10
    146           Height = 20
     143          Height = 26
    147144          Top = 19
    148           Width = 48
     145          Width = 63
    149146          Caption = 'Theme:'
    150           ParentColor = False
    151147          ParentFont = False
    152148        end
    153149        object ComboBoxTheme: TComboBox
    154150          Left = 307
    155           Height = 33
     151          Height = 41
    156152          Top = 10
    157153          Width = 226
    158           ItemHeight = 25
     154          ItemHeight = 0
    159155          ParentFont = False
    160156          Style = csDropDownList
    … …  
    165161    object TabSheetBuild: TTabSheet
    166162      Caption = 'Build'
    167       ClientHeight = 333
    168       ClientWidth = 703
     163      ClientHeight = 331
     164      ClientWidth = 701
    169165      ParentFont = False
    170166      object Panel2: TPanel
    171167        Left = 0
    172         Height = 333
     168        Height = 331
    173169        Top = 0
    174         Width = 703
     170        Width = 701
    175171        Align = alClient
    176172        BevelOuter = bvNone
    177         ClientHeight = 333
    178         ClientWidth = 703
     173        ClientHeight = 331
     174        ClientWidth = 701
    179175        ParentFont = False
    180176        TabOrder = 0
    181177        object Label4: TLabel
    182178          Left = 10
    183           Height = 25
     179          Height = 26
    184180          Top = 125
    185           Width = 189
     181          Width = 202
    186182          Caption = 'Compiler optimizations:'
    187           ParentColor = False
    188183          ParentFont = False
    189184        end
    190185        object ComboBoxOptimization: TComboBox
    191186          Left = 298
    192           Height = 33
    193           Top = 125
     187          Height = 38
     188          Top = 120
    194189          Width = 226
    195           ItemHeight = 25
     190          ItemHeight = 0
    196191          Items.Strings = (
    197192            'None'
    … …  
    205200        object CheckBoxOptimizeAddSub: TCheckBox
    206201          Left = 37
    207           Height = 29
     202          Height = 30
    208203          Top = 163
    209           Width = 228
     204          Width = 236
    210205          Caption = 'Addition and subtraction'
    211206          ParentFont = False
    … …  
    214209        object CheckBoxOptimizeMerge: TCheckBox
    215210          Left = 37
    216           Height = 29
    217           Top = 192
    218           Width = 218
     211          Height = 30
     212          Top = 224
     213          Width = 227
    219214          Caption = 'Merge same operations'
    220215          ParentFont = False
    … …  
    223218        object CheckBoxOptimizeCopyMultiply: TCheckBox
    224219          Left = 37
    225           Height = 29
    226           Top = 250
    227           Width = 141
     220          Height = 30
     221          Top = 282
     222          Width = 142
    228223          Caption = 'Copy multiply'
     224          OnChange = CheckBoxOptimizeCopyMultiplyChange
    229225          ParentFont = False
    230226          TabOrder = 3
    … …  
    232228        object CheckBoxOptimizeRelativeIndexes: TCheckBox
    233229          Left = 37
    234           Height = 29
    235           Top = 221
    236           Width = 155
     230          Height = 30
     231          Top = 253
     232          Width = 162
    237233          Caption = 'Relative indexes'
     234          OnChange = CheckBoxOptimizeRelativeIndexesChange
    238235          ParentFont = False
    239236          TabOrder = 4
    … …  
    241238        object Label2: TLabel
    242239          Left = 10
    243           Height = 25
    244           Top = 48
    245           Width = 66
     240          Height = 26
     241          Top = 64
     242          Width = 73
    246243          Caption = 'Cell size:'
    247           ParentColor = False
    248244          ParentFont = False
    249245        end
    250246        object Label1: TLabel
    251247          Left = 10
    252           Height = 25
    253           Top = 10
    254           Width = 105
     248          Height = 26
     249          Top = 16
     250          Width = 112
    255251          Caption = 'Memory size:'
    256           ParentColor = False
    257252          ParentFont = False
    258253        end
    259254        object SpinEditMemorySize: TSpinEdit
    260255          Left = 198
    261           Height = 33
     256          Height = 42
    262257          Top = 7
    263258          Width = 156
    … …  
    268263        object SpinEditCellSize: TSpinEdit
    269264          Left = 198
    270           Height = 33
    271           Top = 48
     265          Height = 42
     266          Top = 56
    272267          Width = 156
    273268          MaxValue = 2000000000
    274269          ParentFont = False
    275270          TabOrder = 6
     271        end
     272        object CheckBoxOptimizeSetZero: TCheckBox
     273          Left = 37
     274          Height = 30
     275          Top = 192
     276          Width = 93
     277          Caption = 'Set zero'
     278          ParentFont = False
     279          TabOrder = 7
    276280        end
    277281      end

  • trunk/Forms/UFormOptions.lrj

    r103 r126  
    1717{"hash":150963587,"name":"tformoptions.checkboxoptimizerelativeindexes.caption","sourcebytes":[82,101,108,97,116,105,118,101,32,105,110,100,101,120,101,115],"value":"Relative indexes"},
    1818{"hash":243182762,"name":"tformoptions.label2.caption","sourcebytes":[67,101,108,108,32,115,105,122,101,58],"value":"Cell size:"},
    19 {"hash":239490586,"name":"tformoptions.label1.caption","sourcebytes":[77,101,109,111,114,121,32,115,105,122,101,58],"value":"Memory size:"}
     19{"hash":239490586,"name":"tformoptions.label1.caption","sourcebytes":[77,101,109,111,114,121,32,115,105,122,101,58],"value":"Memory size:"},
     20{"hash":208144671,"name":"tformoptions.checkboxoptimizesetzero.caption","sourcebytes":[83,101,116,32,122,101,114,111],"value":"Set zero"}
    2021]}

  • trunk/Forms/UFormOptions.pas

    r115 r126  
    2020    CheckBoxOptimizeAddSub: TCheckBox;
    2121    CheckBoxOptimizeCopyMultiply: TCheckBox;
     22    CheckBoxOptimizeSetZero: TCheckBox;
    2223    CheckBoxOptimizeMerge: TCheckBox;
    2324    CheckBoxOptimizeRelativeIndexes: TCheckBox;
    … …  
    4243    TabSheetBuild: TTabSheet;
    4344    procedure CheckBoxDPIAutoChange(Sender: TObject);
     45    procedure CheckBoxOptimizeCopyMultiplyChange(Sender: TObject);
     46    procedure CheckBoxOptimizeRelativeIndexesChange(Sender: TObject);
    4447    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    4548    procedure FormCreate(Sender: TObject);
    … …  
    8184  end;
    8285  CheckBoxOptimizeAddSub.Enabled := ComboBoxOptimization.ItemIndex > 0;
     86  CheckBoxOptimizeSetZero.Enabled := ComboBoxOptimization.ItemIndex > 0;
    8387  CheckBoxOptimizeMerge.Enabled := ComboBoxOptimization.ItemIndex > 0;
    8488  CheckBoxOptimizeRelativeIndexes.Enabled := ComboBoxOptimization.ItemIndex > 0;
    … …  
    9498  CheckBox1.Checked := Core.OpenProjectOnStart;
    9599  CheckBoxOptimizeAddSub.Checked := Core.Optimizations.AddSub;
     100  CheckBoxOptimizeSetZero.Checked := Core.Optimizations.SetZero;
    96101  CheckBoxOptimizeMerge.Checked := Core.Optimizations.Merge;
    97102  CheckBoxOptimizeRelativeIndexes.Checked := Core.Optimizations.RelativeIndexes;
    … …  
    119124  Core.MemorySize := SpinEditMemorySize.Value;
    120125  Core.Optimizations.AddSub := CheckBoxOptimizeAddSub.Checked;
     126  Core.Optimizations.SetZero := CheckBoxOptimizeSetZero.Checked;
    121127  Core.Optimizations.Merge := CheckBoxOptimizeMerge.Checked;
    122128  Core.Optimizations.RelativeIndexes := CheckBoxOptimizeRelativeIndexes.Checked;
    … …  
    127133begin
    128134  UpdateInterface;
     135end;
     136
     137procedure TFormOptions.CheckBoxOptimizeCopyMultiplyChange(Sender: TObject);
     138begin
     139  // Needed for optimize copy multiply
     140  if CheckBoxOptimizeCopyMultiply.Checked then
     141    CheckBoxOptimizeRelativeIndexes.Checked := True;
     142end;
     143
     144procedure TFormOptions.CheckBoxOptimizeRelativeIndexesChange(Sender: TObject);
     145begin
     146  // Needed for optimize copy multiply
     147  if not CheckBoxOptimizeRelativeIndexes.Checked then
     148    CheckBoxOptimizeCopyMultiply.Checked := False;
    129149end;
    130150

  • trunk/Languages/LazFuck.cs.po

    r124 r126  
    287287msgstr "Relativní indexy"
    288288
     289#: tformoptions.checkboxoptimizesetzero.caption
     290msgid "Set zero"
     291msgstr "Nastavení nuly"
     292
    289293#: tformoptions.label1.caption
    290294msgid "Memory size:"
    … …  
    544548msgstr "Spouštěč \"%s\" nenalezen"
    545549
    546 #: utargetinterpretter.sjumptablecolision
    547 msgid "Jump table colision"
    548 msgstr "Kolize skokové tabulky"
     550#: utargetinterpretter.sjumptablecollision
     551msgid "Jump table collision"
     552msgstr "Kolize v tabulce skoků"
    549553
    550554#: utargetinterpretter.sjumptableinsistent

  • trunk/Languages/LazFuck.pot

    r124 r126  
    277277msgstr ""
    278278
     279#: tformoptions.checkboxoptimizesetzero.caption
     280msgid "Set zero"
     281msgstr ""
     282
    279283#: tformoptions.label1.caption
    280284msgid "Memory size:"
    … …  
    534538msgstr ""
    535539
    536 #: utargetinterpretter.sjumptablecolision
    537 msgid "Jump table colision"
     540#: utargetinterpretter.sjumptablecollision
     541msgid "Jump table collision"
    538542msgstr ""
    539543

  • trunk/Target/UTargetC.pas

    r125 r126  
    7474  AddLine('Pos = 0;');
    7575  FProgramIndex := 0;
    76   while (FProgramIndex < Length(FProgram)) do begin
     76  while FProgramIndex < FProgram.Count do begin
    7777    case FProgram[FProgramIndex].Command of
    7878      cmPointerInc: AddLine('Pos = Pos + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    … …  
    8383      cmInput: AddLine(GetMemoryCell + ' = getchar();');
    8484      cmSet: AddLine(GetMemoryCell + ' = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    85       cmMultipy: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     85      cmMultiply: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    8686      cmLoopStart: begin
    8787        AddLine('while(' + GetMemoryCell + ' != 0)');

  • trunk/Target/UTargetCSharp.pas

    r125 r126  
    7575  AddLine('Pos = 0;');
    7676  FProgramIndex := 0;
    77   while (FProgramIndex < Length(FProgram)) do begin
     77  while FProgramIndex < FProgram.Count do begin
    7878    case FProgram[FProgramIndex].Command of
    7979      cmPointerInc: AddLine('Pos += ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    … …  
    8484      cmInput: AddLine(GetMemoryCell + ' = (int)Console.ReadKey().KeyChar;');
    8585      cmSet: AddLine(GetMemoryCell + ' = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    86       cmMultipy: begin
     86      cmMultiply: begin
    8787        if FProgram[FProgramIndex].Parameter = 1 then
    8888          AddLine(GetMemoryCell + ' += Memory[Pos];')

  • trunk/Target/UTargetDelphi.pas

    r125 r126  
    6767  AddLine('Pos := 0;');
    6868  FProgramIndex := 0;
    69   while (FProgramIndex < Length(FProgram)) do begin
     69  while FProgramIndex < FProgram.Count do begin
    7070    case FProgram[FProgramIndex].Command of
    7171      cmPointerInc: AddLine('Inc(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    … …  
    7474      cmDec: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    7575      cmSet: AddLine(GetMemoryCell + ' := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    76       cmMultipy: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     76      cmMultiply: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    7777      cmOutput: AddLine('Write(Chr(' + GetMemoryCell + '));');
    7878      cmInput: AddLine('Read(ReadChar); ' + GetMemoryCell + ' := Ord(ReadChar);');

  • trunk/Target/UTargetFPC.pas

    r125 r126  
    6969  AddLine('Pos := 0;');
    7070  FProgramIndex := 0;
    71   while (FProgramIndex < Length(FProgram)) do begin
     71  while FProgramIndex < FProgram.Count do begin
    7272    case FProgram[FProgramIndex].Command of
    7373      cmPointerInc: AddLine('Inc(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    … …  
    7676      cmDec: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    7777      cmSet: AddLine(GetMemoryCell + ' := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    78       cmMultipy: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     78      cmMultiply: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    7979      cmOutput: AddLine('Write(Chr(' + GetMemoryCell + '));');
    8080      cmInput: AddLine('Read(ReadChar); ' + GetMemoryCell + ' := Ord(ReadChar);');

  • trunk/Target/UTargetInterpretter.pas

    r125 r126  
    8383  SProgramUpperLimit = 'Program run over upper limit';
    8484  SJumpTableInsistent = 'Jump table is inconsistent';
    85   SJumpTableColision = 'Jump table colision';
     85  SJumpTableCollision = 'Jump table collision';
    8686  SProgramNotRunning = 'Program not running';
    8787  SUnsupportedCommand = 'Unsupported command';
    … …  
    9595  with Parent do
    9696  repeat
    97     while (FProgramIndex < Length(FProgram)) and (State <> rsStopped) do begin
     97    while (FProgramIndex < FProgram.Count) and (State <> rsStopped) do begin
    9898      if State = rsRunning then begin
    9999        if FProgramBreakpoints[FProgramIndex] then begin
    … …  
    154154  I: Integer;
    155155begin
    156   for I := 0 to Length(FProgram) - 1 do begin
     156  for I := 0 to FProgram.Count - 1 do begin
    157157    case FProgram[I].Command of
    158       cmLoopStart: FProgram[I].Parameter := 0;
    159       cmLoopEnd: FProgram[I].Parameter := 0;
     158      cmLoopStart: FProgram.Operations[I].Parameter := 0;
     159      cmLoopEnd: FProgram.Operations[I].Parameter := 0;
    160160    end;
    161161  end;
    162162
    163163  SetLength(Loop, 0);
    164   for I := 0 to Length(FProgram) - 1 do begin
     164  for I := 0 to FProgram.Count - 1 do begin
    165165    case FProgram[I].Command of
    166166      cmLoopStart: begin
    … …  
    170170      cmLoopEnd: begin
    171171        if FProgram[I].Parameter > 0 then
    172           raise Exception.Create(SJumpTableColision);
    173         FProgram[I].Parameter := Loop[High(Loop)];
     172          raise Exception.Create(SJumpTableCollision);
     173        FProgram.Operations[I].Parameter := Loop[High(Loop)];
    174174        if FProgram[Loop[High(Loop)]].Parameter > 0 then
    175           raise Exception.Create(SJumpTableColision);
    176         FProgram[Loop[High(Loop)]].Parameter := I;
     175          raise Exception.Create(SJumpTableCollision);
     176        FProgram.Operations[Loop[High(Loop)]].Parameter := I;
    177177        SetLength(Loop, Length(Loop) - 1);
    178178      end;
    … …  
    303303  I: Integer;
    304304begin
    305   SetLength(FProgramBreakpoints, Length(FProgram));
     305  SetLength(FProgramBreakpoints, FProgram.Count);
    306306  for I := 0 to High(FProgramBreakpoints) do
    307307    FProgramBreakpoints[I] := False;
    308308  for I := 0 to BreakPoints.Count - 1 do
    309     if TBreakPoint(BreakPoints[I]).TargetAddress < Length(FProgramBreakpoints) then
    310       FProgramBreakpoints[TBreakPoint(BreakPoints[I]).TargetAddress] := True;
     309    if BreakPoints[I].TargetAddress < Length(FProgramBreakpoints) then
     310      FProgramBreakpoints[BreakPoints[I].TargetAddress] := True;
    311311end;
    312312
    … …  
    316316begin
    317317  Result := '';
    318   for I := 0 to Length(FProgram) - 1 do begin
     318  for I := 0 to FProgram.Count - 1 do begin
    319319    Result := Result + GetOperationText(FProgram[I]);
    320320  end;
    … …  
    438438  // Extended commands
    439439  FCommandTable[cmSet] := CommandSet;
    440   FCommandTable[cmMultipy] := CommandMultiply;
     440  FCommandTable[cmMultiply] := CommandMultiply;
    441441end;
    442442

  • trunk/Target/UTargetJava.pas

    r125 r126  
    7474  AddLine('Pos = 0;');
    7575  FProgramIndex := 0;
    76   while (FProgramIndex < Length(FProgram)) do begin
     76  while FProgramIndex < FProgram.Count do begin
    7777    case FProgram[FProgramIndex].Command of
    7878      cmPointerInc: AddLine('Pos = Pos + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    … …  
    8383      cmInput: AddLine(GetMemoryCell + ' = (char)System.in.read();');
    8484      cmSet: AddLine(GetMemoryCell + ' = (char)' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    85       cmMultipy: AddLine(GetMemoryCell + ' = (char)((int)' + GetMemoryCell + ' + (int)Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     85      cmMultiply: AddLine(GetMemoryCell + ' = (char)((int)' + GetMemoryCell + ' + (int)Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    8686      cmLoopStart: begin
    8787        AddLine('while(' + GetMemoryCell + ' != 0)');

  • trunk/Target/UTargetJavascript.pas

    r125 r126  
    6161  AddLine('');
    6262  FProgramIndex := 0;
    63   while (FProgramIndex < Length(FProgram)) do begin
     63  while FProgramIndex < FProgram.Count do begin
    6464    case FProgram[FProgramIndex].Command of
    6565      cmPointerInc: AddLine('Pos = Pos + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    … …  
    7070      cmInput: ; //AddLine(GetMemoryCell + ' = getchar();');
    7171      cmSet: AddLine(GetMemoryCell + ' = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    72       cmMultipy: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     72      cmMultiply: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    7373      cmLoopStart: begin
    7474        AddLine('while(' + GetMemoryCell + ' != 0)');

  • trunk/Target/UTargetPHP.pas

    r125 r126  
    6666  AddLine('$Position = 0;');
    6767  FProgramIndex := 0;
    68   while (FProgramIndex < Length(FProgram)) do begin
     68  while FProgramIndex < FProgram.Count do begin
    6969    case FProgram[FProgramIndex].Command of
    7070      cmPointerInc: AddLine('$Position = $Position + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    … …  
    7777      cmInput: AddLine(GetMemoryCell + ' = fgetc(STDIN);');
    7878      cmSet: AddLine(GetMemoryCell + ' = chr(' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    79       cmMultipy: AddLine(GetMemoryCell + ' = chr(ord(' + GetMemoryCell + ') + ord($Memory[$Position]) * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     79      cmMultiply: AddLine(GetMemoryCell + ' = chr(ord(' + GetMemoryCell + ') + ord($Memory[$Position]) * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    8080      cmLoopStart: begin
    8181        AddLine('while(' + GetMemoryCell + ' != "\0") {');

  • trunk/Target/UTargetPython.pas

    r125 r126  
    104104  AddLine('position = 0');
    105105  FProgramIndex := 0;
    106   while (FProgramIndex < Length(FProgram)) do begin
     106  while FProgramIndex < FProgram.Count do begin
    107107    case FProgram[FProgramIndex].Command of
    108108      cmPointerInc: AddLine('position += ' + IntToStr(FProgram[FProgramIndex].Parameter));
    … …  
    116116      cmInput: AddLine(GetMemoryCell + ' = ord(getchar())');
    117117      cmSet: AddLine(GetMemoryCell + ' = ' + IntToStr(FProgram[FProgramIndex].Parameter));
    118       cmMultipy: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + memory[position] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     118      cmMultiply: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + memory[position] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    119119      cmLoopStart: begin
    120120        AddLine('while(' + GetMemoryCell + ' != 0):');

  • 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;

  • trunk/UTarget.pas

    r125 r126  
    289289  Last := SearchIndexByProgramPos(OldProgramTo);
    290290  for I := Last downto First + 1 do Delete(I);
    291   Items[First].ProgramPosition := NewProgram;
    292   Items[First].TargetPosition := NewTarget;
    293 end;
    294 
     291  if NewProgram = -1 then begin
     292    Delete(First);
     293  end else begin
     294    if (First >= 0) and (First < Count) then begin
     295      Items[First].ProgramPosition := NewProgram;
     296      Items[First].TargetPosition := NewTarget;
     297    end else begin
     298      // Index not found, possible new command?
     299    end;
     300  end;
     301end;
    295302
    296303{ TTargetList }
Note: See TracChangeset for help on using the changeset viewer.