Changeset 20 for branches/DelphiToC


Ignore:
Timestamp:
Sep 8, 2009, 2:01:55 PM (15 years ago)
Author:
george
Message:
  • Přidáno: Analýza páru dalších programových konstrukcí.
  • Přidáno: Pár jednoduchých testovacích příkladů pro překladač.
Location:
branches/DelphiToC
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • branches/DelphiToC/Example.pas

    r19 r20  
    11program Test;
    22
    3 procedure Pokus;
     3procedure Pokus(A: Byte);
    44begin
    55end;
    66
    77const
    8   Verze: Byte = 10;
     8  Verze: Byte = 11;
    99var
    10   a: Bpyte;
     10  a: Byte;
    1111  B: Byte;
    1212  sS: Byte;
    1313begin
    1414  A := 1;
     15  While A < 1 do A := A + 1;
    1516end.

  • branches/DelphiToC/UAssemblerSource.pas

    r14 r20  
    2828    procedure AddInstruction(LabelName, Instruction, Operand1,
    2929      Operand2: string);
    30     procedure GenerateCommonBlock(CommonBlock: TCommonBlock; LabelPrefix: string);
     30//    procedure GenerateCommonBlock(CommonBlock: TCommonBlock; LabelPrefix: string);
    3131    procedure GenerateExpression(Expression: TExpression; LabelPrefix: string);
    3232    procedure GenerateProgram(ProgramBlock: TProgram);
    … …  
    114114end;
    115115
    116 procedure TAssemblerProducer.GenerateCommonBlock(CommonBlock: TCommonBlock; LabelPrefix: string);
    117 var
    118   I: Integer;
    119   LabelName: string;
    120 begin
    121   with CommonBlock do
    122   for I := 0 to Operations.Count - 1 do
    123   with TOperation(Operations[I]) do begin
    124     if Referenced then LabelName := Name + '_L' + IntToStr(I)
    125       else LabelName := '';
    126     case Instruction of
    127       inJump: begin
    128         AddInstruction(LabelName, 'JMP', Name + '_L' + IntToStr(GotoAddress), '');
     116(*
     117  procedure TAssemblerProducer.GenerateCommonBlock(CommonBlock: TCommonBlock; LabelPrefix: string);
     118  var
     119    I: Integer;
     120    LabelName: string;
     121  begin
     122    with CommonBlock do
     123    for I := 0 to Operations.Count - 1 do
     124    with TOperation(Operations[I]) do begin
     125      if Referenced then LabelName := Name + '_L' + IntToStr(I)
     126        else LabelName := '';
     127      case Instruction of
     128        inJump: begin
     129          AddInstruction(LabelName, 'JMP', Name + '_L' + IntToStr(GotoAddress), '');
     130        end;
     131        inConditionalJump: begin
     132          GenerateExpression(ExpressionTree, LabelPrefix + '_L' + IntToStr(GotoAddress));
     133          AddInstruction(LabelName, 'BRCS', Name + '_L' + IntToStr(GotoAddress), '');
     134        end;
     135        inExpressionEvaluation: begin
     136          if LabelName <> '' then AddInstruction(LabelName, '', '', '');
     137          GenerateExpression(ExpressionTree, Name + '_L' + IntToStr(GotoAddress));
     138        end;
     139        inReturn:
     140          AddInstruction(LabelName, 'RET', '', '');
    129141      end;
    130       inConditionalJump: begin
    131         GenerateExpression(ExpressionTree, LabelPrefix + '_L' + IntToStr(GotoAddress));
    132         AddInstruction(LabelName, 'BRCS', Name + '_L' + IntToStr(GotoAddress), '');
    133       end;
    134       inExpressionEvaluation: begin
    135         if LabelName <> '' then AddInstruction(LabelName, '', '', '');
    136         GenerateExpression(ExpressionTree, Name + '_L' + IntToStr(GotoAddress));
    137       end;
    138       inReturn:
    139         AddInstruction(LabelName, 'RET', '', '');
    140142    end;
    141143  end;
    142 end;
     144*)
    143145
    144146procedure TAssemblerProducer.GenerateExpression(Expression: TExpression; LabelPrefix: string);
    … …  
    180182  I: Integer;
    181183begin
    182   with ProgramBlock do
    183   for I := 0 to Modules.Count - 1 do
    184     GenerateCommonBlock(TModule(Modules[I]), '');
     184//  with ProgramBlock do
     185//  for I := 0 to Modules.Count - 1 do
     186//    GenerateCommonBlock(TModule(Modules[I]), '');
    185187end;
    186188

  • branches/DelphiToC/UCSource.pas

    r19 r20  
    3737begin
    3838  inherited;
     39  TextSource.Clear;
    3940  GenerateProgram(ProgramCode);
    4041end;

  • branches/DelphiToC/UMainForm.pas

    r19 r20  
    6565  NewNode: TTreeNode;
    6666  NewNode2: TTreeNode;
     67  NewNode3: TTreeNode;
    6768  ModuleNode: TTreeNode;
    6869  I: Integer;
     70  II: Integer;
    6971  M: Integer;
    7072begin
    … …  
    8284        NewNode := AddChild(ModuleNode, 'Funkce');
    8385        for I := 0 to Methods.Count - 1 do
    84         with TFunction(Methods[I]) do
     86        with TFunction(Methods[I]) do begin
    8587          NewNode2 := AddChild(NewNode, Name);
     88          with NewNode2 do begin
     89            NewNode3 := AddChild(NewNode2, 'Parametery');
     90            for II := 0 to Parameters.Count - 1 do
     91              AddChild(NewNode3, TParameter(Parameters[II]).Name + ':' + TParameter(Parameters[II]).ValueType.Name);
     92          end;
     93        end;
    8694        NewNode := AddChild(ModuleNode, 'Promìnné');
    8795        for I := 0 to Variables.Count - 1 do
    8896        with TVariable(Variables[I]) do
    89           NewNode2 := AddChild(NewNode, Name);
     97          NewNode2 := AddChild(NewNode, Name + ':' + ValueType.Name);
    9098        NewNode := AddChild(ModuleNode, 'Konstanty');
    9199        for I := 0 to Constants.Count - 1 do
    92100        with TConstant(Constants[I]) do
    93           NewNode2 := AddChild(NewNode, Name);
     101          NewNode2 := AddChild(NewNode, Name + ':' + ValueType.Name + '=' + Value);
    94102        NewNode := AddChild(ModuleNode, 'Program');
     103        for I := 0 to Code.Commands.Count - 1 do begin
     104          if TObject(Code.Commands[I]) is TBeginEnd then begin
     105            NewNode2 := AddChild(NewNode, 'Begin-End');
     106
     107          end else
     108          if TObject(Code.Commands[I]) is TWhileDo then begin
     109            NewNode2 := AddChild(NewNode, 'While-Do');
     110          end else
     111          if TObject(Code.Commands[I]) is TAssignment then begin
     112            NewNode2 := AddChild(NewNode, TAssignment(Code.Commands[I]).Target.Name + ' := exp');
     113
     114          end;
     115        end;
     116
    95117      end;
    96118    TopItem.Expand(True);

  • branches/DelphiToC/UPascalParser.pas

    r19 r20  
    88
    99type
     10  TPascalParser = class;
     11
    1012  TOnErrorMessage = procedure (Text: string) of object;
     13
     14  TParserCommand = class(TCommand)
     15    procedure Parse(Parser: TPascalParser);
     16  end;
     17
     18  TParserWhileDo = class(TWhileDo)
     19    procedure Parse(Parser: TPascalParser);
     20  end;
     21
     22  TParserExpression = class(TExpression)
     23    procedure Parse(Parser: TPascalParser);
     24  end;
     25
     26
    1127
    1228  TPascalParser = class
    … …  
    3248    procedure ParseModuleProgram(Module: TModule);
    3349    procedure ParseFunction(FunctionList: TFunctionList);
     50    procedure ParseFunctionParameterList(ParameterList: TParameterList);
    3451    procedure ParseVariableList(VariableList: TVariableList);
    3552    procedure ParseVariable(Variable: TVariable);
    … …  
    4057    procedure ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
    4158    function ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
    42     procedure ParseCommonBlockProgramCode(CommonBlock: TCommonBlock);
    43     procedure ParseCommonBlockOperation(CommonBlock: TCommonBlock);
     59    function ParseCommand(CommonBlock: TCommonBlock): TCommand;
     60    procedure ParseBeginEnd(CommonBlock: TCommonBlock; Command: TBeginEnd);
     61    procedure ParseIfThenElse(CommonBlock: TCommonBlock; Command: TIfThenElse);
     62    procedure ParseWhileDo(CommonBlock: TCommonBlock; Command: TWhileDo);
    4463    procedure Log(Text: string);
    4564    property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
    … …  
    206225
    207226procedure TPascalParser.ParseFunction(FunctionList: TFunctionList);
    208 begin
     227var
     228  Identifiers: TStringList;
     229  NewValueType: TType;
     230  TypeName: string;
     231  VariableName: string;
     232  Variable: TParameter;
     233  I: Integer;
     234begin
     235  Identifiers := TStringList.Create;
    209236  with FunctionList do begin
    210237    with TFunction(Items[Add(TFunction.Create)]) do begin
     238      Parent := FunctionList.Parent;
    211239      Expect('procedure');
    212240      Name := ReadCode;
    213       Expect(';');
    214       ParseCommonBlockDefinitions(Items[Count - 1]);
    215     end;
     241      if NextCode = '(' then begin
     242        Expect('(');
     243        while NextCode <> ')' do begin
     244//    while IsIdentificator(NextCode) do begin
     245          with TParameterList(Parameters) do begin
     246            VariableName := ReadCode;
     247            Variable := Search(VariableName);
     248            if not Assigned(Variable) then begin
     249              Identifiers.Add(VariableName);
     250              while NextCode = ',' do begin
     251                Expect(',');
     252                Identifiers.Add(ReadCode);
     253              end;
     254            end else ErrorMessage('Pøedefinování existující promìnné.');
     255            Expect(':');
     256            TypeName := ReadCode;
     257            NewValueType := Parent.Types.Search(TypeName);
     258            if not Assigned(NewValueType) then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
     259              else for I := 0 to Identifiers.Count - 1 do
     260                with TParameter(Items[Add(TParameter.Create)]) do begin
     261                  Name := Identifiers[I];
     262                  ValueType := NewValueType;
     263                end;
     264          end;
     265        end;
     266        Expect(')');
     267      end;
     268    end;
     269    Expect(';');
     270    ParseCommonBlockDefinitions(TFunction(Items[Count - 1]));
     271  end;
     272  Identifiers.Destroy;
     273end;
     274
     275procedure TPascalParser.ParseFunctionParameterList(
     276  ParameterList: TParameterList);
     277begin
     278
     279end;
     280
     281procedure TPascalParser.ParseIfThenElse(CommonBlock: TCommonBlock; Command: TIfThenElse);
     282begin
     283  Expect('if');
     284  Expect('than');
     285  if NextCode = 'else' then begin
     286    Expect('else');
    216287  end;
    217288end;
    … …  
    229300      Name := 'main';
    230301      with TType(Types[Types.Add(TType.Create)]) do begin
     302        Name := 'void';
     303        Size := 0;
     304        UsedType := nil;
     305      end;
     306      with TType(Types[Types.Add(TType.Create)]) do begin
    231307        Name := 'byte';
    232308        Size := 1;
    233309        UsedType := nil;
     310      end;
     311      with TFunction(Methods[Methods.Add(TFunction.Create)]) do begin
     312        Name := 'exit';
     313        ResultType := TModule(Modules[0]).Types[0];
    234314      end;
    235315    end;
    … …  
    318398end;
    319399
     400procedure TPascalParser.ParseBeginEnd(CommonBlock: TCommonBlock; Command: TBeginEnd);
     401var
     402  NewCommand: TCommand;
     403begin
     404  with Command do begin
     405    Expect('begin');
     406    while NextCode <> 'end' do begin
     407      NewCommand := ParseCommand(CommonBlock);
     408      if Assigned(NewCommand) then Commands.Add(NewCommand);
     409      //ShowMessage(NextCode);
     410      if NextCode = ';' then ReadCode;     
     411    end;
     412    Expect('end');
     413  end;
     414end;
     415
    320416procedure TPascalParser.ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
    321417begin
    … …  
    327423      else if NextCode = 'procedure' then ParseFunction(Methods)
    328424      else begin
    329         ParseCommonBlockProgramCode(CommonBlock);
     425        ParseBeginEnd(CommonBlock, Code);
    330426        Break;
    331427      end;
    … …  
    335431end;
    336432
    337 function TPascalParser.ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
     433function TPascalParser.ParseCommand(CommonBlock: TCommonBlock): TCommand;
     434var
     435  Identifier: string;
     436  Variable: TVariable;
     437  Method: TFunction;
     438  First: TOperation;
     439  Second: TOperation;
     440  StartIndex: Integer;
     441  LoopVariable: TVariable;
     442  IdentName: string;
     443begin
     444  if NextCode = 'begin' then begin
     445    Result := TBeginEnd.Create;
     446    ParseBeginEnd(CommonBlock, TBeginEnd(Result));
     447  end else
     448  if NextCode = 'if' then begin
     449    Result :=  TIfThenElse.Create;
     450    ParseIfThenElse(CommonBlock, TIfThenElse(Result));
     451  end else
     452  if NextCode = 'while' then begin
     453    Result := TWhileDo.Create;
     454    ParseWhileDo(CommonBlock, TWhileDo(Result));
     455  end else
     456  if IsIdentificator(NextCode) then begin
     457    if Assigned(CommonBlock.Variables.Search(NextCode)) then begin
     458      Result := TAssignment.Create;
     459      IdentName := ReadCode;
     460      TAssignment(Result).Target := CommonBlock.Variables.Search(IdentName);
     461      Expect(':=');
     462      TAssignment(Result).Source := ParseCommonBlockExpression(CommonBlock);
     463    end else
     464    if Assigned(CommonBlock.Methods.Search(NextCode)) then begin
     465      Result := TMethodCall.Create;
     466//      ParseMetVariable(TMethodCall(Result).Target);
     467    end;
     468  end;
     469
     470(*    begin
     471      Expect('if');
     472      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     473        Instruction := inConditionalJump;
     474        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     475        Negative := True;
     476      end;
     477      First := Operations[Operations.Count - 1];
     478      Expect('then');
     479      ParseCommonBlockOperation(CommonBlock);
     480      if NextCode = 'else' then begin
     481        with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     482          Instruction := inJump;
     483        end;
     484        Second := Operations[Operations.Count - 1];
     485        First.GotoAddress := Operations.Count;
     486        Expect('else');
     487        ParseCommonBlockOperation(CommonBlock);
     488        Second.GotoAddress := Operations.Count;
     489      end else First.GotoAddress := Operations.Count;
     490    end
     491    else if NextCode = 'repeat' then begin
     492      Expect('repeat');
     493      StartIndex := Operations.Count;
     494      ParseCommonBlockOperation(CommonBlock);
     495      Expect('until');
     496      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     497        Instruction := inConditionalJump;
     498        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     499        GotoAddress := StartIndex;
     500      end;
     501    end
     502    else if NextCode = 'while' then begin
     503      Expect('while');
     504      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     505        Instruction := inConditionalJump;
     506        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     507      end;
     508      First := Operations[Operations.Count - 1];
     509      StartIndex := Operations.Count - 1;
     510      Expect('do');
     511      ParseCommonBlockOperation(CommonBlock);
     512      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     513        Instruction := inJump;
     514        GotoAddress := StartIndex;
     515      end;
     516      First.GotoAddress := Operations.Count;
     517    end
     518    else if NextCode = 'for' then begin
     519      Expect('for');
     520      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     521        Instruction := inExpressionEvaluation;
     522        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     523        if (ExpressionTree.NodeType <> ntOperator) and
     524          (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
     525        if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
     526          ErrorMessage('Index in FOR loop have to be variable');
     527        LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
     528      end;
     529      Expect('to');
     530      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     531        Instruction := inExpressionEvaluation;
     532        ExpressionTree := TExpression.Create;
     533        with ExpressionTree do begin
     534          NodeType := ntOperator;
     535          OperatorName := '=';
     536          SubItems[0] := TExpression.Create;
     537          with TExpression(SubItems[0]) do begin
     538            NodeType := ntVariable;
     539            Variable := LoopVaraible;
     540          end;
     541          SubItems[1] := ParseCommonBlockExpression(CommonBlock);
     542        end;
     543        Negative := True;
     544      end;
     545      First := Operations[Operations.Count - 1];
     546      StartIndex := Operations.Count - 1;
     547      Expect('do');
     548      ParseCommonBlockOperation(CommonBlock);
     549      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     550        Instruction := inExpressionEvaluation;
     551        ExpressionTree := TExpression.Create;
     552        with ExpressionTree do begin
     553          NodeType := ntOperator;
     554          OperatorName := ':=';
     555          SubItems[0] := TExpression.Create;
     556          with TExpression(SubItems[0]) do begin
     557            NodeType := ntVariable;
     558            Variable := LoopVaraible;
     559          end;
     560          SubItems[1] := TExpression.Create;
     561          with TExpression(SubItems[1]) do begin
     562            NodeType := ntOperator;
     563            OperatorName := '+';
     564            SubItems[0] := TExpression.Create;
     565            with TExpression(SubItems[0]) do begin
     566              NodeType := ntVariable;
     567              Variable := LoopVaraible;
     568            end;
     569            SubItems[1] := TExpression.Create;
     570            with TExpression(SubItems[1]) do begin
     571              NodeType := ntConstant;
     572              //SetLength(Value, 1);
     573              //Value[0] := 1;
     574              Value := 1;
     575            end;
     576          end;
     577        end;
     578      end;
     579      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     580        Instruction := inJump;
     581        GotoAddress := StartIndex;
     582      end;
     583      First.GotoAddress := Operations.Count;
     584    end
     585    else begin
     586      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     587        Instruction := inExpressionEvaluation;
     588        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     589      end;
     590    end;
     591  *)
     592end;
     593
     594procedure TPascalParser.ParseTypeList(TypeList: TTypeList);
     595begin
     596  with TypeList do begin
     597    Expect('type');
     598    while IsIdentificator(NextCode) do
     599      with TType(Items[Add(TType.Create)]) do begin
     600        Parent := TypeList;
     601        ParseType(TType(Items[Count - 1]));
     602      end;
     603  end;
     604end;
     605
     606procedure TPascalParser.ParseVariableList(VariableList: TVariableList);
     607var
     608  Identifiers: TStringList;
     609  NewValueType: TType;
     610  TypeName: string;
     611  VariableName: string;
     612  Variable: TVariable;
     613  I: Integer;
     614begin
     615  Identifiers := TStringList.Create;
     616  with VariableList do begin
     617    Expect('var');
     618    while IsIdentificator(NextCode) do begin
     619      VariableName := ReadCode;
     620      Variable := Search(VariableName);
     621      if not Assigned(Variable) then begin
     622        Identifiers.Add(VariableName);
     623        while NextCode = ',' do begin
     624          Expect(',');
     625          Identifiers.Add(ReadCode);
     626        end;
     627      end else ErrorMessage('Pøedefinování existující promìnné.');
     628      Expect(':');
     629      TypeName := ReadCode;
     630      NewValueType := Parent.Types.Search(TypeName);
     631      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
     632        else for I := 0 to Identifiers.Count - 1 do
     633          with TVariable(Items[Add(TVariable.Create)]) do begin
     634            Name := Identifiers[I];
     635            ValueType := NewValueType;
     636          end;
     637      Expect(';');
     638    end;
     639  end;
     640  Identifiers.Destroy;
     641end;
     642
     643procedure TPascalParser.ParseWhileDo(CommonBlock: TCommonBlock; Command: TWhileDo);
     644begin
     645end;
     646
     647procedure TPascalParser.ParseVariable(Variable: TVariable);
     648begin
     649  with Variable do begin
     650    Name := NextCode;
     651    Expect(':=');
     652
     653  end;
     654end;
     655
     656procedure TPascalParser.ParseType(AType: TType);
     657begin
     658  with AType do begin
     659    Name := NextCode;
     660    Expect('=');
     661    UsedType := Parent.Search(NextCode);
     662  end;
     663end;
     664
     665{ TParserWhileDo }
     666
     667procedure TParserWhileDo.Parse(Parser: TPascalParser);
     668begin
     669  with Parser do begin
     670    Expect('while');
     671    TParserExpression(Condition).Parse(Parser);
     672    Expect('do');
     673    TParserCommand(Command).Parse(Parser);
     674  end;
     675end;
     676
     677{ TExpression }
     678
     679procedure TParserExpression.Parse(Parser: TPascalParser);
    338680var
    339681  Identifier: string;
    … …  
    455797end;
    456798
    457 procedure TPascalParser.ParseCommonBlockOperation(CommonBlock: TCommonBlock);
    458 var
    459   Identifier: string;
    460   Variable: TVariable;
    461   Method: TFunction;
    462   First: TOperation;
    463   Second: TOperation;
    464   StartIndex: Integer;
    465   LoopVaraible: TVariable;
    466 begin
    467   with CommonBlock do begin
    468     if NextCode = 'begin' then ParseCommonBlockProgramCode(CommonBlock)
    469     else if NextCode = 'if' then begin
    470       Expect('if');
    471       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    472         Instruction := inConditionalJump;
    473         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    474         Negative := True;
    475       end;
    476       First := Operations[Operations.Count - 1];
    477       Expect('then');
    478       ParseCommonBlockOperation(CommonBlock);
    479       if NextCode = 'else' then begin
    480         with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    481           Instruction := inJump;
    482         end;
    483         Second := Operations[Operations.Count - 1];
    484         First.GotoAddress := Operations.Count;
    485         Expect('else');
    486         ParseCommonBlockOperation(CommonBlock);
    487         Second.GotoAddress := Operations.Count;
    488       end else First.GotoAddress := Operations.Count;
    489     end
    490     else if NextCode = 'repeat' then begin
    491       Expect('repeat');
    492       StartIndex := Operations.Count;
    493       ParseCommonBlockOperation(CommonBlock);
    494       Expect('until');
    495       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    496         Instruction := inConditionalJump;
    497         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    498         GotoAddress := StartIndex;
    499       end;
    500     end
    501     else if NextCode = 'while' then begin
    502       Expect('while');
    503       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    504         Instruction := inConditionalJump;
    505         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    506       end;
    507       First := Operations[Operations.Count - 1];
    508       StartIndex := Operations.Count - 1;
    509       Expect('do');
    510       ParseCommonBlockOperation(CommonBlock);
    511       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    512         Instruction := inJump;
    513         GotoAddress := StartIndex;
    514       end;
    515       First.GotoAddress := Operations.Count;
    516     end
    517     else if NextCode = 'for' then begin
    518       Expect('for');
    519       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    520         Instruction := inExpressionEvaluation;
    521         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    522         if (ExpressionTree.NodeType <> ntOperator) and
    523           (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
    524         if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
    525           ErrorMessage('Index in FOR loop have to be variable');
    526         LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
    527       end;
    528       Expect('to');
    529       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    530         Instruction := inExpressionEvaluation;
    531         ExpressionTree := TExpression.Create;
    532         with ExpressionTree do begin
    533           NodeType := ntOperator;
    534           OperatorName := '=';
    535           SubItems[0] := TExpression.Create;
    536           with TExpression(SubItems[0]) do begin
    537             NodeType := ntVariable;
    538             Variable := LoopVaraible;
    539           end;
    540           SubItems[1] := ParseCommonBlockExpression(CommonBlock);
    541         end;
    542         Negative := True;
    543       end;
    544       First := Operations[Operations.Count - 1];
    545       StartIndex := Operations.Count - 1;
    546       Expect('do');
    547       ParseCommonBlockOperation(CommonBlock);
    548       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    549         Instruction := inExpressionEvaluation;
    550         ExpressionTree := TExpression.Create;
    551         with ExpressionTree do begin
    552           NodeType := ntOperator;
    553           OperatorName := ':=';
    554           SubItems[0] := TExpression.Create;
    555           with TExpression(SubItems[0]) do begin
    556             NodeType := ntVariable;
    557             Variable := LoopVaraible;
    558           end;
    559           SubItems[1] := TExpression.Create;
    560           with TExpression(SubItems[1]) do begin
    561             NodeType := ntOperator;
    562             OperatorName := '+';
    563             SubItems[0] := TExpression.Create;
    564             with TExpression(SubItems[0]) do begin
    565               NodeType := ntVariable;
    566               Variable := LoopVaraible;
    567             end;
    568             SubItems[1] := TExpression.Create;
    569             with TExpression(SubItems[1]) do begin
    570               NodeType := ntConstant;
    571               //SetLength(Value, 1);
    572               //Value[0] := 1;
    573               Value := 1;
    574             end;
    575           end;
    576         end;
    577       end;
    578       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    579         Instruction := inJump;
    580         GotoAddress := StartIndex;
    581       end;
    582       First.GotoAddress := Operations.Count;
    583     end
    584     else begin
    585       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    586         Instruction := inExpressionEvaluation;
    587         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    588       end;
    589     end;
    590   end;
    591 end;
    592 
    593 procedure TPascalParser.ParseCommonBlockProgramCode(CommonBlock: TCommonBlock);
    594 begin
    595   with CommonBlock do begin
    596     Expect('begin');
    597     while NextCode <> 'end' do begin
    598       ParseCommonBlockOperation(CommonBlock);
    599       Expect(';');
    600     end;
    601     Expect('end');
    602     with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    603       Instruction := inReturn;
    604     end;
    605     CheckReferences;
    606   end;
    607 end;
    608 
    609 procedure TPascalParser.ParseTypeList(TypeList: TTypeList);
    610 begin
    611   with TypeList do begin
    612     Expect('type');
    613     while IsIdentificator(NextCode) do
    614       with TType(Items[Add(TType.Create)]) do begin
    615         Parent := TypeList;
    616         ParseType(TType(Items[Count - 1]));
    617       end;
    618   end;
    619 end;
    620 
    621 procedure TPascalParser.ParseVariableList(VariableList: TVariableList);
    622 var
    623   Identifiers: TStringList;
    624   NewValueType: TType;
    625   TypeName: string;
    626   VariableName: string;
    627   Variable: TVariable;
    628   I: Integer;
    629 begin
    630   Identifiers := TStringList.Create;
    631   with VariableList do begin
    632     Expect('var');
    633     while IsIdentificator(NextCode) do begin
    634       VariableName := ReadCode;
    635       Variable := Search(VariableName);
    636       if not Assigned(Variable) then begin
    637         Identifiers.Add(VariableName);
    638         while NextCode = ',' do begin
    639           Expect(',');
    640           Identifiers.Add(ReadCode);
    641         end;
    642       end else ErrorMessage('Pøedefinování existující promìnné.');
    643       Expect(':');
    644       TypeName := ReadCode;
    645       NewValueType := Parent.Types.Search(TypeName);
    646       if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
    647         else for I := 0 to Identifiers.Count - 1 do
    648           with TVariable(Items[Add(TVariable.Create)]) do begin
    649             Name := Identifiers[I];
    650             ValueType := NewValueType;
    651           end;
    652       Expect(';');
    653     end;
    654   end;
    655   Identifiers.Destroy;
    656 end;
    657 
    658 procedure TPascalParser.ParseVariable(Variable: TVariable);
    659 begin
    660 end;
    661 
    662 procedure TPascalParser.ParseType(AType: TType);
    663 begin
    664   with AType do begin
    665     Name := NextCode;
    666     Expect('=');
    667     UsedType := Parent.Search(NextCode);
    668   end;
    669 end;
    670 
    671799end.

  • branches/DelphiToC/UPascalSource.pas

    r19 r20  
    4343
    4444  TCommand = class
    45 
     45    Parent: TObject;
     46
     47  end;
     48
     49  TAssignment = class(TCommand)
     50    Target: TVariable;
     51    Source: TExpression;
     52    constructor Create;
     53    destructor Destroy; override;
     54  end;
     55
     56  TMethodCall = class(TCommand)
     57    Method: TMethod;
    4658  end;
    4759
    4860  TBeginEnd = class(TCommand)
    4961    Commands: TCommandList;
     62    procedure Clear;
     63    constructor Create;
     64    destructor Destroy; override;
    5065  end;
    5166
    … …  
    5368    Condition: TExpression;
    5469    Command: TCommand;
    55   end;
    56 
    57   WithDo = class(TCommand)
     70    constructor Create;
     71    destructor Destroy; override;
     72  end;
     73
     74  TWithDo = class(TCommand)
    5875    Context: TContext;
    5976    Command: TCommand;
    6077  end;
    6178
    62   RepeatUntil = class(TCommand)
     79  TRepeatUntil = class(TCommand)
    6380    Block: TCommandList;
    6481    Condition: TExpression;
    6582  end;
    6683
    67   ForToDo = class(TCommand)
     84  TForToDo = class(TCommand)
    6885    ControlVariable: TVariable;
    6986    Start: TExpression;
    … …  
    7289  end;
    7390
    74   IfThenElse = class(TCommand)
     91  TIfThenElse = class(TCommand)
    7592    Condition: TExpression;
    7693    Command: TCommand;
    … …  
    83100  end;
    84101
    85   CaseOfEnd = class(TCommand)
     102  TCaseOfEnd = class(TCommand)
    86103    Expression: TExpression;
    87104    Branches: TList; // TList<TCaseOfEndBranche>
    … …  
    89106  end;
    90107
    91   TryFinally = class(TCommand)
     108  TTryFinally = class(TCommand)
    92109    Block: TCommandList;
    93110    FinallyBlock: TCommandList;
    94111  end;
    95112
    96   TryExcept = class(TCommand)
     113  TTryExcept = class(TCommand)
    97114    Block: TCommandList;
    98115    ExceptBlock: TCommandList;
    99116  end;
    100 
    101 
    102117
    103118  TCommandList = class(TList)
    … …  
    112127    Variables: TVariableList;
    113128    Methods: TFunctionList;
    114     Operations: TOperationList;
     129    Code: TBeginEnd;
    115130    constructor Create; virtual;
    116131    destructor Destroy; override;
    117     procedure CheckReferences;
     132//    procedure CheckReferences;
    118133  end;
    119134
    … …  
    166181    Parent: TCommonBlock;
    167182    function Search(Name: string): TVariable;
     183    destructor Destroy; override;
     184  end;
     185
     186  TParameter = class
     187    Name: string;
     188    ValueType: TType;
     189    DafaultValue: TValue;
     190  end;
     191
     192  TParameterList = class(TList)
     193    Parent: TFunction;
     194    function Search(Name: string): TParameter;
    168195    destructor Destroy; override;
    169196  end;
    … …  
    200227  TFunction = class(TCommonBlock)
    201228  public
    202     Parameters: TList; // TList<TParameter>
     229    Parameters: TList; // TList<TVariable>
    203230    ResultType: TType;
    204231    constructor Create; override;
    … …  
    246273begin
    247274  inherited;
    248   Parameters := TList.Create;
    249   ResultType := TType.Create;
     275  Parameters := TParameterList.Create;
     276  TParameterList(Parameters).Parent := Self;
     277  //ResultType := TType.Create;
    250278end;
    251279
    … …  
    253281begin
    254282  Parameters.Free;
    255   ResultType.Free;
     283//  ResultType.Free;
    256284  inherited;
    257285end;
    … …  
    310338  Constants.Clear;
    311339  Methods.Clear;
    312   Operations.Clear;
     340  Code.Clear;
    313341end;
    314342
    … …  
    325353end;
    326354
     355(*
    327356procedure TCommonBlock.CheckReferences;
    328357var
    … …  
    335364  end;
    336365end;
     366*)
    337367
    338368constructor TCommonBlock.Create;
    … …  
    346376  Methods := TFunctionList.Create;
    347377  Methods.Parent := Self;
    348   Operations := TOperationList.Create;
     378  Code := TBeginEnd.Create;
    349379end;
    350380
    … …  
    355385  Variables.Destroy;
    356386  Methods.Destroy;
    357   Operations.Destroy;
     387  Code.Destroy;
    358388  inherited;
    359389end;
    … …  
    483513end;
    484514
     515{ TParameterList }
     516
     517destructor TParameterList.Destroy;
     518var
     519  I: Integer;
     520begin
     521  for I := 0 to Count - 1 do
     522    TParameter(Items[I]).Free;
     523  inherited;
     524end;
     525
     526function TParameterList.Search(Name: string): TParameter;
     527var
     528  I: Integer;
     529begin
     530  I := 0;
     531  while (I < Count) and (TParameter(Items[I]).Name <> Name) do Inc(I);
     532  if I < Count then Result := Items[I] else Result := nil;
     533end;
     534
     535{ TBeginEnd }
     536
     537procedure TBeginEnd.Clear;
     538begin
     539
     540end;
     541
     542constructor TBeginEnd.Create;
     543begin
     544  Commands := TCommandList.Create;
     545end;
     546
     547destructor TBeginEnd.Destroy;
     548begin
     549  Commands.Free;
     550  inherited;
     551end;
     552
     553{ TAssignment }
     554
     555constructor TAssignment.Create;
     556begin
     557//  Source := TExpression.Create;
     558end;
     559
     560destructor TAssignment.Destroy;
     561begin
     562  Source.Free;
     563  inherited;
     564end;
     565
     566{ TWhileDo }
     567
     568constructor TWhileDo.Create;
     569begin
     570  Condition := TExpression.Create;
     571  Command := TCommand.Create;
     572end;
     573
     574destructor TWhileDo.Destroy;
     575begin
     576  Condition.Free;
     577  Command.Free;
     578  inherited;
     579end;
     580
    485581end.
    486582
Note: See TracChangeset for help on using the changeset viewer.