Changeset 64


Ignore:
Timestamp:
Dec 4, 2014, 2:59:28 PM (10 years ago)
Author:
chronos
Message:
  • Modified: Now commands cmInc, cmDec, cmPointerInc, cmPointerDec and cmSet use numeric parameter to merge multiple small steps to one unary operation with numeric parameter. Optimization is done on TTarget side and not on each specific targets.
  • Added: Optimization to eliminate redundant source code.
  • Added: Optimization level option in Options dialog.
Location:
trunk
Files:
1 added
16 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.pas

    r63 r64  
    194194    FCurrentTarget.OnChangeState := TargetStateChanged;
    195195    FCurrentTarget.OnLog := TargetLogExecute;
     196    FCurrentTarget.OptimizationLevel := Core.OptimizationLevel;
    196197    FCurrentTarget.Messages.OnChange := MessagesChanged;
    197198  end;
    … …  
    469470    //OptionsForm.SaveToInterpretter(CurrentTarget);
    470471    OptionsForm.Save;
     472    if Assigned(CurrentTarget) then
     473      CurrentTarget.OptimizationLevel := Core.OptimizationLevel;
    471474  end;
    472475end;
    … …  
    476479  with CurrentTarget do begin
    477480    AProgramStop.Execute;
    478     Optimization := coNormal;
    479481    SourceCode := FormSourceCode.MemoSource.Text;
    480482    ProjectFileName := Core.Project.FileName;

  • trunk/Forms/UFormOptions.lfm

    r59 r64  
    11object OptionsForm: TOptionsForm
    22  Left = 415
    3   Height = 279
     3  Height = 339
    44  Top = 210
    55  Width = 468
    66  Caption = 'Options'
    7   ClientHeight = 279
     7  ClientHeight = 339
    88  ClientWidth = 468
    99  OnShow = FormShow
    … …  
    1212    Left = 389
    1313    Height = 25
    14     Top = 247
     14    Top = 307
    1515    Width = 75
    1616    Anchors = [akRight, akBottom]
    … …  
    2323    Left = 304
    2424    Height = 25
    25     Top = 247
     25    Top = 307
    2626    Width = 75
    2727    Anchors = [akRight, akBottom]
    … …  
    8080    TabOrder = 4
    8181  end
    82   object ComboBoxLanguage: TComboBox
    83     Left = 248
    84     Height = 37
    85     Top = 83
    86     Width = 188
    87     ItemHeight = 0
    88     Style = csDropDownList
    89     TabOrder = 5
    90   end
    9182  object SpinEditDPIX: TSpinEdit
    9283    Left = 104
    … …  
    9687    MaxValue = 1000
    9788    MinValue = 1
    98     TabOrder = 6
     89    TabOrder = 5
    9990    Value = 1
    10091  end
    … …  
    114105    MaxValue = 1000
    115106    MinValue = 1
    116     TabOrder = 7
     107    TabOrder = 6
    117108    Value = 1
    118109  end
    … …  
    134125    Caption = 'Automatic DPI'
    135126    OnChange = CheckBoxDPIAutoChange
     127    TabOrder = 7
     128  end
     129  object Label4: TLabel
     130    Left = 16
     131    Height = 25
     132    Top = 248
     133    Width = 221
     134    Caption = 'Compiler optimizations:'
     135    ParentColor = False
     136  end
     137  object ComboBoxLanguage: TComboBox
     138    Left = 248
     139    Height = 37
     140    Top = 83
     141    Width = 188
     142    ItemHeight = 0
     143    Style = csDropDownList
    136144    TabOrder = 8
    137145  end
     146  object ComboBoxOptimizatipn: TComboBox
     147    Left = 256
     148    Height = 37
     149    Top = 240
     150    Width = 188
     151    ItemHeight = 0
     152    Items.Strings = (
     153      'None'
     154      'Normal'
     155    )
     156    Style = csDropDownList
     157    TabOrder = 9
     158  end
    138159end

  • trunk/Forms/UFormOptions.lrt

    r59 r64  
    99TOPTIONSFORM.LABELX.CAPTION=x
    1010TOPTIONSFORM.CHECKBOXDPIAUTO.CAPTION=Automatic DPI
     11TOPTIONSFORM.LABEL4.CAPTION=Compiler optimizations:

  • trunk/Forms/UFormOptions.pas

    r59 r64  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   Spin, UTargetInterpretter;
     9  Spin, UTargetInterpretter, UTarget;
    1010
    1111type
    … …  
    1919    CheckBoxDPIAuto: TCheckBox;
    2020    ComboBoxLanguage: TComboBox;
     21    ComboBoxOptimizatipn: TComboBox;
    2122    Label1: TLabel;
    2223    Label2: TLabel;
    2324    Label3: TLabel;
     25    Label4: TLabel;
    2426    LabelDPI: TLabel;
    2527    LabelX: TLabel;
    … …  
    7880  SpinEditDPIY.Value := Core.ScaleDPI.DPI.Y;
    7981  CheckBoxDPIAuto.Checked := Core.ScaleDPI.AutoDetect;
     82  ComboBoxOptimizatipn.ItemIndex := Integer(Core.OptimizationLevel);
    8083  UpdateInterface;
    8184end;
    … …  
    8689  Core.ScaleDPI.DPI.Y := SpinEditDPIY.Value;
    8790  Core.ScaleDPI.AutoDetect := CheckBoxDPIAuto.Checked;
     91  Core.OptimizationLevel := TCompilerOptimization(ComboBoxOptimizatipn.ItemIndex);
    8892end;
    8993

  • trunk/Forms/UFormTargetCode.lfm

    r48 r64  
    77  ClientHeight = 240
    88  ClientWidth = 320
    9   LCLVersion = '1.1'
     9  LCLVersion = '1.3'
    1010  object MemoTarget: TMemo
    1111    Left = 0
    … …  
    1414    Width = 320
    1515    Align = alClient
     16    Font.Name = 'Courier New'
     17    ParentFont = False
    1618    PopupMenu = PopupMenuTarget
    1719    ReadOnly = True

  • trunk/Languages/LazFuckIDE.cs.po

    r62 r64  
    547547msgstr "Jazyk rozhraní:"
    548548
     549#: toptionsform.label4.caption
     550msgid "Compiler optimizations:"
     551msgstr ""
     552
    549553#: toptionsform.labeldpi.caption
    550554msgctxt "toptionsform.labeldpi.caption"
    … …  
    743747msgid "Read input error"
    744748msgstr "Chyba čtení vstupu"
     749
     750#: utargetinterpretter.sunsupportedcommand
     751msgid "Unsupported command"
     752msgstr ""
     753

  • trunk/Languages/LazFuckIDE.po

    r62 r64  
    534534msgstr ""
    535535
     536#: toptionsform.label4.caption
     537msgid "Compiler optimizations:"
     538msgstr ""
     539
    536540#: toptionsform.labeldpi.caption
    537541msgctxt "TOPTIONSFORM.LABELDPI.CAPTION"
    … …  
    731735msgstr ""
    732736
     737#: utargetinterpretter.sunsupportedcommand
     738msgid "Unsupported command"
     739msgstr ""
     740

  • trunk/LazFuckIDE.lpi

    r61 r64  
    133133      </Unit4>
    134134      <Unit5>
    135         <Filename Value="Target\UTarget.pas"/>
     135        <Filename Value="UTarget.pas"/>
    136136        <IsPartOfProject Value="True"/>
    137137        <UnitName Value="UTarget"/>
    … …  
    207207        <HasResources Value="True"/>
    208208        <ResourceBaseClass Value="Form"/>
     209        <UnitName Value="UFormTargetCode"/>
    209210      </Unit16>
    210211      <Unit17>

  • trunk/Target/UTargetC.pas

    r60 r64  
    6565  FProgramIndex := 0;
    6666  while (FProgramIndex < Length(FProgram)) do begin
    67     case FProgram[FProgramIndex] of
    68       cmPointerInc: begin
    69         Sum := CheckOccurence(cmPointerInc);
    70         AddLine('Pos = Pos + ' + IntToStr(Sum) + ';');
    71       end;
    72       cmPointerDec: begin
    73         Sum := CheckOccurence(cmPointerDec);
    74         AddLine('Pos = Pos - ' + IntToStr(Sum) + ';');
    75       end;
    76       cmInc: begin
    77         Sum := CheckOccurence(cmInc);
    78         AddLine('Memory[Pos] = Memory[Pos] + ' + IntToStr(Sum) + ';');
    79       end;
    80       cmDec: begin
    81         Sum := CheckOccurence(cmDec);
    82         AddLine('Memory[Pos] = Memory[Pos] - ' + IntToStr(Sum) + ';');
    83       end;
     67    case FProgram[FProgramIndex].Command of
     68      cmPointerInc: AddLine('Pos = Pos + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     69      cmPointerDec: AddLine('Pos = Pos - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     70      cmInc: AddLine('Memory[Pos] = Memory[Pos] + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     71      cmDec: AddLine('Memory[Pos] = Memory[Pos] - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    8472      cmOutput: AddLine('putchar(Memory[Pos]);');
    8573      cmInput: AddLine('Memory[Pos] = getchar();');
     74      cmSet: AddLine('Memory[Pos] = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    8675      cmLoopStart: begin
    87         if CheckClear then begin
    88           AddLine('Memory[Pos] = 0;');
    89           Inc(FProgramIndex, 2);
    90         end else begin
    91           AddLine('while(Memory[Pos] != 0)');
    92           AddLine('{');
    93           Inc(Indent);
    94         end;
     76        AddLine('while(Memory[Pos] != 0)');
     77        AddLine('{');
     78        Inc(Indent);
    9579      end;
    9680      cmLoopEnd: begin

  • trunk/Target/UTargetDelphi.pas

    r60 r64  
    5959  FProgramIndex := 0;
    6060  while (FProgramIndex < Length(FProgram)) do begin
    61     case FProgram[FProgramIndex] of
    62       cmPointerInc: begin
    63         Sum := CheckOccurence(cmPointerInc);
    64         AddLine('Inc(Pos, ' + IntToStr(Sum) + ');');
    65       end;
    66       cmPointerDec: begin
    67         Sum := CheckOccurence(cmPointerDec);
    68         AddLine('Dec(Pos, ' + IntToStr(Sum) + ');');
    69       end;
    70       cmInc: begin
    71         Sum := CheckOccurence(cmInc);
    72         AddLine('Memory[Pos] := Memory[Pos] + ' + IntToStr(Sum) + ';');
    73       end;
    74       cmDec: begin
    75         Sum := CheckOccurence(cmDec);
    76         AddLine('Memory[Pos] := Memory[Pos] - ' + IntToStr(Sum) + ';');
    77       end;
     61    case FProgram[FProgramIndex].Command of
     62      cmPointerInc: AddLine('Inc(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     63      cmPointerDec: AddLine('Dec(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     64      cmInc: AddLine('Memory[Pos] := Memory[Pos] + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     65      cmDec: AddLine('Memory[Pos] := Memory[Pos] - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     66      cmSet: AddLine('Memory[Pos] := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    7867      cmOutput: AddLine('Write(Chr(Memory[Pos]));');
    7968      cmInput: AddLine('Read(ReadChar); Memory[Pos] := Ord(ReadChar);');
    8069      cmLoopStart: begin
    81         if CheckClear then begin
    82           AddLine('Memory[Pos] := 0;');
    83           Inc(FProgramIndex, 2);
    84         end else begin
    85           AddLine('while Memory[Pos] <> 0 do begin');
    86           Inc(Indent);
    87         end;
     70        AddLine('while Memory[Pos] <> 0 do begin');
     71        Inc(Indent);
    8872      end;
    8973      cmLoopEnd: begin

  • trunk/Target/UTargetFPC.pas

    r60 r64  
    4444
    4545procedure TTargetFPC.Compile;
    46 var
    47   Sum: Integer;
    4846begin
    4947  inherited;
    … …  
    6260  FProgramIndex := 0;
    6361  while (FProgramIndex < Length(FProgram)) do begin
    64     case FProgram[FProgramIndex] of
    65       cmPointerInc: begin
    66         Sum := CheckOccurence(cmPointerInc);
    67         AddLine('Inc(Pos, ' + IntToStr(Sum) + ');');
    68       end;
    69       cmPointerDec: begin
    70         Sum := CheckOccurence(cmPointerDec);
    71         AddLine('Dec(Pos, ' + IntToStr(Sum) + ');');
    72       end;
    73       cmInc: begin
    74         Sum := CheckOccurence(cmInc);
    75         AddLine('Memory[Pos] := Memory[Pos] + ' + IntToStr(Sum) + ';');
    76       end;
    77       cmDec: begin
    78         Sum := CheckOccurence(cmDec);
    79         AddLine('Memory[Pos] := Memory[Pos] - ' + IntToStr(Sum) + ';');
    80       end;
     62    case FProgram[FProgramIndex].Command of
     63      cmPointerInc: AddLine('Inc(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     64      cmPointerDec: AddLine('Dec(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     65      cmInc: AddLine('Memory[Pos] := Memory[Pos] + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     66      cmDec: AddLine('Memory[Pos] := Memory[Pos] - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     67      cmSet: AddLine('Memory[Pos] := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    8168      cmOutput: AddLine('Write(Chr(Memory[Pos]));');
    8269      cmInput: AddLine('Read(ReadChar); Memory[Pos] := Ord(ReadChar);');
    8370      cmLoopStart: begin
    84         if CheckClear then begin
    85           AddLine('Memory[Pos] := 0;');
    86           Inc(FProgramIndex, 2);
    87         end else begin
    88           AddLine('while Memory[Pos] <> 0 do begin');
    89           Inc(Indent);
    90         end;
     71        AddLine('while Memory[Pos] <> 0 do begin');
     72        Inc(Indent);
    9173      end;
    9274      cmLoopEnd: begin

  • trunk/Target/UTargetInterpretter.pas

    r52 r64  
    3333    FThread: TTargetInterpretterThread;
    3434    FStepCount: Integer;
    35     FCommandTable: array[TBrainFuckCommand] of TCommandHandler;
     35    FCommandTable: array[TMachineCommand] of TCommandHandler;
    3636    function GetMemorySize: Integer;
    3737    procedure SetMemorySize(AValue: Integer);
    … …  
    4646    procedure CommandLoopStart;
    4747    procedure CommandLoopEnd;
     48    procedure CommandSet;
    4849    procedure PrepareBreakPoints;
    4950  protected
    … …  
    8182
    8283const
    83   BrainFuckCommandText: array[TBrainFuckCommand] of Char = (
    84     ' ', '+', '-', '>', '<', '.', ',', '[', ']', '@');
     84  BrainFuckCommandText: array[TMachineCommand] of Char = (
     85    ' ', '+', '-', '>', '<', '.', ',', '[', ']', '@', '=');
    8586
    8687
    … …  
    9596  SMemoryCellOutOfRange = 'Memory cell %s value out of range';
    9697  SProgramNotRunning = 'Program not running';
     98  SUnsupportedCommand = 'Unsupported command';
    9799
    98100{ TTargetInterpretterThread }
    … …  
    111113          SetStateSafe(rsPaused);
    112114        end else begin
    113           FCommandTable[FProgram[FProgramIndex]];
     115          if Assigned(FCommandTable[FProgram[FProgramIndex].Command]) then
     116            FCommandTable[FProgram[FProgramIndex].Command]
     117            else raise Exception.Create(SUnsupportedCommand);
    114118          Inc(FProgramIndex);
    115119          Inc(FStepCount);
    … …  
    177181  SetLength(Loop, 0);
    178182  for I := 0 to Length(FProgram) - 1 do begin
    179     case FProgram[I] of
     183    case FProgram[I].Command of
    180184      cmLoopStart: begin
    181185        SetLength(Loop, Length(Loop) + 1);
    … …  
    194198end;
    195199
    196 procedure TTargetInterpretter.CommandInc;
    197 begin
    198   Memory[MemoryPosition] := ((Memory[MemoryPosition] + 1) mod CellSize);
    199 end;
    200 
    201 procedure TTargetInterpretter.CommandDec;
    202 begin
    203   Memory[MemoryPosition] := ((Memory[MemoryPosition] - 1) mod CellSize);
    204 end;
    205 
    206 procedure TTargetInterpretter.CommandPointerInc;
    207 begin
    208   if MemoryPosition < MemorySize then Inc(MemoryPosition)
    209     else raise Exception.Create(SProgramUpperLimit);
    210 end;
    211 
    212 procedure TTargetInterpretter.CommandPointerDec;
    213 begin
    214   if MemoryPosition > 0 then Dec(MemoryPosition)
    215     else raise Exception.Create(SProgramLowerLimit);
    216 end;
    217 
    218200procedure TTargetInterpretter.CommandInput;
    219201begin
    … …  
    245227  if Memory[MemoryPosition] > 0 then
    246228    FProgramIndex := SourceJump[FProgramIndex] - 1;
     229end;
     230
     231procedure TTargetInterpretter.CommandInc;
     232begin
     233  Memory[MemoryPosition] := ((Memory[MemoryPosition] + FProgram[FProgramIndex].Parameter) mod CellSize);
     234end;
     235
     236procedure TTargetInterpretter.CommandDec;
     237begin
     238  Memory[MemoryPosition] := ((Memory[MemoryPosition] - FProgram[FProgramIndex].Parameter) mod CellSize);
     239end;
     240
     241procedure TTargetInterpretter.CommandPointerInc;
     242begin
     243  if MemoryPosition < MemorySize then Inc(MemoryPosition, FProgram[FProgramIndex].Parameter)
     244    else raise Exception.Create(SProgramUpperLimit);
     245end;
     246
     247procedure TTargetInterpretter.CommandPointerDec;
     248begin
     249  if MemoryPosition > 0 then Dec(MemoryPosition, FProgram[FProgramIndex].Parameter)
     250    else raise Exception.Create(SProgramLowerLimit);
     251end;
     252
     253procedure TTargetInterpretter.CommandSet;
     254begin
     255  Memory[MemoryPosition] := FProgram[FProgramIndex].Parameter mod CellSize;
    247256end;
    248257
    … …  
    286295  I: Integer;
    287296begin
    288   SetLength(Result, Length(FProgram));
    289   for I := 0 to Length(FProgram) - 1 do
    290     Result[I + 1] := BrainFuckCommandText[FProgram[I]];
     297  Result := '';
     298  for I := 0 to Length(FProgram) - 1 do begin
     299    Result := Result + BrainFuckCommandText[FProgram[I].Command];
     300    if FProgram[I].Command in [cmInc, cmDec, cmSet, cmPointerInc, cmPointerDec] then begin
     301      if FProgram[I].Parameter > 1 then
     302        Result := Result + IntToStr(FProgram[I].Parameter);
     303    end;
     304  end;
    291305end;
    292306
    … …  
    402416  MemorySize := 30000;
    403417  CellSize := 256;
     418  // Base commands
    404419  FCommandTable[cmInc] := CommandInc;
    405420  FCommandTable[cmDec] := CommandDec;
    … …  
    410425  FCommandTable[cmLoopStart] := CommandLoopStart;
    411426  FCommandTable[cmLoopEnd] := CommandLoopEnd;
     427  // Extended commands
     428  FCommandTable[cmSet] := CommandSet;
    412429end;
    413430

  • trunk/Target/UTargetJava.pas

    r60 r64  
    6666  FProgramIndex := 0;
    6767  while (FProgramIndex < Length(FProgram)) do begin
    68     case FProgram[FProgramIndex] of
    69       cmPointerInc: begin
    70         Sum := CheckOccurence(cmPointerInc);
    71         AddLine('Pos = Pos + ' + IntToStr(Sum) + ';');
    72       end;
    73       cmPointerDec: begin
    74         Sum := CheckOccurence(cmPointerDec);
    75         AddLine('Pos = Pos - ' + IntToStr(Sum) + ';');
    76       end;
    77       cmInc: begin
    78         Sum := CheckOccurence(cmInc);
    79         AddLine('Memory[Pos] = (char)((int)Memory[Pos] + ' + IntToStr(Sum) + ');');
    80       end;
    81       cmDec: begin
    82         Sum := CheckOccurence(cmDec);
    83         AddLine('Memory[Pos] = (char)((int)Memory[Pos] - ' + IntToStr(Sum) + ');');
    84       end;
     68    case FProgram[FProgramIndex].Command of
     69      cmPointerInc: AddLine('Pos = Pos + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     70      cmPointerDec: AddLine('Pos = Pos - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     71      cmInc: AddLine('Memory[Pos] = (char)((int)Memory[Pos] + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     72      cmDec: AddLine('Memory[Pos] = (char)((int)Memory[Pos] - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    8573      cmOutput: AddLine('System.out.print(Memory[Pos]);');
    8674      cmInput: AddLine('Memory[Pos] = (char)System.in.read();');
     75      cmSet: AddLine('Memory[Pos] = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
    8776      cmLoopStart: begin
    88         if CheckClear then begin
    89           AddLine('Memory[Pos] = 0;');
    90           Inc(FProgramIndex, 2);
    91         end else begin
    92           AddLine('while(Memory[Pos] != 0)');
    93           AddLine('{');
    94           Inc(Indent);
    95         end;
     77        AddLine('while(Memory[Pos] != 0)');
     78        AddLine('{');
     79        Inc(Indent);
    9680      end;
    9781      cmLoopEnd: begin

  • trunk/Target/UTargetPHP.pas

    r60 r64  
    5858  FProgramIndex := 0;
    5959  while (FProgramIndex < Length(FProgram)) do begin
    60     case FProgram[FProgramIndex] of
    61       cmPointerInc: begin
    62         Sum := CheckOccurence(cmPointerInc);
    63         AddLine('$Position = $Position + ' + IntToStr(Sum) + ';');
    64       end;
    65       cmPointerDec: begin
    66         Sum := CheckOccurence(cmPointerDec);
    67         AddLine('$Position = $Position - ' + IntToStr(Sum) + ';');
    68       end;
    69       cmInc: begin
    70         Sum := CheckOccurence(cmInc);
    71         AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) + ' + IntToStr(Sum) + ');');
    72       end;
    73       cmDec: begin
    74         Sum := CheckOccurence(cmDec);
    75         AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) - ' + IntToStr(Sum) + ');');
    76       end;
     60    case FProgram[FProgramIndex].Command of
     61      cmPointerInc: AddLine('$Position = $Position + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     62      cmPointerDec: AddLine('$Position = $Position - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
     63      cmInc: AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
     64      cmDec: AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    7765      cmOutput: AddLine('echo($Memory[$Position]);');
    7866      cmInput: AddLine('$Memory[$Position] = fgetc(STDIN);');
     67      cmSet: AddLine('$Memory[$Position] = chr(' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
    7968      cmLoopStart: begin
    80         if CheckClear then begin
    81           AddLine('$Memory[$Position] = "\0";');
    82           Inc(FProgramIndex, 2);
    83         end else begin
    84           AddLine('while($Memory[$Position] != "\0") {');
    85           Inc(Indent);
    86         end;
     69        AddLine('while($Memory[$Position] != "\0") {');
     70        Inc(Indent);
    8771      end;
    8872      cmLoopEnd: begin

  • trunk/UCore.pas

    r61 r64  
    2525    Targets: TTargetList;
    2626    OpenProjectOnStart: Boolean;
     27    OptimizationLevel: TCompilerOptimization;
    2728    procedure LoadFromRegistry(Root: HKEY; Key: string);
    2829    procedure SaveToRegistry(Root: HKEY; Key: string);
    … …  
    8081      ReadIntegerWithDefault('DPIY', 96));
    8182    ScaleDPI.AutoDetect := ReadBoolWithDefault('DPIAuto', True);
     83    OptimizationLevel := TCompilerOptimization(ReadIntegerWithDefault('OptimizationLevel', Integer(coNormal)));
    8284  finally
    8385    Free;
    … …  
    99101    WriteInteger('DPIX', ScaleDPI.DPI.X);
    100102    WriteInteger('DPIY', ScaleDPI.DPI.Y);
     103    WriteInteger('OptimizationLevel', Integer(OptimizationLevel));
    101104    if Assigned(CoolTranslator1.Language) and (CoolTranslator1.Language.Code <> '') then
    102105      WriteString('LanguageCode', CoolTranslator1.Language.Code)

  • trunk/UTarget.pas

    r63 r64  
    6666  end;
    6767
    68   TBrainFuckCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
    69     cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug);
     68  TMachineCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
     69    cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug, cmSet);
     70
     71  TMachineOperation = record
     72    Command: TMachineCommand;
     73    Parameter: Integer;
     74  end;
    7075
    7176  TLogEvent = procedure (Lines: TStrings) of object;
    … …  
    8085    function SourceReadNext: Char;
    8186    function CheckClear: Boolean;
    82     function CheckOccurence(C: TBrainFuckCommand): Integer;
     87    function CheckOccurenceSumParam(C: TMachineCommand): Integer;
     88    function CheckOccurence(C: TMachineCommand): Integer;
     89    procedure OptimizeAddSub;
     90    procedure OptimizeMerge;
     91    procedure OptimizeZeroInitMemory;
    8392  protected
    8493    FSourceCode: string;
    85     FProgram: array of TBrainFuckCommand;
     94    FProgram: array of TMachineOperation;
    8695    FProgramIndex: Integer;
    8796    FTargetCode: string;
    … …  
    101110    ProgramName: string;
    102111    ImageIndex: Integer;
    103     Optimization: TCompilerOptimization;
     112    OptimizationLevel: TCompilerOptimization;
    104113    CompilerPath: string;
    105114    ExecutorPath: string;
    … …  
    367376begin
    368377  inherited;
    369   Optimization := coNormal;
     378  OptimizationLevel := coNormal;
    370379  BreakPoints := TBreakPointList.Create;
    371380  DebugSteps := TDebugStepList.Create;
    … …  
    387396
    388397procedure TTarget.OptimizeSource;
    389 begin
    390   // Remove redundand code
    391 
     398var
     399  OldLength: Integer;
     400begin
     401  OptimizeAddSub;
     402  repeat
     403    OldLength := Length(FProgram);
     404    OptimizeMerge;
     405  until Length(FProgram) = OldLength;
     406  OptimizeZeroInitMemory;
    392407end;
    393408
    … …  
    395410begin
    396411  LoadProgram;
     412  if OptimizationLevel = coNormal then OptimizeSource;
    397413  Compiled := True;
    398414end;
    … …  
    528544end;
    529545
    530 function TTarget.CheckOccurence(C: TBrainFuckCommand): Integer;
     546function TTarget.CheckOccurence(C: TMachineCommand): Integer;
    531547begin
    532548  Result := 1;
    533   if Optimization = coNormal then
    534   while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1] = C) do begin
     549  while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
    535550    Inc(Result);
    536551    Inc(FProgramIndex);
    537552  end;
     553end;
     554
     555function TTarget.CheckOccurenceSumParam(C: TMachineCommand): Integer;
     556begin
     557  Result := FProgram[FProgramIndex].Parameter;
     558  while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
     559    Inc(Result, FProgram[FProgramIndex + 1].Parameter);
     560    Inc(FProgramIndex);
     561  end;
     562end;
     563
     564procedure TTarget.OptimizeAddSub;
     565var
     566  NewProgram: array of TMachineOperation;
     567  NewProgramIndex: Integer;
     568begin
     569  NewProgramIndex := 0;
     570  SetLength(NewProgram, Length(FProgram));
     571
     572  FProgramIndex := 0;
     573  while (FProgramIndex < Length(FProgram)) do begin
     574    case FProgram[FProgramIndex].Command of
     575      cmPointerInc: begin
     576        NewProgram[NewProgramIndex].Command := cmPointerInc;
     577        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerInc);
     578      end;
     579      cmPointerDec: begin
     580        NewProgram[NewProgramIndex].Command := cmPointerDec;
     581        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerDec);
     582      end;
     583      cmInc: begin
     584        NewProgram[NewProgramIndex].Command := cmInc;
     585        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmInc);
     586      end;
     587      cmDec: begin
     588        NewProgram[NewProgramIndex].Command := cmDec;
     589        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmDec);
     590      end;
     591      else begin
     592        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     593        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     594      end;
     595    end;
     596    Inc(FProgramIndex);
     597    Inc(NewProgramIndex);
     598  end;
     599  SetLength(NewProgram, NewProgramIndex);
     600
     601  // Replace old program by new program
     602  SetLength(FProgram, Length(NewProgram));
     603  Move(NewProgram[0], FProgram[0], SizeOf(TMachineOperation) * Length(NewProgram));
     604end;
     605
     606procedure TTarget.OptimizeMerge;
     607var
     608  NewProgram: array of TMachineOperation;
     609  NewProgramIndex: Integer;
     610  PreviousCommand: TMachineCommand;
     611begin
     612  // Merge together cmInc, cmDec, cmSet
     613  // Merge together cmPointerInc, cmPointerDec
     614  PreviousCommand := cmNoOperation;
     615  NewProgramIndex := 0;
     616  SetLength(NewProgram, Length(FProgram));
     617
     618  FProgramIndex := 0;
     619  while (FProgramIndex < Length(FProgram)) do begin
     620    case FProgram[FProgramIndex].Command of
     621      cmPointerInc: begin
     622        if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
     623          if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
     624            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
     625              FProgram[FProgramIndex].Parameter
     626          else if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
     627            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
     628              FProgram[FProgramIndex].Parameter;
     629          // If value negative then change command
     630          if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
     631            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
     632            if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
     633              NewProgram[NewProgramIndex - 1].Command := cmPointerDec
     634              else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
     635          end;
     636          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
     637          Dec(NewProgramIndex);
     638        end else begin
     639          NewProgram[NewProgramIndex].Command := cmPointerInc;
     640          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     641        end;
     642      end;
     643      cmPointerDec: begin
     644        if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
     645          if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
     646            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
     647              FProgram[FProgramIndex].Parameter
     648          else if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
     649            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
     650              FProgram[FProgramIndex].Parameter;
     651          // If value negative then change command
     652          if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
     653            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
     654            if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
     655              NewProgram[NewProgramIndex - 1].Command := cmPointerDec
     656              else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
     657          end;
     658          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
     659          Dec(NewProgramIndex);
     660        end else begin
     661          NewProgram[NewProgramIndex].Command := cmPointerDec;
     662          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     663        end;
     664      end;
     665      cmInc: begin
     666        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
     667          if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
     668            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
     669              FProgram[FProgramIndex].Parameter
     670          else if NewProgram[NewProgramIndex - 1].Command = cmDec then
     671            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
     672              FProgram[FProgramIndex].Parameter;
     673          // If value negative then change command
     674          if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
     675            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
     676            if NewProgram[NewProgramIndex - 1].Command = cmInc then
     677              NewProgram[NewProgramIndex - 1].Command := cmDec
     678              else NewProgram[NewProgramIndex - 1].Command := cmInc;
     679          end;
     680          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
     681          Dec(NewProgramIndex);
     682        end else begin
     683          NewProgram[NewProgramIndex].Command := cmInc;
     684          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     685        end;
     686      end;
     687      cmDec: begin
     688        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
     689          if NewProgram[NewProgramIndex - 1].Command = cmDec then
     690            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
     691              FProgram[FProgramIndex].Parameter
     692          else if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
     693            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
     694              FProgram[FProgramIndex].Parameter;
     695          // If value negative then change command
     696          if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
     697            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
     698            if NewProgram[NewProgramIndex - 1].Command = cmInc then
     699              NewProgram[NewProgramIndex - 1].Command := cmDec
     700              else NewProgram[NewProgramIndex - 1].Command := cmInc;
     701          end;
     702          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
     703          Dec(NewProgramIndex);
     704        end else begin
     705          NewProgram[NewProgramIndex].Command := cmDec;
     706          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     707        end;
     708      end;
     709      cmSet: begin
     710        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
     711          // Set overrides value of previous commands
     712          Dec(NewProgramIndex);
     713          NewProgram[NewProgramIndex].Command := cmSet;
     714          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     715        end else begin
     716          NewProgram[NewProgramIndex].Command := cmSet;
     717          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     718        end;
     719      end;
     720      cmLoopStart: begin
     721        if CheckClear then begin
     722          NewProgram[NewProgramIndex].Command := cmSet;
     723          NewProgram[NewProgramIndex].Parameter := 0;
     724          Inc(FProgramIndex, 2);
     725        end else begin
     726          NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     727          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     728        end;
     729      end;
     730      else begin
     731        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
     732        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
     733      end;
     734    end;
     735    PreviousCommand := FProgram[FProgramIndex].Command;
     736    Inc(FProgramIndex);
     737    Inc(NewProgramIndex);
     738  end;
     739  SetLength(NewProgram, NewProgramIndex);
     740
     741  // Replace old program by new program
     742  SetLength(FProgram, Length(NewProgram));
     743  Move(NewProgram[0], FProgram[0], SizeOf(TMachineOperation) * Length(NewProgram));
     744end;
     745
     746procedure TTarget.OptimizeZeroInitMemory;
     747begin
     748  // Here optimization related to assumption that initial memory is filled with zeroes
     749  // Then code for constants preparation can be translated to cmSet commands
     750  // To eliminate also loops for building constants code need to be somehow interpretted partialy
    538751end;
    539752
    … …  
    549762    case FSourceCode[I] of
    550763      '+': begin
    551         FProgram[FProgramIndex] := cmInc;
     764        FProgram[FProgramIndex].Command := cmInc;
     765        FProgram[FProgramIndex].Parameter := 1;
    552766        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    553767      end;
    554768      '-': begin
    555         FProgram[FProgramIndex] := cmDec;
     769        FProgram[FProgramIndex].Command := cmDec;
     770        FProgram[FProgramIndex].Parameter := 1;
    556771        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    557772      end;
    558773      '>': begin
    559         FProgram[FProgramIndex] := cmPointerInc;
     774        FProgram[FProgramIndex].Command := cmPointerInc;
     775        FProgram[FProgramIndex].Parameter := 1;
    560776        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    561777      end;
    562778      '<': begin
    563         FProgram[FProgramIndex] := cmPointerDec;
     779        FProgram[FProgramIndex].Command := cmPointerDec;
     780        FProgram[FProgramIndex].Parameter := 1;
    564781        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    565782      end;
    566783      ',': begin
    567         FProgram[FProgramIndex] := cmInput;
     784        FProgram[FProgramIndex].Command := cmInput;
     785        FProgram[FProgramIndex].Parameter := 0;
    568786        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    569787      end;
    570788      '.': begin
    571         FProgram[FProgramIndex] := cmOutput;
     789        FProgram[FProgramIndex].Command := cmOutput;
     790        FProgram[FProgramIndex].Parameter := 0;
    572791        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    573792      end;
    574793      '[': begin
    575         FProgram[FProgramIndex] := cmLoopStart;
     794        FProgram[FProgramIndex].Command := cmLoopStart;
     795        FProgram[FProgramIndex].Parameter := 0;
    576796        DebugSteps.AddStep(I - 1, FProgramIndex, soStepIn);
    577797      end;
    578798      ']': begin
    579         FProgram[FProgramIndex] := cmLoopEnd;
     799        FProgram[FProgramIndex].Command := cmLoopEnd;
     800        FProgram[FProgramIndex].Parameter := 0;
    580801        DebugSteps.AddStep(I - 1, FProgramIndex, soStepOut);
    581802      end
    … …  
    594815function TTarget.CheckClear: Boolean;
    595816begin
    596   Result := (FProgram[FProgramIndex] = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and
    597     (FProgram[FProgramIndex + 1] = cmDec) and (FProgram[FProgramIndex + 2] = cmLoopEnd);
     817  Result := (FProgram[FProgramIndex].Command = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and
     818    (((FProgram[FProgramIndex + 1].Command = cmDec) and (FProgram[FProgramIndex + 1].Parameter = 1)) or
     819    ((FProgram[FProgramIndex + 1].Command = cmInc) and (FProgram[FProgramIndex + 1].Parameter = -1)))
     820    and (FProgram[FProgramIndex + 2].Command = cmLoopEnd);
    598821end;
    599822
Note: See TracChangeset for help on using the changeset viewer.