Changeset 33 for trunk/Target


Ignore:
Timestamp:
Feb 18, 2012, 11:08:44 PM (12 years ago)
Author:
chronos
Message:
  • Modified: CompiledForm replaced by compiled source tab in PageControl on MainForm.
  • Added: Function for switching position between source code and target code.
Location:
trunk/Target
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/Target/UTarget.pas

    r32 r33  
    1818  TRunState = (rsStopped, rsPaused, rsRunning);
    1919
     20  TStepOperation = (soNormal, soStepIn, soStepOut);
     21
     22  TDebugStep = class
     23    SourcePosition: Integer;
     24    TargetPosition: Integer;
     25    Operation: TStepOperation;
     26  end;
     27
     28  { TDebugStepList }
     29
     30  TDebugStepList = class(TListObject)
     31    function SearchBySourcePos(Pos: Integer): TDebugStep;
     32    function SearchByTargetPos(Pos: Integer): TDebugStep;
     33    procedure AddStep(SourcePos, TargetPos: Integer; Operation: TStepOperation);
     34  end;
     35
    2036  { TTarget }
    2137
    2238  TTarget = class
    2339  private
     40    FCompiled: Boolean;
    2441  protected
    25     FSource: string;
     42    FSourceCode: string;
     43    FTargetCode: string;
    2644    Indent: Integer;
    2745    FState: TRunState;
    2846    FOnChangeState: TNotifyEvent;
    29     procedure SetSource(AValue: string); virtual;
     47    procedure SetSourceCode(AValue: string); virtual;
     48    function GetTargetCode: string; virtual;
    3049    procedure AddLine(Text: string);
    3150    function LongFileName(FileName: string): string;
    … …  
    3352    Name: string;
    3453    ProgramName: string;
    35     Output: string;
    3654    Optimization: TCompilerOptimization;
    3755    CompilerPath: string;
    … …  
    4058    ProjectFileName: string;
    4159    Capabilities: TTargetCapabilities;
     60    BreakPointers: TListInteger;
     61    DebugSteps: TDebugStepList;
    4262    constructor Create; virtual;
     63    destructor Destroy; override;
    4364    procedure OptimizeSource;
    4465    procedure Compile; virtual;
    … …  
    5576    property State: TRunState read FState;
    5677    property OnChangeState: TNotifyEvent read FOnChangeState write FOnChangeState;
    57     property Source: string write SetSource;
     78    property SourceCode: string write SetSourceCode;
     79    property TargetCode: string read GetTargetCode;
     80    property Compiled: Boolean read FCompiled write FCompiled;
    5881  end;
    5982
    … …  
    7396
    7497implementation
     98
     99{ TDebugStepList }
     100
     101function TDebugStepList.SearchBySourcePos(Pos: Integer
     102  ): TDebugStep;
     103var
     104  I: Integer;
     105begin
     106  I := 0;
     107  while (I < Count) and (TDebugStep(Items[I]).SourcePosition < Pos) do Inc(I);
     108  if I < Count then Result := TDebugStep(Items[I])
     109    else Result := nil;
     110end;
     111
     112function TDebugStepList.SearchByTargetPos(Pos: Integer
     113  ): TDebugStep;
     114var
     115  I: Integer;
     116begin
     117  I := 0;
     118  while (I < Count) and (TDebugStep(Items[I]).TargetPosition < Pos) do Inc(I);
     119  if I < Count then Result := TDebugStep(Items[I])
     120    else Result := nil;
     121end;
     122
     123procedure TDebugStepList.AddStep(SourcePos, TargetPos: Integer;
     124  Operation: TStepOperation);
     125var
     126  NewItem: TDebugStep;
     127begin
     128  NewItem := TDebugStep.Create;
     129  NewItem.SourcePosition := SourcePos;
     130  NewItem.TargetPosition := TargetPos;
     131  NewItem.Operation := Operation;
     132  Add(NewItem);
     133end;
    75134
    76135
    … …  
    122181{ TTarget }
    123182
    124 procedure TTarget.SetSource(AValue: string);
    125 begin
    126   FSource := AValue;
     183function TTarget.GetTargetCode: string;
     184begin
     185  Result := FTargetCode;
     186end;
     187
     188procedure TTarget.SetSourceCode(AValue: string);
     189begin
     190  FSourceCode := AValue;
    127191end;
    128192
    129193procedure TTarget.AddLine(Text: string);
    130194begin
    131   Output := Output + DupeString('  ', Indent) + Text + LineEnding;
     195  FTargetCode := FTargetCode + DupeString('  ', Indent) + Text + LineEnding;
    132196end;
    133197
    … …  
    145209constructor TTarget.Create;
    146210begin
     211  inherited;
    147212  Optimization := coNormal;
     213  BreakPointers := TListInteger.Create;
     214  DebugSteps := TDebugStepList.Create;
     215end;
     216
     217destructor TTarget.Destroy;
     218begin
     219  DebugSteps.Free;;
     220  BreakPointers.Free;
     221  inherited Destroy;
    148222end;
    149223
    … …  
    156230procedure TTarget.Compile;
    157231begin
    158 
     232  Compiled := True;
    159233end;
    160234
    … …  
    170244  with TStringList.Create do
    171245  try
    172     Text := Output;
     246    Text := FTargetCode;
    173247    SaveToFile(CompiledFile);
    174248  finally

  • trunk/Target/UTargetC.pas

    r32 r33  
    5050  Result := 1;
    5151  if Optimization = coNormal then
    52   while ((I + 1) <= Length(FSource)) and (FSource[I + 1] = C) do begin
     52  while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin
    5353    Inc(Result);
    5454    Inc(I)
    … …  
    5858begin
    5959  Indent := 0;
    60   Output := '';
     60  FTargetCode := '';
    6161
    6262  AddLine('#include <stdio.h>');
    … …  
    7171  AddLine('Pos = 0;');
    7272  I := 1;
    73   while (I <= Length(FSource)) do begin
    74     case FSource[I] of
     73  while (I <= Length(FSourceCode)) do begin
     74    case FSourceCode[I] of
    7575      '>': begin
    7676        Sum := CheckOccurence('>');
    … …  
    119119  with TStringList.Create do
    120120  try
    121     Text := Output;
     121    Text := FTargetCode;
    122122    SaveToFile(CompiledFile);
    123123  finally

  • trunk/Target/UTargetDelphi.pas

    r32 r33  
    4444  Result := 1;
    4545  if Optimization = coNormal then
    46   while ((I + 1) <= Length(FSource)) and (FSource[I + 1] = C) do begin
     46  while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin
    4747    Inc(Result);
    4848    Inc(I)
    … …  
    5252begin
    5353  Indent := 0;
    54   Output := '';
     54  FTargetCode := '';
    5555
    5656  AddLine('program ' + ProgramName + ';');
    … …  
    6666  AddLine('Pos := 0;');
    6767  I := 1;
    68   while (I <= Length(FSource)) do begin
    69     case FSource[I] of
     68  while (I <= Length(FSourceCode)) do begin
     69    case FSourceCode[I] of
    7070      '>': begin
    7171        Sum := CheckOccurence('>');

  • trunk/Target/UTargetInterpretter.pas

    r32 r33  
    1818  end;
    1919
    20   TBrainFuckCommand = (cmNone, cmInc, cmDec, cmPointerInc, cmPointerDec,
    21     cmOutput, cmInput, cmLoopStart, cmLoopEnd);
     20  TBrainFuckCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
     21    cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug);
    2222
    2323  TCommandHandler = procedure of object;
    … …  
    4545    procedure CommandLoopStart;
    4646    procedure CommandLoopEnd;
     47    procedure SingleStep;
     48    procedure Reset;
    4749  protected
    48     procedure SetSource(AValue: string); override;
     50    function GetTargetCode: string; override;
    4951  public
    50     FSource: array of TBrainFuckCommand;
     52    FProgram: array of TBrainFuckCommand;
    5153    SourceJump: array of Integer;
    5254    SourcePosition: Integer;
    … …  
    5860    Input: string;
    5961    InputPosition: Integer;
    60     procedure Reset;
    61     procedure SingleStep;
     62    procedure Compile; override;
    6263    procedure Run; override;
    6364    procedure Pause; override;
    … …  
    7273  end;
    7374
     75const
     76  BrainFuckCommandText: array[TBrainFuckCommand] of Char = (
     77    ' ', '+', '-', '>', '<', '.', ',', '[', ']', '@');
     78
    7479
    7580implementation
    … …  
    8893begin
    8994  repeat
    90     while (Parent.SourcePosition < Length(Parent.FSource)) and (Parent.State <> rsStopped) do begin
     95    while (Parent.SourcePosition < Length(Parent.FProgram)) and (Parent.State <> rsStopped) do begin
    9196      Parent.SingleStep;
    9297      while Parent.State = rsPaused do begin
    … …  
    117122end;
    118123
    119 procedure TTargetInterpretter.SetSource(AValue: string);
     124procedure TTargetInterpretter.Compile;
    120125var
    121126  I: Integer;
    122127  Pos: Integer;
    123128begin
    124   SetLength(FSource, Length(AValue));
     129  DebugSteps.Clear;
     130  SetLength(FProgram, Length(FSourceCode));
    125131  Pos := 0;
    126   for I := 1 to Length(AValue) do begin
    127     case AValue[I] of
    128       '+': FSource[Pos] := cmInc;
    129       '-': FSource[Pos] := cmDec;
    130       '>': FSource[Pos] := cmPointerInc;
    131       '<': FSource[Pos] := cmPointerDec;
    132       ',': FSource[Pos] := cmInput;
    133       '.': FSource[Pos] := cmOutput;
    134       '[': FSource[Pos] := cmLoopStart;
    135       ']': FSource[Pos] := cmLoopEnd;
     132  for I := 1 to Length(FSourceCode) do begin
     133    case FSourceCode[I] of
     134      '+': begin
     135        FProgram[Pos] := cmInc;
     136        DebugSteps.AddStep(I - 1, Pos, soNormal);
     137      end;
     138      '-': begin
     139        FProgram[Pos] := cmDec;
     140        DebugSteps.AddStep(I - 1, Pos, soNormal);
     141      end;
     142      '>': begin
     143        FProgram[Pos] := cmPointerInc;
     144        DebugSteps.AddStep(I - 1, Pos, soNormal);
     145      end;
     146      '<': begin
     147        FProgram[Pos] := cmPointerDec;
     148        DebugSteps.AddStep(I - 1, Pos, soNormal);
     149      end;
     150      ',': begin
     151        FProgram[Pos] := cmInput;
     152        DebugSteps.AddStep(I - 1, Pos, soNormal);
     153      end;
     154      '.': begin
     155        FProgram[Pos] := cmOutput;
     156        DebugSteps.AddStep(I - 1, Pos, soNormal);
     157      end;
     158      '[': begin
     159        FProgram[Pos] := cmLoopStart;
     160        DebugSteps.AddStep(I - 1, Pos, soStepIn);
     161      end;
     162      ']': begin
     163        FProgram[Pos] := cmLoopEnd;
     164        DebugSteps.AddStep(I - 1, Pos, soStepOut);
     165      end
    136166      else Dec(Pos);
    137167    end;
    138168    Inc(Pos);
    139169  end;
    140   SetLength(FSource, Pos);
     170  SetLength(FProgram, Pos);
    141171end;
    142172
    … …  
    160190  I: Integer;
    161191begin
    162   SetLength(SourceJump, Length(FSource));
     192  SetLength(SourceJump, Length(FProgram));
    163193  //FillChar(Pointer(SourceJump)^, Length(SourceJump), 0);
    164   for I := 0 to Length(FSource) - 1 do
     194  for I := 0 to Length(FProgram) - 1 do
    165195    SourceJump[I] := 0;
    166196  SetLength(Loop, 0);
    167   for I := 0 to Length(FSource) - 1 do begin
    168     case FSource[I] of
     197  for I := 0 to Length(FProgram) - 1 do begin
     198    case FProgram[I] of
    169199      cmLoopStart: begin
    170200        SetLength(Loop, Length(Loop) + 1);
    … …  
    252282end;
    253283
     284function TTargetInterpretter.GetTargetCode: string;
     285var
     286  I: Integer;
     287begin
     288  SetLength(Result, Length(FProgram));
     289  for I := 0 to Length(FProgram) - 1 do
     290    Result[I + 1] := BrainFuckCommandText[FProgram[I]];
     291end;
     292
    254293procedure TTargetInterpretter.SingleStep;
    255294begin
    256   FCommandTable[FSource[SourcePosition]];
     295  FCommandTable[FProgram[SourcePosition]];
    257296  Inc(SourcePosition);
    258297  Inc(FStepCount);
    … …  
    281320  inherited;
    282321  Name := 'Interpretter';
    283   Capabilities := [tcRun, tcPause, tcStop];
     322  Capabilities := [tcRun, tcPause, tcStop, tcCompile, tcStepOut, tcStepInto,
     323    tcStepOver, tcRunToCursor];
    284324  MemorySize := 30000;
    285325  CellSize := 256;

  • trunk/Target/UTargetPHP.pas

    r32 r33  
    4848  Result := 1;
    4949  if Optimization = coNormal then
    50   while ((I + 1) <= Length(FSource)) and (FSource[I + 1] = C) do begin
     50  while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin
    5151    Inc(Result);
    5252    Inc(I)
    … …  
    5656begin
    5757  Indent := 0;
    58   Output := '';
     58  FTargetCode := '';
    5959
    6060  AddLine('<?php // ' + ProgramName);
    … …  
    6262  AddLine('$Memory = str_repeat("\0", 30000);');
    6363  AddLine('$Position = 0;');
    64   for I := 1 to Length(FSource) do begin
    65     case FSource[I] of
     64  for I := 1 to Length(FSourceCode) do begin
     65    case FSourceCode[I] of
    6666      '>': begin
    6767        Sum := CheckOccurence('>');
Note: See TracChangeset for help on using the changeset viewer.