Changeset 66


Ignore:
Timestamp:
Jan 17, 2015, 12:23:38 PM (9 years ago)
Author:
chronos
Message:
  • Moved: BrainFuck related code moved from TTarget to specialized TBFTarget.
Location:
trunk
Files:
1 added
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/LazFuckIDE.lpi

    r64 r66  
    9696      </Item6>
    9797    </RequiredPackages>
    98     <Units Count="22">
     98    <Units Count="23">
    9999      <Unit0>
    100100        <Filename Value="LazFuckIDE.lpr"/>
    … …  
    243243        <UnitName Value="UProject"/>
    244244      </Unit21>
     245      <Unit22>
     246        <Filename Value="UBFTarget.pas"/>
     247        <IsPartOfProject Value="True"/>
     248        <UnitName Value="UBFTarget"/>
     249      </Unit22>
    245250    </Units>
    246251  </ProjectOptions>

  • trunk/LazFuckIDE.lpr

    r61 r66  
    1313  UFormOutput, UFormInput, UFormMemory, UFormMessages, UFormSourceCode,
    1414  UFormTargetCode, UFormTargetOptions, UCore, Common, TemplateGenerics,
    15   CoolTranslator, UFormLog, UProject;
     15  CoolTranslator, UFormLog, UProject, UBFTarget;
    1616
    1717{$R *.res}

  • trunk/Target/UTargetC.pas

    r64 r66  
    66
    77uses
    8   Classes, SysUtils, FileUtil, UTarget, Process, Dialogs;
     8  Classes, SysUtils, FileUtil, UTarget, UBFTarget, Process, Dialogs;
    99
    1010type
    … …  
    1212  { TTargetC }
    1313
    14   TTargetC = class(TTarget)
     14  TTargetC = class(TBFTarget)
    1515  private
    1616  public

  • trunk/Target/UTargetDelphi.pas

    r64 r66  
    66
    77uses
    8   Classes, SysUtils, UTarget;
     8  Classes, SysUtils, UTarget, UBFTarget;
    99
    1010type
    … …  
    1212  { TTargetDelphi }
    1313
    14   TTargetDelphi = class(TTarget)
     14  TTargetDelphi = class(TBFTarget)
    1515  private
    1616  public

  • trunk/Target/UTargetFPC.pas

    r64 r66  
    66
    77uses
    8   Classes, SysUtils, UTarget;
     8  Classes, SysUtils, UTarget, UBFTarget;
    99
    1010type
    … …  
    1212  { TTargetFPC }
    1313
    14   TTargetFPC = class(TTarget)
     14  TTargetFPC = class(TBFTarget)
    1515  private
    1616  public

  • trunk/Target/UTargetInterpretter.pas

    r64 r66  
    66
    77uses
    8   Classes, SysUtils, Dialogs, Forms, StrUtils, UTarget, Registry, URegistry;
     8  Classes, SysUtils, Dialogs, Forms, StrUtils, UTarget, Registry, URegistry,
     9  UBFTarget;
    910
    1011type
    … …  
    2728  { TTargetInterpretter }
    2829
    29   TTargetInterpretter = class(TTarget)
     30  TTargetInterpretter = class(TBFTarget)
    3031  private
    3132    FCellSize: Integer;

  • trunk/Target/UTargetJava.pas

    r64 r66  
    66
    77uses
    8   Classes, SysUtils, FileUtil, UTarget, Process, Dialogs;
     8  Classes, SysUtils, FileUtil, UTarget, UBFTarget, Process, Dialogs;
    99
    1010type
    … …  
    1212  { TTargetJava }
    1313
    14   TTargetJava = class(TTarget)
     14  TTargetJava = class(TBFTarget)
    1515  private
    1616  public

  • trunk/Target/UTargetPHP.pas

    r64 r66  
    66
    77uses
    8   Classes, SysUtils, UTarget;
     8  Classes, SysUtils, UTarget, UBFTarget;
    99
    1010type
    … …  
    1212  { TTargetPHP }
    1313
    14   TTargetPHP = class(TTarget)
     14  TTargetPHP = class(TBFTarget)
    1515  private
    1616  public

  • trunk/UTarget.pas

    r65 r66  
    6767  end;
    6868
    69   TMachineCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
    70     cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug, cmSet);
    71 
    72   TMachineOperation = record
    73     Command: TMachineCommand;
    74     Parameter: Integer;
    75   end;
    76 
    7769  TLogEvent = procedure (Lines: TStrings) of object;
    7870
    … …  
    8577    FCompiled: Boolean;
    8678    function SourceReadNext: Char;
    87     function CheckClear: Boolean;
    88     function CheckOccurenceSumParam(C: TMachineCommand): Integer;
    89     function CheckOccurence(C: TMachineCommand): Integer;
    90     procedure OptimizeAddSub;
    91     procedure OptimizeMerge;
    92     procedure OptimizeZeroInitMemory;
    9379  protected
    9480    FSourceCode: string;
    95     FProgram: array of TMachineOperation;
    96     FProgramIndex: Integer;
    9781    FTargetCode: string;
    9882    FTargetIndex: Integer;
    … …  
    10084    FState: TRunState;
    10185    FOnChangeState: TNotifyEvent;
    102     procedure LoadProgram;
     86    procedure LoadProgram; virtual;
    10387    procedure SetSourceCode(AValue: string); virtual;
    10488    function GetTargetCode: string; virtual;
    … …  
    143127    property Compiled: Boolean read FCompiled write FCompiled;
    144128    property ExecutionPosition: Integer read GetExecutionPosition;
    145     property ProgramIndex: Integer read FProgramIndex;
    146129    property OnChangeState: TNotifyEvent read FOnChangeState write FOnChangeState;
    147130    property OnLog: TLogEvent read FOnLog write FOnLog;
     131  end;
     132
     133  TBFTarget = class
     134
    148135  end;
    149136
    … …  
    409396
    410397procedure TTarget.OptimizeSource;
    411 var
    412   OldLength: Integer;
    413 begin
    414   OptimizeAddSub;
    415   repeat
    416     OldLength := Length(FProgram);
    417     OptimizeMerge;
    418   until Length(FProgram) = OldLength;
    419   OptimizeZeroInitMemory;
     398begin
    420399end;
    421400
    … …  
    557536end;
    558537
    559 function TTarget.CheckOccurence(C: TMachineCommand): Integer;
    560 begin
    561   Result := 1;
    562   while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
    563     Inc(Result);
    564     Inc(FProgramIndex);
    565   end;
    566 end;
    567 
    568 function TTarget.CheckOccurenceSumParam(C: TMachineCommand): Integer;
    569 begin
    570   Result := FProgram[FProgramIndex].Parameter;
    571   while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
    572     Inc(Result, FProgram[FProgramIndex + 1].Parameter);
    573     Inc(FProgramIndex);
    574   end;
    575 end;
    576 
    577 procedure TTarget.OptimizeAddSub;
    578 var
    579   NewProgram: array of TMachineOperation;
    580   NewProgramIndex: Integer;
    581 begin
    582   NewProgramIndex := 0;
    583   SetLength(NewProgram, Length(FProgram));
    584 
    585   FProgramIndex := 0;
    586   while (FProgramIndex < Length(FProgram)) do begin
    587     case FProgram[FProgramIndex].Command of
    588       cmPointerInc: begin
    589         NewProgram[NewProgramIndex].Command := cmPointerInc;
    590         NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerInc);
    591       end;
    592       cmPointerDec: begin
    593         NewProgram[NewProgramIndex].Command := cmPointerDec;
    594         NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerDec);
    595       end;
    596       cmInc: begin
    597         NewProgram[NewProgramIndex].Command := cmInc;
    598         NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmInc);
    599       end;
    600       cmDec: begin
    601         NewProgram[NewProgramIndex].Command := cmDec;
    602         NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmDec);
    603       end;
    604       else begin
    605         NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
    606         NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    607       end;
    608     end;
    609     DebugSteps.UpdateTargetPos(FProgramIndex, NewProgramIndex);
    610     Inc(FProgramIndex);
    611     Inc(NewProgramIndex);
    612   end;
    613   SetLength(NewProgram, NewProgramIndex);
    614 
    615   // Replace old program by new program
    616   SetLength(FProgram, Length(NewProgram));
    617   Move(NewProgram[0], FProgram[0], SizeOf(TMachineOperation) * Length(NewProgram));
    618 end;
    619 
    620 procedure TTarget.OptimizeMerge;
    621 var
    622   NewProgram: array of TMachineOperation;
    623   NewProgramIndex: Integer;
    624   PreviousCommand: TMachineCommand;
    625 begin
    626   // Merge together cmInc, cmDec, cmSet
    627   // Merge together cmPointerInc, cmPointerDec
    628   PreviousCommand := cmNoOperation;
    629   NewProgramIndex := 0;
    630   SetLength(NewProgram, Length(FProgram));
    631 
    632   FProgramIndex := 0;
    633   while (FProgramIndex < Length(FProgram)) do begin
    634     case FProgram[FProgramIndex].Command of
    635       cmPointerInc: begin
    636         if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
    637           if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
    638             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
    639               FProgram[FProgramIndex].Parameter
    640           else if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
    641             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
    642               FProgram[FProgramIndex].Parameter;
    643           // If value negative then change command
    644           if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
    645             NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
    646             if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
    647               NewProgram[NewProgramIndex - 1].Command := cmPointerDec
    648               else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
    649           end;
    650           if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
    651           Dec(NewProgramIndex);
    652         end else begin
    653           NewProgram[NewProgramIndex].Command := cmPointerInc;
    654           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    655         end;
    656       end;
    657       cmPointerDec: begin
    658         if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
    659           if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
    660             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
    661               FProgram[FProgramIndex].Parameter
    662           else if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
    663             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
    664               FProgram[FProgramIndex].Parameter;
    665           // If value negative then change command
    666           if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
    667             NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
    668             if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
    669               NewProgram[NewProgramIndex - 1].Command := cmPointerDec
    670               else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
    671           end;
    672           if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
    673           Dec(NewProgramIndex);
    674         end else begin
    675           NewProgram[NewProgramIndex].Command := cmPointerDec;
    676           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    677         end;
    678       end;
    679       cmInc: begin
    680         if PreviousCommand in [cmInc, cmDec, cmSet] then begin
    681           if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
    682             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
    683               FProgram[FProgramIndex].Parameter
    684           else if NewProgram[NewProgramIndex - 1].Command = cmDec then
    685             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
    686               FProgram[FProgramIndex].Parameter;
    687           // If value negative then change command
    688           if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
    689             NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
    690             if NewProgram[NewProgramIndex - 1].Command = cmInc then
    691               NewProgram[NewProgramIndex - 1].Command := cmDec
    692               else NewProgram[NewProgramIndex - 1].Command := cmInc;
    693           end;
    694           if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
    695           Dec(NewProgramIndex);
    696         end else begin
    697           NewProgram[NewProgramIndex].Command := cmInc;
    698           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    699         end;
    700       end;
    701       cmDec: begin
    702         if PreviousCommand in [cmInc, cmDec, cmSet] then begin
    703           if NewProgram[NewProgramIndex - 1].Command = cmDec then
    704             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
    705               FProgram[FProgramIndex].Parameter
    706           else if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
    707             NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
    708               FProgram[FProgramIndex].Parameter;
    709           // If value negative then change command
    710           if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
    711             NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
    712             if NewProgram[NewProgramIndex - 1].Command = cmInc then
    713               NewProgram[NewProgramIndex - 1].Command := cmDec
    714               else NewProgram[NewProgramIndex - 1].Command := cmInc;
    715           end;
    716           if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
    717           Dec(NewProgramIndex);
    718         end else begin
    719           NewProgram[NewProgramIndex].Command := cmDec;
    720           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    721         end;
    722       end;
    723       cmSet: begin
    724         if PreviousCommand in [cmInc, cmDec, cmSet] then begin
    725           // Set overrides value of previous commands
    726           Dec(NewProgramIndex);
    727           NewProgram[NewProgramIndex].Command := cmSet;
    728           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    729         end else begin
    730           NewProgram[NewProgramIndex].Command := cmSet;
    731           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    732         end;
    733       end;
    734       cmLoopStart: begin
    735         if CheckClear then begin
    736           NewProgram[NewProgramIndex].Command := cmSet;
    737           NewProgram[NewProgramIndex].Parameter := 0;
    738           Inc(FProgramIndex, 2);
    739         end else begin
    740           NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
    741           NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    742         end;
    743       end;
    744       else begin
    745         NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
    746         NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
    747       end;
    748     end;
    749     PreviousCommand := FProgram[FProgramIndex].Command;
    750     DebugSteps.UpdateTargetPos(FProgramIndex, NewProgramIndex);
    751     Inc(FProgramIndex);
    752     Inc(NewProgramIndex);
    753   end;
    754   SetLength(NewProgram, NewProgramIndex);
    755 
    756   // Replace old program by new program
    757   SetLength(FProgram, Length(NewProgram));
    758   Move(NewProgram[0], FProgram[0], SizeOf(TMachineOperation) * Length(NewProgram));
    759 end;
    760 
    761 procedure TTarget.OptimizeZeroInitMemory;
    762 begin
    763   // Here optimization related to assumption that initial memory is filled with zeroes
    764   // Then code for constants preparation can be translated to cmSet commands
    765   // To eliminate also loops for building constants code need to be somehow interpretted partialy
    766 end;
    767 
    768538procedure TTarget.LoadProgram;
    769 var
    770   I: Integer;
    771 begin
    772   inherited;
    773   DebugSteps.Clear;
    774   SetLength(FProgram, Length(FSourceCode));
    775   FProgramIndex := 0;
    776   for I := 1 to Length(FSourceCode) do begin
    777     case FSourceCode[I] of
    778       '+': begin
    779         FProgram[FProgramIndex].Command := cmInc;
    780         FProgram[FProgramIndex].Parameter := 1;
    781         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    782       end;
    783       '-': begin
    784         FProgram[FProgramIndex].Command := cmDec;
    785         FProgram[FProgramIndex].Parameter := 1;
    786         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    787       end;
    788       '>': begin
    789         FProgram[FProgramIndex].Command := cmPointerInc;
    790         FProgram[FProgramIndex].Parameter := 1;
    791         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    792       end;
    793       '<': begin
    794         FProgram[FProgramIndex].Command := cmPointerDec;
    795         FProgram[FProgramIndex].Parameter := 1;
    796         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    797       end;
    798       ',': begin
    799         FProgram[FProgramIndex].Command := cmInput;
    800         FProgram[FProgramIndex].Parameter := 0;
    801         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    802       end;
    803       '.': begin
    804         FProgram[FProgramIndex].Command := cmOutput;
    805         FProgram[FProgramIndex].Parameter := 0;
    806         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
    807       end;
    808       '[': begin
    809         FProgram[FProgramIndex].Command := cmLoopStart;
    810         FProgram[FProgramIndex].Parameter := 0;
    811         DebugSteps.AddStep(I - 1, FProgramIndex, soStepIn);
    812       end;
    813       ']': begin
    814         FProgram[FProgramIndex].Command := cmLoopEnd;
    815         FProgram[FProgramIndex].Parameter := 0;
    816         DebugSteps.AddStep(I - 1, FProgramIndex, soStepOut);
    817       end
    818       else Dec(FProgramIndex);
    819     end;
    820     Inc(FProgramIndex);
    821   end;
    822   SetLength(FProgram, FProgramIndex);
     539begin
    823540end;
    824541
    … …  
    828545end;
    829546
    830 function TTarget.CheckClear: Boolean;
    831 begin
    832   Result := (FProgram[FProgramIndex].Command = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and
    833     (((FProgram[FProgramIndex + 1].Command = cmDec) and (FProgram[FProgramIndex + 1].Parameter = 1)) or
    834     ((FProgram[FProgramIndex + 1].Command = cmInc) and (FProgram[FProgramIndex + 1].Parameter = -1)))
    835     and (FProgram[FProgramIndex + 2].Command = cmLoopEnd);
    836 end;
    837 
    838547end.
    839548
Note: See TracChangeset for help on using the changeset viewer.