Changeset 52 for trunk/Target


Ignore:
Timestamp:
Jul 26, 2012, 3:11:08 PM (12 years ago)
Author:
chronos
Message:
  • Modified: Optimization functions moved to shared place in TTarget.
  • Modified: Text source is loaded to program source array of brainfuck commands for better processing.
Location:
trunk/Target
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/Target/UTarget.pas

    r50 r52  
    6666  end;
    6767
     68  TBrainFuckCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
     69    cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug);
     70
    6871  { TTarget }
    6972
    7073  TTarget = class
    71   private
     74  protected
    7275    FCompiled: Boolean;
     76    function SourceReadNext: Char;
     77    function IsOpcode(Opcode: Char): Boolean;
     78    function CheckClear: Boolean;
     79    function CheckOccurence(C: TBrainFuckCommand): Integer;
    7380  protected
    7481    FSourceCode: string;
     82    FProgram: array of TBrainFuckCommand;
     83    FProgramIndex: Integer;
    7584    FTargetCode: string;
     85    FTargetIndex: Integer;
    7686    Indent: Integer;
    7787    FState: TRunState;
    7888    FOnChangeState: TNotifyEvent;
     89    procedure LoadProgram;
    7990    procedure SetSourceCode(AValue: string); virtual;
    8091    function GetTargetCode: string; virtual;
    … …  
    119130    property Compiled: Boolean read FCompiled write FCompiled;
    120131    property ExecutionPosition: Integer read GetExecutionPosition;
     132    property ProgramIndex: Integer read FProgramIndex;
    121133  end;
    122134
    … …  
    377389procedure TTarget.Compile;
    378390begin
     391  LoadProgram;
    379392  Compiled := True;
    380393end;
    … …  
    489502end;
    490503
     504function TTarget.CheckOccurence(C: TBrainFuckCommand): Integer;
     505begin
     506  Result := 1;
     507  if Optimization = coNormal then
     508  while ((FProgramIndex + 1) <= Length(FProgram)) and (FProgram[FProgramIndex + 1] = C) do begin
     509    Inc(Result);
     510    Inc(FProgramIndex);
     511  end;
     512end;
     513
     514procedure TTarget.LoadProgram;
     515var
     516  I: Integer;
     517begin
     518  inherited;
     519  DebugSteps.Clear;
     520  SetLength(FProgram, Length(FSourceCode));
     521  FProgramIndex := 0;
     522  for I := 1 to Length(FSourceCode) do begin
     523    case FSourceCode[I] of
     524      '+': begin
     525        FProgram[FProgramIndex] := cmInc;
     526        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
     527      end;
     528      '-': begin
     529        FProgram[FProgramIndex] := cmDec;
     530        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
     531      end;
     532      '>': begin
     533        FProgram[FProgramIndex] := cmPointerInc;
     534        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
     535      end;
     536      '<': begin
     537        FProgram[FProgramIndex] := cmPointerDec;
     538        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
     539      end;
     540      ',': begin
     541        FProgram[FProgramIndex] := cmInput;
     542        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
     543      end;
     544      '.': begin
     545        FProgram[FProgramIndex] := cmOutput;
     546        DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
     547      end;
     548      '[': begin
     549        FProgram[FProgramIndex] := cmLoopStart;
     550        DebugSteps.AddStep(I - 1, FProgramIndex, soStepIn);
     551      end;
     552      ']': begin
     553        FProgram[FProgramIndex] := cmLoopEnd;
     554        DebugSteps.AddStep(I - 1, FProgramIndex, soStepOut);
     555      end
     556      else Dec(FProgramIndex);
     557    end;
     558    Inc(FProgramIndex);
     559  end;
     560  SetLength(FProgram, FProgramIndex);
     561end;
     562
     563function TTarget.SourceReadNext: Char;
     564begin
     565//  while FProgramIndex;
     566end;
     567
     568function TTarget.IsOpcode(Opcode: Char): Boolean;
     569begin
     570  Result := (Opcode = '+') or (Opcode = '-') or (Opcode = '<') or (Opcode = '>') or
     571    (Opcode = '[') or (Opcode = ']') or (Opcode = ',') or (Opcode = '.');
     572end;
     573
     574function TTarget.CheckClear: Boolean;
     575begin
     576  Result := (FProgram[FProgramIndex] = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and
     577    (FProgram[FProgramIndex + 1] = cmDec) and (FProgram[FProgramIndex + 2] = cmLoopEnd);
     578end;
     579
    491580end.
    492581

  • trunk/Target/UTargetC.pas

    r48 r52  
    3535  Capabilities := [tcCompile, tcRun];
    3636  {$IFDEF Windows}
    37   CompilerPath := 'c:\Program Files\MinGW\bin\gcc.exe -o %1:s';
     37  CompilerPath := 'c:\Program Files\MinGW\bin\gcc.exe';
    3838  {$ENDIF}
    3939  {$IFDEF Linux}
    … …  
    4444procedure TTargetC.Compile;
    4545var
    46   I: Integer;
    4746  Sum: Integer;
    48 
    49 function CheckOccurence(C: Char): Integer;
    50 begin
    51   Result := 1;
    52   if Optimization = coNormal then
    53   while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin
    54     Inc(Result);
    55     Inc(I)
    56   end;
    57 end;
    58 
    5947begin
    6048  inherited;
    … …  
    7260  AddLine('');
    7361  AddLine('Pos = 0;');
    74   I := 1;
    75   while (I <= Length(FSourceCode)) do begin
    76     case FSourceCode[I] of
    77       '>': begin
    78         Sum := CheckOccurence('>');
     62  FProgramIndex := 0;
     63  while (FProgramIndex < Length(FProgram)) do begin
     64    case FProgram[FProgramIndex] of
     65      cmPointerInc: begin
     66        Sum := CheckOccurence(cmPointerInc);
    7967        AddLine('Pos = Pos + ' + IntToStr(Sum) + ';');
    8068      end;
    81       '<': begin
    82         Sum := CheckOccurence('<');
     69      cmPointerDec: begin
     70        Sum := CheckOccurence(cmPointerDec);
    8371        AddLine('Pos = Pos - ' + IntToStr(Sum) + ';');
    8472      end;
    85       '+': begin
    86         Sum := CheckOccurence('+');
     73      cmInc: begin
     74        Sum := CheckOccurence(cmInc);
    8775        AddLine('Memory[Pos] = Memory[Pos] + ' + IntToStr(Sum) + ';');
    8876      end;
    89       '-': begin
    90         Sum := CheckOccurence('-');
     77      cmDec: begin
     78        Sum := CheckOccurence(cmDec);
    9179        AddLine('Memory[Pos] = Memory[Pos] - ' + IntToStr(Sum) + ';');
    9280      end;
    93       '.': AddLine('putchar(Memory[Pos]);');
    94       ',': AddLine('Memory[Pos] = getchar();');
    95       '[': begin
    96         AddLine('while(Memory[Pos] != 0)');
    97         AddLine('{');
    98         Inc(Indent);
     81      cmOutput: AddLine('putchar(Memory[Pos]);');
     82      cmInput: AddLine('Memory[Pos] = getchar();');
     83      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)');
     89          AddLine('{');
     90          Inc(Indent);
     91        end;
    9992      end;
    100       ']': begin
     93      cmLoopEnd: begin
    10194        Dec(Indent);
    10295        AddLine('}');
    10396      end;
    10497    end;
    105     Inc(I);
     98    Inc(FProgramIndex);
    10699  end;
    107100  AddLine('return 0;');

  • trunk/Target/UTargetDelphi.pas

    r48 r52  
    3939procedure TTargetDelphi.Compile;
    4040var
    41   I: Integer;
    4241  Sum: Integer;
    43 
    44 function CheckOccurence(C: Char): Integer;
    45 begin
    46   Result := 1;
    47   if Optimization = coNormal then
    48   while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin
    49     Inc(Result);
    50     Inc(I)
    51   end;
    52 end;
    53 
    54 function CheckClear: Boolean;
    55 begin
    56   Result := (FSourceCode[I] = '[') and (Length(FSourceCode) >= I + 2) and
    57     (FSourceCode[I + 1] = '-') and (FSourceCode[I + 2] = ']');
    58 end;
    59 
    6042begin
    6143  inherited;
    … …  
    7456  Inc(Indent);
    7557  AddLine('Pos := 0;');
    76   I := 1;
    77   while (I <= Length(FSourceCode)) do begin
    78     case FSourceCode[I] of
    79       '>': begin
    80         Sum := CheckOccurence('>');
     58  FProgramIndex := 0;
     59  while (FProgramIndex < Length(FProgram)) do begin
     60    case FProgram[FProgramIndex] of
     61      cmPointerInc: begin
     62        Sum := CheckOccurence(cmPointerInc);
    8163        AddLine('Inc(Pos, ' + IntToStr(Sum) + ');');
    8264      end;
    83       '<': begin
    84         Sum := CheckOccurence('<');
     65      cmPointerDec: begin
     66        Sum := CheckOccurence(cmPointerDec);
    8567        AddLine('Dec(Pos, ' + IntToStr(Sum) + ');');
    8668      end;
    87       '+': begin
    88         Sum := CheckOccurence('+');
     69      cmInc: begin
     70        Sum := CheckOccurence(cmInc);
    8971        AddLine('Memory[Pos] := Memory[Pos] + ' + IntToStr(Sum) + ';');
    9072      end;
    91       '-': begin
    92         Sum := CheckOccurence('-');
     73      cmDec: begin
     74        Sum := CheckOccurence(cmDec);
    9375        AddLine('Memory[Pos] := Memory[Pos] - ' + IntToStr(Sum) + ';');
    9476      end;
    95       '.': AddLine('Write(Chr(Memory[Pos]));');
    96       ',': AddLine('Read(ReadChar); Memory[Pos] := Ord(ReadChar);');
    97       '[': begin
     77      cmOutput: AddLine('Write(Chr(Memory[Pos]));');
     78      cmInput: AddLine('Read(ReadChar); Memory[Pos] := Ord(ReadChar);');
     79      cmLoopStart: begin
    9880        if CheckClear then begin
    9981          AddLine('Memory[Pos] := 0;');
    100           Inc(I, 2);
     82          Inc(FProgramIndex, 2);
    10183        end else begin
    10284          AddLine('while Memory[Pos] <> 0 do begin');
    … …  
    10486        end;
    10587      end;
    106       ']': begin
     88      cmLoopEnd: begin
    10789        Dec(Indent);
    10890        AddLine('end;');
    10991      end;
    11092    end;
    111     Inc(I);
     93    Inc(FProgramIndex);
    11294  end;
    11395  Dec(Indent);

  • trunk/Target/UTargetInterpretter.pas

    r48 r52  
    2222    procedure Execute; override;
    2323  end;
    24 
    25   TBrainFuckCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
    26     cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug);
    2724
    2825  TCommandHandler = procedure of object;
    … …  
    5552    function GetExecutionPosition: Integer; override;
    5653  public
    57     FProgram: array of TBrainFuckCommand;
    5854    FProgramBreakpoints: array of Boolean;
    5955    SourceJump: array of Integer;
    60     SourcePosition: Integer;
    6156    SourceBreakpoint: array of Boolean;
    6257    Memory: array of Integer;
    … …  
    109104  with Parent do
    110105  repeat
    111     while (SourcePosition < Length(FProgram)) and (State <> rsStopped) do begin
     106    while (FProgramIndex < Length(FProgram)) and (State <> rsStopped) do begin
    112107      if State = rsRunning then begin
    113         if FProgramBreakpoints[SourcePosition] then begin
    114           BreakPoint := BreakPoints.SearchByTargetPos(SourcePosition);
     108        if FProgramBreakpoints[FProgramIndex] then begin
     109          BreakPoint := BreakPoints.SearchByTargetPos(FProgramIndex);
    115110          if BreakPoint.System then BreakPoints.Delete(BreakPoints.IndexOf(BreakPoint));
    116111          SetStateSafe(rsPaused);
    117112        end else begin
    118           FCommandTable[FProgram[SourcePosition]];
    119           Inc(SourcePosition);
     113          FCommandTable[FProgram[FProgramIndex]];
     114          Inc(FProgramIndex);
    120115          Inc(FStepCount);
    121116        end;
    … …  
    155150begin
    156151  SetLength(Memory, AValue);
    157 end;
    158 
    159 procedure TTargetInterpretter.Compile;
    160 var
    161   I: Integer;
    162   Pos: Integer;
    163 begin
    164   inherited;
    165   DebugSteps.Clear;
    166   SetLength(FProgram, Length(FSourceCode));
    167   Pos := 0;
    168   for I := 1 to Length(FSourceCode) do begin
    169     case FSourceCode[I] of
    170       '+': begin
    171         FProgram[Pos] := cmInc;
    172         DebugSteps.AddStep(I - 1, Pos, soNormal);
    173       end;
    174       '-': begin
    175         FProgram[Pos] := cmDec;
    176         DebugSteps.AddStep(I - 1, Pos, soNormal);
    177       end;
    178       '>': begin
    179         FProgram[Pos] := cmPointerInc;
    180         DebugSteps.AddStep(I - 1, Pos, soNormal);
    181       end;
    182       '<': begin
    183         FProgram[Pos] := cmPointerDec;
    184         DebugSteps.AddStep(I - 1, Pos, soNormal);
    185       end;
    186       ',': begin
    187         FProgram[Pos] := cmInput;
    188         DebugSteps.AddStep(I - 1, Pos, soNormal);
    189       end;
    190       '.': begin
    191         FProgram[Pos] := cmOutput;
    192         DebugSteps.AddStep(I - 1, Pos, soNormal);
    193       end;
    194       '[': begin
    195         FProgram[Pos] := cmLoopStart;
    196         DebugSteps.AddStep(I - 1, Pos, soStepIn);
    197       end;
    198       ']': begin
    199         FProgram[Pos] := cmLoopEnd;
    200         DebugSteps.AddStep(I - 1, Pos, soStepOut);
    201       end
    202       else Dec(Pos);
    203     end;
    204     Inc(Pos);
    205   end;
    206   SetLength(FProgram, Pos);
    207152end;
    208153
    … …  
    293238begin
    294239  if Memory[MemoryPosition] = 0 then
    295     SourcePosition := SourceJump[SourcePosition];
     240    FProgramIndex := SourceJump[FProgramIndex];
    296241end;
    297242
    … …  
    299244begin
    300245  if Memory[MemoryPosition] > 0 then
    301     SourcePosition := SourceJump[SourcePosition] - 1;
     246    FProgramIndex := SourceJump[FProgramIndex] - 1;
    302247end;
    303248
    … …  
    308253  inherited;
    309254  PrepareJumpTable;
    310   SourcePosition := 0;
     255  FProgramIndex := 0;
    311256  InputPosition := 1;
    312257  Output := '';
    … …  
    320265end;
    321266
     267procedure TTargetInterpretter.Compile;
     268begin
     269  inherited;
     270end;
     271
    322272procedure TTargetInterpretter.PrepareBreakPoints;
    323273var
    … …  
    343293function TTargetInterpretter.GetExecutionPosition: Integer;
    344294begin
    345   Result := SourcePosition;
     295  Result := FProgramIndex;
    346296end;
    347297
    … …  
    379329begin
    380330  if State = rsPaused then begin
    381     Step := DebugSteps.SearchByTargetPos(SourcePosition);
     331    Step := DebugSteps.SearchByTargetPos(FProgramIndex);
    382332    if Step.Operation = soStepOut then begin
    383333      BreakPoints.SetSystem(Step.TargetPosition + 1);
    … …  
    401351begin
    402352  if State = rsPaused then begin
    403     Step := DebugSteps.SearchByTargetPos(SourcePosition);
     353    Step := DebugSteps.SearchByTargetPos(FProgramIndex);
    404354    if Step.Operation = soStepOut then begin
    405355      BreakPoints.SetSystem(Step.TargetPosition + 1);
    … …  
    422372begin
    423373  if State = rsPaused then begin
    424     Step := DebugSteps.SearchByTargetPos(SourcePosition);
     374    Step := DebugSteps.SearchByTargetPos(FProgramIndex);
    425375    StepIndex := DebugSteps.IndexOf(Step);
    426376    Nesting := 1;

  • trunk/Target/UTargetJava.pas

    r48 r52  
    4545procedure TTargetJava.Compile;
    4646var
    47   I: Integer;
    4847  Sum: Integer;
    49 
    50 function CheckOccurence(C: Char): Integer;
    51 begin
    52   Result := 1;
    53   if Optimization = coNormal then
    54   while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin
    55     Inc(Result);
    56     Inc(I)
    57   end;
    58 end;
    59 
    6048begin
    6149  inherited;
    … …  
    7563  AddLine('Memory = new char[30000];');
    7664  AddLine('Pos = 0;');
    77   I := 1;
    78   while (I <= Length(FSourceCode)) do begin
    79     case FSourceCode[I] of
    80       '>': begin
    81         Sum := CheckOccurence('>');
     65  FProgramIndex := 0;
     66  while (FProgramIndex < Length(FProgram)) do begin
     67    case FProgram[FProgramIndex] of
     68      cmPointerInc: begin
     69        Sum := CheckOccurence(cmPointerInc);
    8270        AddLine('Pos = Pos + ' + IntToStr(Sum) + ';');
    8371      end;
    84       '<': begin
    85         Sum := CheckOccurence('<');
     72      cmPointerDec: begin
     73        Sum := CheckOccurence(cmPointerDec);
    8674        AddLine('Pos = Pos - ' + IntToStr(Sum) + ';');
    8775      end;
    88       '+': begin
    89         Sum := CheckOccurence('+');
     76      cmInc: begin
     77        Sum := CheckOccurence(cmInc);
    9078        AddLine('Memory[Pos] = (char)((int)Memory[Pos] + ' + IntToStr(Sum) + ');');
    9179      end;
    92       '-': begin
    93         Sum := CheckOccurence('-');
     80      cmDec: begin
     81        Sum := CheckOccurence(cmDec);
    9482        AddLine('Memory[Pos] = (char)((int)Memory[Pos] - ' + IntToStr(Sum) + ');');
    9583      end;
    96       '.': AddLine('System.out.print(Memory[Pos]);');
    97       ',': AddLine('Memory[Pos] = (char)System.in.read();');
    98       '[': begin
    99         AddLine('while(Memory[Pos] != 0)');
    100         AddLine('{');
    101         Inc(Indent);
     84      cmOutput: AddLine('System.out.print(Memory[Pos]);');
     85      cmInput: AddLine('Memory[Pos] = (char)System.in.read();');
     86      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;
    10295      end;
    103       ']': begin
     96      cmLoopEnd: begin
    10497        Dec(Indent);
    10598        AddLine('}');
    10699      end;
    107100    end;
    108     Inc(I);
     101    Inc(FProgramIndex);
    109102  end;
    110103  Dec(Indent);

  • trunk/Target/UTargetPHP.pas

    r49 r52  
    4444procedure TTargetPHP.Compile;
    4545var
    46   I: Integer;
    4746  Sum: Integer;
    48 
    49 function CheckOccurence(C: Char): Integer;
    50 begin
    51   Result := 1;
    52   if Optimization = coNormal then
    53   while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin
    54     Inc(Result);
    55     Inc(I)
    56   end;
    57 end;
    58 
    59 function CheckClear: Boolean;
    60 begin
    61   Result := (FSourceCode[I] = '[') and (Length(FSourceCode) >= I + 2) and
    62     (FSourceCode[I + 1] = '-') and (FSourceCode[I + 2] = ']');
    63 end;
    64 
    6547begin
    6648  inherited;
    … …  
    7254  AddLine('$Memory = str_repeat("\0", 30000);');
    7355  AddLine('$Position = 0;');
    74   I := 1;
    75   while (I <= Length(FSourceCode)) do begin
    76     case FSourceCode[I] of
    77       '>': begin
    78         Sum := CheckOccurence('>');
     56  FProgramIndex := 0;
     57  while (FProgramIndex < Length(FProgram)) do begin
     58    case FProgram[FProgramIndex] of
     59      cmPointerInc: begin
     60        Sum := CheckOccurence(cmPointerInc);
    7961        AddLine('$Position = $Position + ' + IntToStr(Sum) + ';');
    8062      end;
    81       '<': begin
    82         Sum := CheckOccurence('<');
     63      cmPointerDec: begin
     64        Sum := CheckOccurence(cmPointerDec);
    8365        AddLine('$Position = $Position - ' + IntToStr(Sum) + ';');
    8466      end;
    85       '+': begin
    86         Sum := CheckOccurence('+');
     67      cmInc: begin
     68        Sum := CheckOccurence(cmInc);
    8769        AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) + ' + IntToStr(Sum) + ');');
    8870      end;
    89       '-': begin
    90         Sum := CheckOccurence('-');
     71      cmDec: begin
     72        Sum := CheckOccurence(cmDec);
    9173        AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) - ' + IntToStr(Sum) + ');');
    9274      end;
    93       '.': AddLine('echo($Memory[$Position]);');
    94       ',': AddLine('$Memory[$Position] = fgetc(STDIN);');
    95       '[': begin
     75      cmOutput: AddLine('echo($Memory[$Position]);');
     76      cmInput: AddLine('$Memory[$Position] = fgetc(STDIN);');
     77      cmLoopStart: begin
    9678        if CheckClear then begin
    9779          AddLine('$Memory[$Position] = "\0";');
    98           Inc(I, 2);
     80          Inc(FProgramIndex, 2);
    9981        end else begin
    10082          AddLine('while($Memory[$Position] != "\0") {');
    … …  
    10284        end;
    10385      end;
    104       ']': begin
     86      cmLoopEnd: begin
    10587        Dec(Indent);
    10688        AddLine('}');
    10789      end;
    10890    end;
    109     Inc(I);
     91    Inc(FProgramIndex);
    11092  end;
    11193  AddLine('');
Note: See TracChangeset for help on using the changeset viewer.