Changeset 53 for branches/DelphiToC


Ignore:
Timestamp:
Aug 10, 2010, 10:14:57 AM (14 years ago)
Author:
george
Message:

Project renamed to Transpascal.
Added support for generatin cycle For-to-do.
Added support for parsing and generating structured types as record and array.
Emit procedure in TProducerPascal and TProducerC reworked.

Location:
branches/DelphiToC
Files:
3 added
10 edited

Legend:

Unmodified
Added
Removed

  • branches/DelphiToC/Analyze/UParser.pas

    r51 r53  
    6565    procedure ParseConstantList(SourceCode: TConstantList);
    6666    procedure ParseTypeList(SourceCode: TTypeList);
    67     function ParseType(TypeList: TTypeList): TType;
    68     function ParseRecordItem(TypeList: TTypeList): TType;
     67    function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
    6968  private
    7069  end;
    … …  
    999998  begin
    1000999    Expect('type');
    1001     while IsIdentificator(FNextToken) do
     1000    while IsIdentificator(FNextToken) do begin
    10021001      NewType := ParseType(SourceCode);
    10031002      if Assigned(NewType) then begin
    … …  
    10051004        Add(NewType);
    10061005      end;
     1006      Expect(';');
     1007    end;
    10071008  end;
    10081009end;
    … …  
    10101011{ TParserType }
    10111012
    1012 function TPascalParser.ParseType(TypeList: TTypeList): TType;
     1013function TPascalParser.ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
    10131014var
    10141015  Name: string;
    1015   UsedTypeName: string;
     1016  TypeName: string;
    10161017begin
    10171018  //with SourceCode do
    10181019  begin
    1019     Name := ReadCode;
    1020     Expect('=');
     1020    if ExpectName then begin
     1021      Name := ReadCode;
     1022      Expect(AssignSymbol);
     1023    end;
    10211024    if FNextToken = 'record' then begin
    10221025      Expect('record');
    … …  
    10261029      while (FNextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
    10271030      begin
    1028         TTypeRecord(Result).Items.Add(ParseRecordItem(TypeList));
     1031        TTypeRecord(Result).Items.Add(ParseType(TypeList, True, ':'));
     1032        Expect(';');
    10291033      end;
    10301034      Expect('end');
     1035    end else
     1036    if FNextToken = 'array' then begin
     1037      Expect('array');
     1038      Result := TTypeArray.Create;
     1039      TTypeArray(Result).Parent := TypeList;
     1040      TType(Result).Name := Name;
     1041      if FNextToken = '[' then begin
     1042        Expect('[');
     1043        TypeName := FNextToken;
     1044        TTypeArray(Result).IndexType := ParseType(TypeList, False);
     1045        if not Assigned(TTypeArray(Result).IndexType) then
     1046          ErrorMessage(SUndefinedType, [TypeName]);
     1047        Expect(']');
     1048      end;
     1049      Expect('of');
     1050      TypeName := FNextToken;
     1051      TTypeArray(Result).ItemType := ParseType(TypeList, False);
     1052      if not Assigned(TTypeArray(Result).ItemType) then
     1053        ErrorMessage(SUndefinedType, [TypeName]);
    10311054    end else begin
    1032       UsedTypeName := ReadCode;
    1033       Result := TType.Create;
    1034       TType(Result).Parent := TypeList;
    1035       TType(Result).Name := Name;
    1036       TType(Result).UsedType := TypeList.Search(UsedTypeName);
    1037       if not Assigned(TType(Result).UsedType) then ErrorMessage(SUndefinedType, [UsedTypeName]);
    1038     end;
    1039     Expect(';');
    1040   end;
    1041 end;
    1042 
    1043 function TPascalParser.ParseRecordItem(TypeList: TTypeList): TType;
    1044 var
    1045   Name: string;
    1046   UsedTypeName: string;
    1047 begin
    1048   //with SourceCode do
    1049   begin
    1050     Name := ReadCode;
    1051     Expect(':');
    1052     if FNextToken = 'record' then begin
    1053       Expect('record');
    1054       Result := TTypeRecord.Create;
    1055       TTypeRecord(Result).Parent := TypeList;
    1056       TTypeRecord(Result).Name := Name;
    1057       while (FNextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
    1058       begin
    1059         TTypeRecord(Result).Items.Add(ParseRecordItem(TypeList));
    1060       end;
    1061       Expect('end');
    1062     end else begin
    1063       UsedTypeName := ReadCode;
    1064       Result := TType.Create;
    1065       TType(Result).Parent := TypeList;
    1066       TType(Result).Name := Name;
    1067       TType(Result).UsedType := TypeList.Search(UsedTypeName);
    1068       if not Assigned(TType(Result).UsedType) then ErrorMessage(SUndefinedType, [UsedTypeName]);
    1069     end;
    1070     Expect(';');
     1055      TypeName := ReadCode;
     1056      if ExpectName then begin
     1057        Result := TType.Create;
     1058        TType(Result).Parent := TypeList;
     1059        TType(Result).Name := Name;
     1060        TType(Result).UsedType := TypeList.Search(TypeName);
     1061        if not Assigned(TType(Result).UsedType) then
     1062          ErrorMessage(SUndefinedType, [TypeName]);
     1063      end else begin
     1064        TType(Result) := TypeList.Search(TypeName);
     1065        if not Assigned(TType(Result)) then
     1066          ErrorMessage(SUndefinedType, [TypeName]);
     1067      end;
     1068    end;
    10711069  end;
    10721070end;

  • branches/DelphiToC/DelphiToC.lpi

    r52 r53  
    4848        <TopLine Value="4"/>
    4949        <CursorPos X="1" Y="29"/>
    50         <UsageCount Value="146"/>
     50        <UsageCount Value="148"/>
    5151        <Loaded Value="True"/>
    5252      </Unit0>
    … …  
    6060        <EditorIndex Value="6"/>
    6161        <WindowIndex Value="0"/>
    62         <TopLine Value="77"/>
    63         <CursorPos X="35" Y="87"/>
    64         <UsageCount Value="146"/>
     62        <TopLine Value="15"/>
     63        <CursorPos X="46" Y="28"/>
     64        <UsageCount Value="148"/>
    6565        <Loaded Value="True"/>
    6666        <LoadedDesigner Value="True"/>
    … …  
    7373        <TopLine Value="1"/>
    7474        <CursorPos X="1" Y="1"/>
    75         <UsageCount Value="146"/>
     75        <UsageCount Value="148"/>
    7676      </Unit2>
    7777      <Unit3>
    … …  
    8181        <EditorIndex Value="5"/>
    8282        <WindowIndex Value="0"/>
    83         <TopLine Value="637"/>
    84         <CursorPos X="13" Y="668"/>
    85         <UsageCount Value="146"/>
     83        <TopLine Value="168"/>
     84        <CursorPos X="12" Y="181"/>
     85        <UsageCount Value="148"/>
    8686        <Loaded Value="True"/>
    8787      </Unit3>
    … …  
    9494        <TopLine Value="1"/>
    9595        <CursorPos X="40" Y="16"/>
    96         <UsageCount Value="146"/>
     96        <UsageCount Value="148"/>
    9797        <Loaded Value="True"/>
    9898      </Unit4>
    … …  
    105105        <TopLine Value="15"/>
    106106        <CursorPos X="19" Y="28"/>
    107         <UsageCount Value="146"/>
     107        <UsageCount Value="148"/>
    108108        <Loaded Value="True"/>
    109109      </Unit5>
    … …  
    112112        <IsPartOfProject Value="True"/>
    113113        <UnitName Value="UProducer"/>
    114         <IsVisibleTab Value="True"/>
    115114        <EditorIndex Value="1"/>
    116115        <WindowIndex Value="0"/>
    117116        <TopLine Value="1"/>
    118117        <CursorPos X="5" Y="13"/>
    119         <UsageCount Value="146"/>
     118        <UsageCount Value="148"/>
    120119        <Loaded Value="True"/>
    121120      </Unit6>
    … …  
    128127        <TopLine Value="2"/>
    129128        <CursorPos X="13" Y="15"/>
    130         <UsageCount Value="146"/>
     129        <UsageCount Value="148"/>
    131130        <Loaded Value="True"/>
    132131      </Unit7>
    … …  
    137136        <EditorIndex Value="0"/>
    138137        <WindowIndex Value="0"/>
    139         <TopLine Value="1021"/>
    140         <CursorPos X="1" Y="1026"/>
    141         <UsageCount Value="146"/>
     138        <TopLine Value="1032"/>
     139        <CursorPos X="16" Y="1059"/>
     140        <UsageCount Value="148"/>
    142141        <Loaded Value="True"/>
    143142      </Unit8>
    … …  
    164163        <TopLine Value="61"/>
    165164        <CursorPos X="7" Y="68"/>
    166         <UsageCount Value="56"/>
     165        <UsageCount Value="57"/>
    167166        <Loaded Value="True"/>
    168167      </Unit11>
    … …  
    173172        <TopLine Value="139"/>
    174173        <CursorPos X="16" Y="146"/>
    175         <UsageCount Value="56"/>
     174        <UsageCount Value="57"/>
    176175        <Loaded Value="True"/>
    177176      </Unit12>
    … …  
    205204        <TopLine Value="1"/>
    206205        <CursorPos X="20" Y="14"/>
    207         <UsageCount Value="108"/>
     206        <UsageCount Value="110"/>
    208207        <Loaded Value="True"/>
    209208      </Unit16>
    … …  
    227226        <IsPartOfProject Value="True"/>
    228227        <UnitName Value="UProducerPascal"/>
     228        <IsVisibleTab Value="True"/>
    229229        <EditorIndex Value="7"/>
    230230        <WindowIndex Value="0"/>
    231         <TopLine Value="1"/>
    232         <CursorPos X="23" Y="9"/>
    233         <UsageCount Value="62"/>
     231        <TopLine Value="88"/>
     232        <CursorPos X="15" Y="99"/>
     233        <UsageCount Value="64"/>
    234234        <Loaded Value="True"/>
    235235      </Unit19>
    236236    </Units>
    237     <JumpHistory Count="30" HistoryIndex="29">
     237    <JumpHistory Count="30" HistoryIndex="28">
    238238      <Position1>
    239         <Filename Value="Analyze\UParser.pas"/>
    240         <Caret Line="1001" Column="28" TopLine="988"/>
     239        <Filename Value="Forms\UMainForm.pas"/>
     240        <Caret Line="86" Column="42" TopLine="66"/>
    241241      </Position1>
    242242      <Position2>
    243         <Filename Value="Analyze\UParser.pas"/>
    244         <Caret Line="1024" Column="57" TopLine="1011"/>
     243        <Filename Value="Forms\UMainForm.pas"/>
     244        <Caret Line="9" Column="7" TopLine="1"/>
    245245      </Position2>
    246246      <Position3>
    247         <Filename Value="Analyze\UParser.pas"/>
    248         <Caret Line="1022" Column="45" TopLine="1009"/>
     247        <Filename Value="Produce\UProducerTreeView.pas"/>
     248        <Caret Line="14" Column="9" TopLine="7"/>
    249249      </Position3>
    250250      <Position4>
    251         <Filename Value="Analyze\UParser.pas"/>
    252         <Caret Line="1030" Column="39" TopLine="1017"/>
     251        <Filename Value="Forms\UMainForm.pas"/>
     252        <Caret Line="84" Column="39" TopLine="71"/>
    253253      </Position4>
    254254      <Position5>
    255         <Filename Value="Analyze\UParser.pas"/>
    256         <Caret Line="1031" Column="41" TopLine="1018"/>
     255        <Filename Value="Forms\UMainForm.pas"/>
     256        <Caret Line="88" Column="1" TopLine="81"/>
    257257      </Position5>
    258258      <Position6>
    259         <Filename Value="Analyze\UParser.pas"/>
    260         <Caret Line="1067" Column="63" TopLine="1051"/>
     259        <Filename Value="Forms\UMainForm.pas"/>
     260        <Caret Line="86" Column="57" TopLine="73"/>
    261261      </Position6>
    262262      <Position7>
    263         <Filename Value="Analyze\UParser.pas"/>
    264         <Caret Line="1058" Column="54" TopLine="1045"/>
     263        <Filename Value="Forms\UMainForm.pas"/>
     264        <Caret Line="85" Column="57" TopLine="72"/>
    265265      </Position7>
    266266      <Position8>
    267267        <Filename Value="Forms\UMainForm.pas"/>
    268         <Caret Line="112" Column="60" TopLine="97"/>
     268        <Caret Line="99" Column="69" TopLine="75"/>
    269269      </Position8>
    270270      <Position9>
    271271        <Filename Value="Forms\UMainForm.pas"/>
    272         <Caret Line="111" Column="60" TopLine="96"/>
     272        <Caret Line="65" Column="31" TopLine="52"/>
    273273      </Position9>
    274274      <Position10>
    275         <Filename Value="Produce\UProducer.pas"/>
    276         <Caret Line="11" Column="11" TopLine="1"/>
     275        <Filename Value="Forms\UMainForm.pas"/>
     276        <Caret Line="76" Column="31" TopLine="63"/>
    277277      </Position10>
    278278      <Position11>
    279279        <Filename Value="Forms\UMainForm.pas"/>
    280         <Caret Line="111" Column="60" TopLine="96"/>
     280        <Caret Line="77" Column="11" TopLine="64"/>
    281281      </Position11>
    282282      <Position12>
    283         <Filename Value="Produce\UProducerTreeView.pas"/>
    284         <Caret Line="36" Column="16" TopLine="17"/>
     283        <Filename Value="Forms\UMainForm.pas"/>
     284        <Caret Line="87" Column="31" TopLine="74"/>
    285285      </Position12>
    286286      <Position13>
    287         <Filename Value="Produce\UProducerTreeView.pas"/>
    288         <Caret Line="35" Column="1" TopLine="23"/>
     287        <Filename Value="Forms\UMainForm.pas"/>
     288        <Caret Line="98" Column="31" TopLine="85"/>
    289289      </Position13>
    290290      <Position14>
    291         <Filename Value="Forms\UMainForm.pas"/>
    292         <Caret Line="84" Column="35" TopLine="71"/>
     291        <Filename Value="Produce\UProducerC.pas"/>
     292        <Caret Line="128" Column="17" TopLine="128"/>
    293293      </Position14>
    294294      <Position15>
    295         <Filename Value="Forms\UMainForm.pas"/>
    296         <Caret Line="86" Column="42" TopLine="66"/>
     295        <Filename Value="Produce\UProducerC.pas"/>
     296        <Caret Line="15" Column="5" TopLine="2"/>
    297297      </Position15>
    298298      <Position16>
    299         <Filename Value="Forms\UMainForm.pas"/>
    300         <Caret Line="9" Column="7" TopLine="1"/>
     299        <Filename Value="Produce\UProducerAsm8051.pas"/>
     300        <Caret Line="103" Column="22" TopLine="97"/>
    301301      </Position16>
    302302      <Position17>
    303         <Filename Value="Produce\UProducerTreeView.pas"/>
    304         <Caret Line="14" Column="9" TopLine="7"/>
     303        <Filename Value="Forms\UMainForm.pas"/>
     304        <Caret Line="87" Column="35" TopLine="77"/>
    305305      </Position17>
    306306      <Position18>
    307307        <Filename Value="Forms\UMainForm.pas"/>
    308         <Caret Line="84" Column="39" TopLine="71"/>
     308        <Caret Line="11" Column="27" TopLine="1"/>
    309309      </Position18>
    310310      <Position19>
    311         <Filename Value="Forms\UMainForm.pas"/>
    312         <Caret Line="88" Column="1" TopLine="81"/>
     311        <Filename Value="Analyze\UParser.pas"/>
     312        <Caret Line="1012" Column="81" TopLine="1009"/>
    313313      </Position19>
    314314      <Position20>
    315         <Filename Value="Forms\UMainForm.pas"/>
    316         <Caret Line="86" Column="57" TopLine="73"/>
     315        <Filename Value="Analyze\UParser.pas"/>
     316        <Caret Line="1027" Column="62" TopLine="1011"/>
    317317      </Position20>
    318318      <Position21>
    319         <Filename Value="Forms\UMainForm.pas"/>
    320         <Caret Line="85" Column="57" TopLine="72"/>
     319        <Filename Value="Analyze\UParser.pas"/>
     320        <Caret Line="1022" Column="21" TopLine="1018"/>
    321321      </Position21>
    322322      <Position22>
    323         <Filename Value="Forms\UMainForm.pas"/>
    324         <Caret Line="99" Column="69" TopLine="75"/>
     323        <Filename Value="Analyze\UParser.pas"/>
     324        <Caret Line="1011" Column="55" TopLine="1006"/>
    325325      </Position22>
    326326      <Position23>
    327         <Filename Value="Forms\UMainForm.pas"/>
    328         <Caret Line="65" Column="31" TopLine="52"/>
     327        <Filename Value="Analyze\UParser.pas"/>
     328        <Caret Line="1014" Column="3" TopLine="1011"/>
    329329      </Position23>
    330330      <Position24>
    331         <Filename Value="Forms\UMainForm.pas"/>
    332         <Caret Line="76" Column="31" TopLine="63"/>
     331        <Filename Value="Analyze\UParser.pas"/>
     332        <Caret Line="1027" Column="65" TopLine="1014"/>
    333333      </Position24>
    334334      <Position25>
    335         <Filename Value="Forms\UMainForm.pas"/>
    336         <Caret Line="77" Column="11" TopLine="64"/>
     335        <Filename Value="Produce\UProducerPascal.pas"/>
     336        <Caret Line="9" Column="23" TopLine="1"/>
    337337      </Position25>
    338338      <Position26>
    339         <Filename Value="Forms\UMainForm.pas"/>
    340         <Caret Line="87" Column="31" TopLine="74"/>
     339        <Filename Value="Produce\UProducerPascal.pas"/>
     340        <Caret Line="20" Column="15" TopLine="7"/>
    341341      </Position26>
    342342      <Position27>
    343         <Filename Value="Forms\UMainForm.pas"/>
    344         <Caret Line="98" Column="31" TopLine="85"/>
     343        <Filename Value="Produce\UProducerPascal.pas"/>
     344        <Caret Line="97" Column="1" TopLine="88"/>
    345345      </Position27>
    346346      <Position28>
    347         <Filename Value="Produce\UProducerC.pas"/>
    348         <Caret Line="128" Column="17" TopLine="128"/>
     347        <Filename Value="Produce\UProducerPascal.pas"/>
     348        <Caret Line="160" Column="62" TopLine="151"/>
    349349      </Position28>
    350350      <Position29>
    351         <Filename Value="Produce\UProducerC.pas"/>
    352         <Caret Line="15" Column="5" TopLine="2"/>
     351        <Filename Value="Produce\UProducerPascal.pas"/>
     352        <Caret Line="158" Column="14" TopLine="146"/>
    353353      </Position29>
    354354      <Position30>
    355         <Filename Value="Produce\UProducerAsm8051.pas"/>
    356         <Caret Line="103" Column="22" TopLine="97"/>
     355        <Filename Value="USourceCode.pas"/>
     356        <Caret Line="181" Column="12" TopLine="168"/>
    357357      </Position30>
    358358    </JumpHistory>

  • branches/DelphiToC/Example.pas

    r51 r53  
    88    Y: Integer;
    99  end;
     10
     11  TArrayOfByte = array[Byte] of Byte;
    1012
    1113function Max(A, B: Byte): Byte;

  • branches/DelphiToC/Forms/UMainForm.lfm

    r52 r53  
    11object MainForm: TMainForm
    2   Left = 176
     2  Left = 141
    33  Height = 498
    4   Top = 77
     4  Top = 105
    55  Width = 881
    6   Caption = 'Pascal Compiler AVR'
     6  Caption = 'Transpascal '
    77  ClientHeight = 498
    88  ClientWidth = 881
    … …  
    1515  Position = poDesktopCenter
    1616  LCLVersion = '0.9.29'
    17   object Button1: TButton
    18     Left = 800
     17  object ButtonCompile: TButton
     18    Left = 801
    1919    Height = 22
    2020    Top = 401
    … …  
    2222    Anchors = [akRight, akBottom]
    2323    Caption = 'Kompilovat'
    24     OnClick = Button1Click
     24    Font.Height = -11
     25    Font.Name = 'Tahoma'
     26    OnClick = ButtonCompileClick
     27    ParentFont = False
    2528    TabOrder = 0
    2629  end

  • branches/DelphiToC/Forms/UMainForm.pas

    r52 r53  
    1818
    1919  TMainForm = class(TForm)
    20     Button1: TButton;
     20    ButtonCompile: TButton;
    2121    ComboBox1: TComboBox;
    2222    ListBox1: TListBox;
    … …  
    2727    procedure FormShow(Sender: TObject);
    2828    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    29     procedure Button1Click(Sender: TObject);
     29    procedure ButtonCompileClick(Sender: TObject);
    3030    procedure FormCreate(Sender: TObject);
    3131    procedure FormDestroy(Sender: TObject);
    … …  
    4848{ TMainForm }
    4949
    50 procedure TMainForm.Button1Click(Sender: TObject);
     50procedure TMainForm.ButtonCompileClick(Sender: TObject);
    5151var
    5252  I: Integer;
    … …  
    6464    ProducerControl.Parent := Panel1;
    6565    ProducerControl.Align := alClient;
     66    ProducerControl.Font.Name := 'Courier New';
     67    TMemo(ProducerControl).ScrollBars := ssAutoBoth;
    6668    with TProducerPascal(Compiler.Producer) do
    6769      TMemo(ProducerControl).Lines.Assign(TextSource);
    … …  
    7577    ProducerControl.Parent := Panel1;
    7678    ProducerControl.Align := alClient;
     79    ProducerControl.Font.Name := 'Courier New';
     80    TMemo(ProducerControl).ScrollBars := ssAutoBoth;
    7781    with TProducerC(Compiler.Producer) do
    7882      TMemo(ProducerControl).Lines.Assign(TextSource);
    … …  
    8690    ProducerControl.Parent := Panel1;
    8791    ProducerControl.Align := alClient;
     92    ProducerControl.Font.Name := 'Courier New';
     93    TMemo(ProducerControl).ScrollBars := ssAutoBoth;
    8894    with TProducerAsm8051(Compiler.Producer) do
    8995    for I := 0 to AssemblyCode.Count - 1 do
    … …  
    143149  WindowState := wsMaximized;
    144150  SynEdit1.Lines.LoadFromFile(ExampleFileName);
    145   Button1Click(Self);
     151  ButtonCompileClick(Self);
    146152end;
    147153
    148154procedure TMainForm.ComboBox1Change(Sender: TObject);
    149155begin
    150   Button1Click(Self);
     156  ButtonCompileClick(Self);
    151157end;
    152158

  • branches/DelphiToC/Produce/UProducerC.pas

    r52 r53  
    1717    function TranslateType(Name: string): string;
    1818    function TranslateOperator(Name: string): string;
    19     procedure Emit(Text: string);
     19    procedure Emit(AText: string; NewLine: Boolean = True);
    2020    procedure GenerateUses(UsedModules: TUsedModuleList);
    2121    procedure GenerateModule(Module: TModule);
    2222    procedure GenerateCommonBlock(CommonBlock: TCommonBlock;
    2323      LabelPrefix: string);
     24    procedure GenerateType(AType: TType);
     25    procedure GenerateTypes(Types: TTypeList);
    2426    procedure GenerateProgram(ProgramBlock: TProgram);
    2527    procedure GenerateFunctions(Functions: TFunctionList);
    … …  
    2729    procedure GenerateCommand(Command: TCommand);
    2830    procedure GenerateWhileDo(WhileDo: TWhileDo);
     31    procedure GenerateForToDo(ForToDo: TForToDo);
    2932    procedure GenerateIfThenElse(IfThenElse: TIfThenElse);
    3033    procedure GenerateAssignment(Assignment: TAssignment);
    … …  
    6467  else if Name = 'Cardinal' then Result := 'uint32'
    6568  else if Name = 'Integer' then Result := 'int32'
    66   else if Name = 'Void' then Result := 'void';
     69  else if Name = 'Void' then Result := 'void'
     70  else Result := Name;
    6771end;
    6872
    … …  
    8286end;
    8387
    84 procedure TProducerC.Emit(Text: string);
    85 begin
    86   TextSource.Add(DupeString(' ', IndentationLength * Indetation) + Text);
     88procedure TProducerC.Emit(AText: string; NewLine: Boolean = True);
     89begin
     90  with TextSource do begin
     91    if Count = 0 then Add('');
     92    if Strings[Count - 1] = '' then
     93      Strings[Count - 1] := Strings[Count - 1] + DupeString(' ', IndentationLength * Indetation);
     94    Strings[Count - 1] := Strings[Count - 1] + AText;
     95    if NewLine then Add('');
     96  end;
    8797end;
    8898
    … …  
    180190  if Command is TBeginEnd then GenerateBeginEnd(TBeginEnd(Command))
    181191  else if Command is TWhileDo then GenerateWhileDo(TWhileDo(Command))
     192  else if Command is TForToDo then GenerateForToDo(TForToDo(Command))
    182193  else if Command is TIfThenElse then GenerateIfThenElse(TIfThenElse(Command))
    183194  else if Command is TAssignment then GenerateAssignment(TAssignment(Command))
    … …  
    189200  Emit('while (' + GenerateExpression(WhileDo.Condition) + ')');
    190201  GenerateCommand(WhileDo.Command);
     202end;
     203
     204procedure TProducerC.GenerateForToDo(ForToDo: TForToDo);
     205begin
     206  with ForToDo do begin
     207    Emit('for(' + ControlVariable.Name + ' = ' +
     208      GenerateExpression(Start) + '; ' + ControlVariable.Name + ' < ' +
     209      GenerateExpression(Stop) + '; ' + ControlVariable.Name + '++)');
     210    GenerateCommand(Command);
     211  end;
    191212end;
    192213
    … …  
    246267begin
    247268  with CommonBlock do begin
     269    GenerateTypes(Types);
    248270    GenerateFunctions(Functions);
    249271    Emit('void ' + Name + '()');
    … …  
    252274end;
    253275
     276procedure TProducerC.GenerateType(AType: TType);
     277var
     278  I: Integer;
     279begin
     280  if AType is TTypeRecord then begin
     281    Emit('typedef struct');
     282    Emit('{');
     283    Inc(Indetation);
     284    for I := 0 to TTypeRecord(AType).Items.Count - 1 do begin
     285      GenerateType(TType(TTypeRecord(AType).Items[I]));
     286      Emit(';');
     287    end;
     288    Dec(Indetation);
     289    Emit('} ' + TranslateType(AType.Name), False);
     290  end else
     291  if AType is TTypeArray then begin
     292    GenerateType(TTypeArray(AType).ItemType);
     293    Emit('* ', False);
     294
     295(*    if Assigned(TTypeArray(AType).IndexType) then begin
     296      Emit(AType.Name + '[', False);
     297      Emit('[', False);
     298      GenerateType(TTypeArray(AType).IndexType);
     299      Emit(']', False);
     300    end;
     301    Emit(' of ', False);
     302    if Assigned(TTypeArray(AType).ItemType) then*)
     303    Emit(TranslateType(AType.Name), False);
     304  end else begin
     305    if Assigned(AType.UsedType) then begin
     306      GenerateType(AType.UsedType);
     307      Emit(' ', False);
     308    end;
     309    Emit(TranslateType(AType.Name), False);
     310  end;
     311end;
     312
     313procedure TProducerC.GenerateTypes(Types: TTypeList);
     314var
     315  I: Integer;
     316begin
     317  if Types.Count > 0 then begin
     318    Inc(Indetation);
     319    for I := 0 to Types.Count - 1 do
     320    with TType(Types[I]) do
     321    if (not System) then begin
     322      GenerateType(TType(Types[I]));
     323      Emit(';');
     324    end;
     325    Dec(Indetation);
     326    Emit('');
     327  end;
     328end;
     329
    254330
    255331

  • branches/DelphiToC/Produce/UProducerPascal.pas

    r52 r53  
    1515  TProducerPascal = class(TProducer)
    1616  private
    17     procedure Emit(Text: string; NewLine: Boolean = True);
     17    procedure Emit(AText: string; NewLine: Boolean = True);
    1818    procedure GenerateUses(UsedModules: TUsedModuleList);
    1919    procedure GenerateModule(Module: TModule);
     20    procedure GenerateType(AType: TType; AssignSymbol: Char = ':');
     21    procedure GenerateTypes(Types: TTypeList);
    2022    procedure GenerateCommonBlock(CommonBlock: TCommonBlock;
    2123      LabelPrefix: string);
    … …  
    2729    procedure GenerateCommand(Command: TCommand);
    2830    procedure GenerateWhileDo(WhileDo: TWhileDo);
     31    procedure GenerateForToDo(ForToDo: TForToDo);
    2932    procedure GenerateIfThenElse(IfThenElse: TIfThenElse);
    3033    procedure GenerateAssignment(Assignment: TAssignment);
    … …  
    5659end;
    5760
    58 procedure TProducerPascal.Emit(Text: string; NewLine: Boolean = True);
    59 begin
    60   if NewLine then TextSource.Add(DupeString(' ', IndentationLength * Indetation) + Text)
    61     else TextSource.Strings[TextSource.Count - 1] := TextSource.Strings[TextSource.Count - 1] + Text;
     61procedure TProducerPascal.Emit(AText: string; NewLine: Boolean = True);
     62begin
     63  with TextSource do begin
     64    if Count = 0 then Add('');
     65    if Strings[Count - 1] = '' then
     66      Strings[Count - 1] := Strings[Count - 1] + DupeString(' ', IndentationLength * Indetation);
     67    Strings[Count - 1] := Strings[Count - 1] + AText;
     68    if NewLine then Add('');
     69  end;
    6270end;
    6371
    … …  
    8391  GenerateCommonBlock(Module, '');
    8492  Emit('.', False);
     93end;
     94
     95procedure TProducerPascal.GenerateType(AType: TType; AssignSymbol: Char = ':');
     96var
     97  I: Integer;
     98begin
     99  if AType is TTypeRecord then begin
     100    Emit(AType.Name + ' ' + AssignSymbol + ' record');
     101    Inc(Indetation);
     102    for I := 0 to TTypeRecord(AType).Items.Count - 1 do begin
     103      GenerateType(TType(TTypeRecord(AType).Items[I]));
     104      Emit(';');
     105    end;
     106    Dec(Indetation);
     107    Emit('end', False);
     108  end else
     109  if AType is TTypeArray then begin
     110    Emit(AType.Name + ' ' + AssignSymbol + ' array ', False);
     111    if Assigned(TTypeArray(AType).IndexType) then begin
     112      Emit('[', False);
     113      GenerateType(TTypeArray(AType).IndexType);
     114      Emit(']', False);
     115    end;
     116    Emit(' of ', False);
     117    if Assigned(TTypeArray(AType).ItemType) then
     118      GenerateType(TTypeArray(AType).ItemType);
     119  end else begin
     120    Emit(AType.Name, False);
     121    if Assigned(AType.UsedType) then begin
     122      Emit(' ' + AssignSymbol + ' ', False);
     123      GenerateType(AType.UsedType);
     124    end;
     125  end;
     126end;
     127
     128procedure TProducerPascal.GenerateTypes(Types: TTypeList);
     129var
     130  I: Integer;
     131begin
     132  if Types.Count > 0 then begin
     133    Emit('type');
     134    Inc(Indetation);
     135    for I := 0 to Types.Count - 1 do
     136    with TType(Types[I]) do
     137    if (not System) then begin
     138      GenerateType(TType(Types[I]), '=');
     139      Emit(';');
     140    end;
     141    Dec(Indetation);
     142    Emit('');
     143  end;
    85144end;
    86145
    … …  
    127186    Emit(Line + ';');
    128187    GenerateBeginEnd(Code);
    129     Emit(';', False);
     188    Emit(';');
    130189    Emit('');
    131190  end;
    … …  
    136195  I: Integer;
    137196begin
    138   Emit('const');
    139   Inc(Indetation);
    140   for I := 0 to Constants.Count - 1 do
    141   with TConstant(Constants[I]) do
    142     Emit(Name + ': ' + ValueType.Name + ' = ' + Value + ';');
    143   Dec(Indetation);
    144   Emit('');
     197  if Constants.Count > 0 then begin
     198    Emit('const');
     199    Inc(Indetation);
     200    for I := 0 to Constants.Count - 1 do
     201    with TConstant(Constants[I]) do
     202    if not System then begin
     203      Emit(Name + ': ' + ValueType.Name + ' = ' + Value + ';');
     204    end;
     205    Dec(Indetation);
     206    Emit('');
     207  end;
    145208end;
    146209
    … …  
    154217  for I := 0 to BeginEnd.Commands.Count - 1 do begin
    155218    GenerateCommand(TCommand(BeginEnd.Commands[I]));
    156     Emit(';', False);
     219    Emit(';');
    157220  end;
    158221
    159222  Dec(Indetation);
    160   Emit('end');
     223  Emit('end', False);
    161224end;
    162225
    … …  
    178241  if Command is TBeginEnd then GenerateBeginEnd(TBeginEnd(Command))
    179242  else if Command is TWhileDo then GenerateWhileDo(TWhileDo(Command))
     243  else if Command is TForToDo then GenerateForToDo(TForToDo(Command))
    180244  else if Command is TIfThenElse then GenerateIfThenElse(TIfThenElse(Command))
    181245  else if Command is TAssignment then GenerateAssignment(TAssignment(Command))
    … …  
    189253end;
    190254
     255procedure TProducerPascal.GenerateForToDo(ForToDo: TForToDo);
     256begin
     257  with ForToDo do begin
     258    Emit('for ' + ControlVariable.Name + ' := ' +
     259      GenerateExpression(Start) + ' to ' + GenerateExpression(Stop) + ' do ');
     260    GenerateCommand(Command);
     261  end;
     262end;
     263
    191264procedure TProducerPascal.GenerateIfThenElse(IfThenElse: TIfThenElse);
    192265begin
    … …  
    194267  GenerateCommand(IfThenElse.Command);
    195268  if Assigned(IfThenElse.ElseCommand) then begin
    196     Emit('else ');
     269    Emit(' else ');
    197270    GenerateCommand(IfThenElse.ElseCommand);
    198271  end;
    … …  
    201274procedure TProducerPascal.GenerateAssignment(Assignment: TAssignment);
    202275begin
    203   Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source));
     276  Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source), False);
    204277end;
    205278
    … …  
    220293    end;
    221294  end;
    222   Emit(Line);
     295  Emit(Line, False);
    223296end;
    224297
    … …  
    244317begin
    245318  with CommonBlock do begin
     319    GenerateTypes(Types);
    246320    GenerateFunctions(Functions);
    247321    GenerateConstants(Constants);

  • branches/DelphiToC/Produce/UProducerTreeView.pas

    r52 r53  
    2222    procedure AddNodeTypeRecord(Node: TTreeNode; TypeRecord: TTypeRecord);
    2323    procedure AddNodeTypeList(Node: TTreeNode; Types: TTypeList);
     24    procedure AddNodeType(Node: TTreeNode; AType: TType);
    2425    procedure AddNodeVariableList(Node: TTreeNode; Variables: TVariableList);
    2526    procedure AddNodeConstantList(Node: TTreeNode; Constants: TConstantList);
    … …  
    5657  NewNode: TTreeNode;
    5758  NewNode2: TTreeNode;
    58   NewNode3: TTreeNode;
    59   I: Integer;
    6059begin
    6160  NewNode := TreeView.Items.AddChild(Node, 'while');
    … …  
    194193var
    195194  NewNode: TTreeNode;
    196   NewNode2: TTreeNode;
    197   NewNode3: TTreeNode;
    198195  I: Integer;
    199196begin
    … …  
    202199    for I := 0 to Types.Count - 1 do
    203200    with TType(Types[I]) do
    204     if not System then begin
    205       if TType(Types[I]) is TTypeRecord then begin
    206         NewNode2 := TreeView.Items.AddChild(NewNode, Name + ' = record');
    207         AddNodeTypeRecord(NewNode2, TTypeRecord(Types[I]));
    208       end else if Assigned(UsedType) then
    209         NewNode2 := TreeView.Items.AddChild(NewNode, Name + ' = ' + UsedType.Name)
    210       else NewNode2 := TreeView.Items.AddChild(NewNode, Name);
    211     end;
     201    if not System then AddNodeType(NewNode, TType(Types[I]));
     202  end;
     203end;
     204
     205procedure TProducerTreeView.AddNodeType(Node: TTreeNode; AType: TType);
     206var
     207  NewNode: TTreeNode;
     208  NewNode2: TTreeNode;
     209begin
     210  with AType do begin
     211    if AType is TTypeRecord then begin
     212      NewNode := TreeView.Items.AddChild(Node, Name + ' = record');
     213      AddNodeTypeRecord(NewNode, TTypeRecord(AType));
     214    end else
     215    if AType is TTypeArray then begin
     216      NewNode := TreeView.Items.AddChild(Node, Name + ' = array');
     217      if Assigned(TTypeArray(AType).IndexType) then begin
     218        NewNode2 := TreeView.Items.AddChild(NewNode, 'Index');
     219        AddNodeType(NewNode2, TTypeArray(AType).IndexType);
     220      end;
     221      if Assigned(TTypeArray(AType).ItemType) then begin
     222        NewNode2 := TreeView.Items.AddChild(NewNode, 'ItemType');
     223        AddNodeType(NewNode2, TTypeArray(AType).ItemType);
     224      end;
     225    end else if Assigned(UsedType) then
     226      NewNode := TreeView.Items.AddChild(Node, Name + ' = ' + UsedType.Name)
     227    else NewNode := TreeView.Items.AddChild(Node, Name);
    212228  end;
    213229end;
    … …  
    217233var
    218234  NewNode: TTreeNode;
    219   NewNode2: TTreeNode;
    220235  I: Integer;
    221236begin
    … …  
    253268  );
    254269var
    255   NewNode: TTreeNode;
    256   NewNode2: TTreeNode;
    257   NewNode3: TTreeNode;
    258270  I: Integer;
    259271begin
    … …  
    261273    for I := 0 to TypeRecord.Items.Count - 1 do
    262274    with TType(TypeRecord.Items[I]) do
    263     if not System then begin
    264       if TType(TypeRecord.Items[I]) is TTypeRecord then begin
    265         NewNode2 := TreeView.Items.AddChild(NewNode, Name + ' = record');
    266         AddNodeTypeRecord(NewNode2, TTypeRecord(TypeRecord.Items[I]))
    267       end else if Assigned(UsedType) then
    268         NewNode2 := TreeView.Items.AddChild(NewNode, Name + ' = ' + UsedType.Name)
    269       else NewNode2 := TreeView.Items.AddChild(NewNode, Name);
    270     end;
     275    if not System then
     276      AddNodeType(Node, TType(TypeRecord.Items[I]));
    271277  end;
    272278end;

  • branches/DelphiToC/UCompiler.pas

    r52 r53  
    9292        with TType(Types[Types.Add(TType.Create)]) do begin
    9393          Name := 'Void';
     94          System := True;
    9495          Size := 0;
    9596          UsedType := nil;
    … …  
    9798        with TType(Types[Types.Add(TType.Create)]) do begin
    9899          Name := 'Byte';
     100          System := True;
    99101          Size := 1;
    100102          UsedType := nil;

  • branches/DelphiToC/USourceCode.pas

    r51 r53  
    169169
    170170  TTypeArray = class(TType)
    171     //Range: TTypeRange;
     171    IndexType: TType;
    172172    ItemType: TType;
    173173  end;
    … …  
    180180
    181181  TConstant = class
     182    System: Boolean;
    182183    Name: string;
    183184    ValueType: TType;
Note: See TracChangeset for help on using the changeset viewer.