Ignore:
Timestamp:
Apr 9, 2009, 9:53:40 AM (16 years ago)
Author:
george
Message:
  • Upraveno: Rozdělení původního kódu do více tříd.
Location:
branches/DelphiToC
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/DelphiToC

    • Property svn:ignore set to
      *.dsk
      *.exe
      *.res
      *.~dsk
      *.dcu

  • branches/DelphiToC/UPascalSource.pas

    r12 r13  
    1515    inReturn);
    1616
    17   TNodeType = (ntNone, ntVariable, nTFunction, ntConstant, ntOperator);
     17  TNodeType = (ntNone, ntVariable, ntFunction, ntConstant, ntOperator);
    1818
    1919  TValue = array of Byte;
    2020
    21   TCompiler = class;
    2221  TCommonBlock = class;
    2322  TTypeList = class;
    … …  
    4241    Methods: TFunctionList;
    4342    Operations: TOperationList;
    44     procedure AllocateMemory;
    4543    constructor Create; virtual;
    4644    destructor Destroy; override;
    47     procedure ParseDefinitions(Compiler: TCompiler);
    48     function ParseExpression(Compiler: TCompiler): TExpression;
    49     procedure ParseProgramCode(Compiler: TCompiler);
    50     procedure ParseOperation(Compiler: TCompiler);
    51     procedure GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
    5245    procedure CheckReferences;
    5346  end;
    … …  
    5851    Size: Integer;
    5952    UsedType: TType;
    60     procedure Parse(Compiler: TCompiler);
    6153  end;
    6254
    6355  TTypeList = class(TList)
    6456    Parent: TCommonBlock;
    65     procedure Parse(Compiler: TCompiler);
    6657    function Search(Name: string): TType;
    6758  end;
    … …  
    7162    ValueType: TType;
    7263    Value: TValue;
    73     procedure Parse(Compiler: TCompiler);
    7464  end;
    7565
    … …  
    7767    Parent: TCommonBlock;
    7868    function Search(Name: string): TConstant;
    79     procedure Parse(Compiler: TCompiler);
    8069  end;
    8170
    … …  
    8473    ValueType: TType;
    8574    Value: TValue;
    86     procedure Parse(Compiler: TCompiler);
    8775  end;
    8876
    8977  TVariableList = class(TList)
    9078    Parent: TCommonBlock;
    91     procedure Parse(Compiler: TCompiler);
    9279    function Search(Name: string): TVariable;
    9380  end;
    … …  
    10390    constructor Create;
    10491    destructor Destroy; override;
    105     procedure GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
    10692  end;
    10793
    … …  
    11298    Negative: Boolean;
    11399    Referenced: Boolean;
     100    destructor Destroy; override;
    114101  end;
    115102
    116103  TOperationList = class(TList)
    117 
     104    destructor Destroy; override;
    118105  end;
    119106
    120107  TFunction = class(TCommonBlock)
     108  public
    121109    Parameters: TList; // TList<TParameter>
    122110    ResultType: TType;
    123111    constructor Create; override;
    124112    destructor Destroy; override;
    125     procedure Parse(Compiler: TCompiler);
    126113  end;
    127114
    128115  TFunctionList = class(TList)
    129116    Parent: TCommonBlock;
    130     procedure Parse(Compiler: TCompiler);
    131117    function Search(Name: string): TFunction;
    132118  end;
    133119
    134120  TModule = class(TCommonBlock)
     121  public
    135122    ModuleType: TModuleType;
    136123    UsedModules: TList; // TList<TModule>
    137124    constructor Create; override;
    138     destructor Destroy; override;
    139     procedure Parse(Compiler: TCompiler);
    140   private
    141     procedure ParseUnit(Compiler: TCompiler);
    142     procedure ParseProgram(Compiler: TCompiler);
    143125    procedure Clear;
     126    destructor Destroy; override;
    144127  end;
    145128
    … …  
    149132    constructor Create;
    150133    destructor Destroy; override;
    151     procedure Parse(Compiler: TCompiler);
    152     procedure AllocateMemory;
    153     procedure GenerateAssembler(Compiler: TCompiler);
    154   end;
    155 
    156   TAssemblerLine = class
    157     LabelName: string;
    158     Instruction: string;
    159     Operand1: string;
    160     Operand2: string;
    161     SourceCode: string;
    162     function AsString: string;
    163   end;
    164 
    165   TOnErrorMessage = procedure (Text: string) of object;
    166 
    167   TCompiler = class
    168   private
    169     SourceCode: TStringList;
    170     CodePosition: Integer;
    171     ProgramCode: TProgram;
    172     FOnErrorMessage: TOnErrorMessage;
    173     procedure ErrorMessage(Text: string);
    174     function IsAlphanumeric(Character: Char): Boolean;
    175     function NextCode(Shift: Boolean = False): string;
    176     function ReadCode: string;
    177     procedure Expect(Code: string);
    178     function IsWhiteSpace(Character: Char): Boolean;
    179     function IsAlphabetic(Character: Char): Boolean;
    180     function IsIdentificator(Text: string): Boolean;
    181     function IsKeyword(Text: string): Boolean;
    182     function IsOperator(Text: string): Boolean;
    183     procedure GenerateAssemblyCode;
    184     procedure AddInstruction(LabelName, Instruction, Operand1, Operand2: string);
    185   public
    186     AssemblyCode: TList; // TList<TAssemblerLine>
    187     constructor Create;
    188     procedure Compile(SourceCode: TStrings);
    189     destructor Destroy; override;
    190     property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
    191134  end;
    192135
    … …  
    204147implementation
    205148
    206 { TCompiler }
    207 
    208 procedure TCompiler.AddInstruction(LabelName, Instruction, Operand1,
    209   Operand2: string);
    210 var
    211   NewLine: TAssemblerLine;
    212 begin
    213   NewLine := TAssemblerLine.Create;
    214   AssemblyCode.Add(NewLine);
    215   NewLine.LabelName := LabelName;
    216   NewLine.Instruction := Instruction;
    217   NewLine.Operand1 := Operand1;
    218   NewLine.Operand2 := Operand2;
    219 end;
    220 
    221 procedure TCompiler.Compile(SourceCode: TStrings);
    222 begin
    223   Self.SourceCode.Assign(SourceCode);
    224   CodePosition := 1;
    225   ProgramCode.Parse(Self);
    226   ProgramCode.AllocateMemory;
    227   AssemblyCode.Clear;
    228   GenerateAssemblyCode;
    229 end;
    230 
    231 constructor TCompiler.Create;
    232 begin
    233   SourceCode := TStringList.Create;
    234   AssemblyCode := TList.Create;
    235   ProgramCode := TProgram.Create;
    236 end;
    237 
    238 destructor TCompiler.Destroy;
    239 begin
    240   ProgramCode.Free;
    241   AssemblyCode.Free;
    242   SourceCode.Free;
    243 end;
    244 
    245 procedure TCompiler.ErrorMessage(Text: string);
    246 begin
    247   if Assigned(FOnErrorMessage) then FOnErrorMessage(Text); 
    248 end;
    249 
    250 procedure TCompiler.Expect(Code: string);
    251 begin
    252   if NextCode <> Code then begin
    253     ErrorMessage('Expected ' + Code + ' but ' + NextCode + ' found.');
    254   end;
    255   ReadCode;
    256 end;
    257 
    258 procedure TCompiler.GenerateAssemblyCode;
    259 begin
    260   ProgramCode.GenerateAssembler(Self);
    261 end;
    262 
    263 function TCompiler.IsAlphabetic(Character: Char): Boolean;
    264 begin
    265   Result := (Character in ['a'..'z']) or (Character in ['A'..'Z']);
    266 end;
    267 
    268 function TCompiler.IsAlphanumeric(Character: Char): Boolean;
    269 begin
    270   Result := IsAlphabetic(Character) or (Character in ['0'..'9']);
    271 end;
    272 
    273 function TCompiler.IsKeyword(Text: string): Boolean;
    274 var
    275   I: Integer;
    276 begin
    277   Result := False;
    278   for I := 0 to High(Keywords) do
    279     if Keywords[I] = Text then
    280       Result := True;
    281 end;
    282 
    283 function TCompiler.IsOperator(Text: string): Boolean;
    284 var
    285   I: Integer;
    286 begin
    287   Result := False;
    288   for I := 0 to High(Operators) do
    289     if Operators[I] = Text then
    290       Result := True;
    291 end;
    292 
    293 function TCompiler.IsIdentificator(Text: string): Boolean;
    294 var
    295   I: Integer;
    296 begin
    297   Result := True;
    298   if Length(Text) = 0 then Result := False;
    299   if IsKeyWord(Text) then Result := False;
    300   if Length(Text) > 0 then
    301     if not (Text[1] in ['a'..'z', 'A'..'Z', '%', '_']) then
    302       Result := False;
    303   for I := 2 to Length(Text) do
    304     if not (Text[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) then
    305       Result := False;
    306 end;
    307 
    308 function TCompiler.IsWhiteSpace(Character: Char): Boolean;
    309 begin
    310   Result := (Character = ' ') or (Character = #13) or (Character = #10);
    311 end;
    312 
    313 function TCompiler.NextCode(Shift: Boolean = False): string;
    314 var
    315   I: Integer;
    316 //  II: Integer;
    317   J: Integer;
    318 const
    319   SpecChar: set of char = [';', '.', ',', ':', '(', ')', '[', ']', '+', '-', '/', '*',
    320     '^', '=', '<' , '>' , '@'];
    321   DoubleSpecChar : array[1..7] of string = (':=', '..', '<=', '>=', '<>', '+=', '-=');
    322 begin
    323   Result := '';
    324   J := CodePosition;
    325   I := CodePosition;
    326   with SourceCode do
    327   while Result = '' do begin
    328     while IsWhiteSpace(Text[I]) do Inc(I);
    329     J := I;
    330     if Copy(Text, J, 1) = '//' then begin
    331       while (Text[I] <> #13) and (Text[I] <> #10) do Inc(I);
    332       Result := '';
    333     end else
    334     if Copy(Text, J, 1) = '{' then begin
    335       while (Text[I] <> '}') do Inc(I);
    336       Result := '';
    337     end else
    338     if Copy(Text, J, 1) = '(*' then begin
    339       while not((Text[I] = '*') and (Text[I + 1] = ')')) do Inc(I);
    340       Result := '';
    341     end else
    342     if Text[J] = '''' then begin
    343       I := J + 1;
    344       while not ((Text[I] = '''') and (Text[I + 1] <> '''')) do Inc(I);
    345       Inc(I);
    346       Result := Copy(Text, J, I - J );
    347     end else
    348     if (Text[J] in SpecChar) then begin
    349       if (Text[J + 1] in SpecChar) then begin
    350         for I := 0 to High(DoubleSpecChar) do
    351           if Copy(Text, J, 2) = DoubleSpecChar[I] then begin
    352             Result := Copy(Text, J, 2);
    353             Inc(J, 2);
    354             Break;
    355           end;
    356         I := J;
    357       end;
    358       if Result = '' then begin
    359         Result := Text[J];
    360         Inc(I);
    361       end;
    362     end else begin
    363       while IsAlphanumeric(Text[I]) do Inc(I);
    364       Result := LowerCase(Copy(Text, J, I - J));
    365     end;
    366     J := I;
    367   end;
    368   if Shift then CodePosition := J;
    369 end;
    370 
    371 procedure TModule.ParseUnit(Compiler: TCompiler);
    372 begin
    373   with Compiler do begin
    374     Expect('unit');
    375     with TModule(ProgramCode.Modules[0]) do begin
    376       Name := ReadCode;
    377       ModuleType := mdUnit;
    378     end;
    379     Expect(';');
    380     //ParseInterface;
    381     //ParseImplementation;
    382   end;
    383 end;
    384 
    385 function TCompiler.ReadCode: string;
    386 begin
    387   Result := NextCode(True);
    388 end;
    389 
    390149{ TFunction }
    391150
    … …  
    404163end;
    405164
    406 procedure TFunction.Parse(Compiler: TCompiler);
    407 begin
    408   with Compiler do begin
    409     if NextCode = 'var' then TVariableList(Variables).Parse(Compiler)
    410     else if NextCode = 'const' then TConstantList(Constants).Parse(Compiler)
    411     else if NextCode = 'type' then TTypeList(Types).Parse(Compiler)
    412     else ProgramCode.Parse(Compiler);
    413   end;
    414 end;
    415 
    416165{ TProgram }
    417 
    418 procedure TProgram.AllocateMemory;
    419 var
    420   I: Integer;
    421 begin
    422   for I := 0 to Modules.Count - 1 do
    423     TModule(Modules[I]).AllocateMemory;
    424 end;
    425166
    426167constructor TProgram.Create;
    … …  
    431172
    432173destructor TProgram.Destroy;
    433 begin
    434 
    435 end;
    436 
    437 procedure TProgram.GenerateAssembler(Compiler: TCompiler);
    438174var
    439175  I: Integer;
    440176begin
    441177  for I := 0 to Modules.Count - 1 do
    442     TModule(Modules[I]).GenerateAssembler(Compiler, '');
    443 end;
    444 
    445 procedure TProgram.Parse(Compiler: TCompiler);
    446 var
    447   I: Integer;
    448 begin
    449   for I := 0 to Modules.Count - 1 do
    450     TModule(Modules[I]).Clear;
    451   Modules.Clear;
    452   with TModule(Modules[Modules.Add(TModule.Create)]) do begin
    453     Name := 'main';
    454     with TType(Types[Types.Add(TType.Create)]) do begin
    455       Name := 'byte';
    456       Size := 1;
    457       UsedType := nil;
    458     end;
    459   end;
    460   TModule(Modules[0]).Parse(Compiler);
     178    TModule(Modules[I]).Free;
     179  Device.Free;
    461180end;
    462181
    463182{ TConstant }
    464183
    465 procedure TConstant.Parse(Compiler: TCompiler);
    466 begin
    467 
    468 end;
    469184
    470185{ TConstantList }
    471 
    472 procedure TConstantList.Parse(Compiler: TCompiler);
    473 begin
    474 //  Compiler.Expect('const');
    475 //  while Compiler.IsIdentificator(Compiler.NextCode) do
    476 //    TConstant(Items[Add(TConstant.Create)]).Parse(Compiler);
    477 end;
    478186
    479187function TConstantList.Search(Name: string): TConstant;
    … …  
    511219  UsedModules.Destroy;
    512220  inherited;
    513 end;
    514 
    515 procedure TModule.ParseProgram(Compiler: TCompiler);
    516 var
    517   Identifier: string;
    518 begin
    519   with Compiler do begin
    520     if NextCode = 'program' then begin
    521       Expect('program');
    522       Name := ReadCode;
    523       ModuleType := mdProgram;
    524       Expect(';');
    525     end else Name := '';
    526 
    527     // Uses section
    528     if NextCode = 'uses' then begin
    529       Identifier := ReadCode;
    530       while NextCode = ',' do begin
    531         Identifier := ReadCode;
    532 
    533       end;
    534     end;
    535     ParseDefinitions(Compiler);
    536   end;
    537 end;
    538 
    539 procedure TModule.Parse(Compiler: TCompiler);
    540 begin
    541   with Compiler do begin
    542     if NextCode = 'program' then ParseProgram(Compiler)
    543     else if NextCode = 'unit' then ParseUnit(Compiler)
    544     else ParseProgram(Compiler);
    545   end;
    546 end;
    547 
    548 procedure TCommonBlock.AllocateMemory;
    549 begin
    550 //  for I := 0 to Variables - 1 do
    551    
    552221end;
    553222
    … …  
    586255end;
    587256
    588 procedure TCommonBlock.GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
    589 var
    590   I: Integer;
    591   LabelName: string;
    592 begin
    593   with Compiler do
    594   for I := 0 to Operations.Count - 1 do
    595   with TOperation(Operations[I]) do begin
    596     if Referenced then LabelName := Name + '_L' + IntToStr(I)
    597       else LabelName := '';
    598     case Instruction of
    599       inJump: begin
    600         AddInstruction(LabelName, 'JMP', Name + '_L' + IntToStr(GotoAddress), '');
    601       end;
    602       inConditionalJump: begin
    603         ExpressionTree.GenerateAssembler(Compiler, LabelPrefix + '_L' + IntToStr(GotoAddress));
    604         AddInstruction(LabelName, 'BRCS', Name + '_L' + IntToStr(GotoAddress), '');
    605       end;
    606       inExpressionEvaluation: begin
    607         if LabelName <> '' then AddInstruction(LabelName, '', '', '');
    608         ExpressionTree.GenerateAssembler(Compiler, Name + '_L' + IntToStr(GotoAddress));
    609       end;
    610       inReturn:
    611         AddInstruction(LabelName, 'RET', '', '');
    612     end;
    613   end;
    614 end;
    615 
    616 procedure TCommonBlock.ParseDefinitions(Compiler: TCompiler);
    617 begin
    618   with Compiler do begin
    619     while NextCode <> '.' do begin
    620       if NextCode = 'var' then TVariableList(Variables).Parse(Compiler)
    621       else if NextCode = 'const' then TConstantList(Constants).Parse(Compiler)
    622       else if NextCode = 'type' then TTypeList(Types).Parse(Compiler)
    623       else begin
    624         ParseProgramCode(Compiler);
    625         Break;
    626       end;
    627     end;
    628   end;
    629 end;
    630 
    631 function TCommonBlock.ParseExpression(Compiler: TCompiler): TExpression;
    632 var
    633   Identifier: string;
    634   NewVariable: TVariable;
    635   Method: TFunction;
    636   Constant: TConstant;
    637 //  Brackets: Integer;
    638   Expressions: TList; // TList<TExpression>;
    639   I: Integer;
    640   II: Integer;
    641 begin
    642   Expressions := TList.Create;
    643   Expressions.Add(TExpression.Create);
    644   with Compiler do begin
    645     while ((NextCode <> ';') and (NextCode <> ',') and (not IsKeyWord(NextCode))) and
    646       not (((NextCode = ')') or (NextCode = ']'))) do begin
    647         Identifier := ReadCode;
    648         if Identifier = '(' then begin
    649           with TExpression(Expressions[Expressions.Count - 1]) do begin
    650             SubItems[1] := ParseExpression(Compiler);
    651           end;
    652           with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    653             SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    654           end;
    655           Expect(')');
    656         end else
    657         if IsOperator(Identifier) then begin
    658           TExpression(Expressions[Expressions.Count - 1]).OperatorName := Identifier;
    659           TExpression(Expressions[Expressions.Count - 1]).NodeType := ntOperator;
    660         end else
    661         if IsIdentificator(Identifier) then begin
    662           NewVariable := Variables.Search(Identifier);
    663           if Assigned(NewVariable) then begin
    664             with TExpression(Expressions[Expressions.Count - 1]) do begin
    665               SubItems[1] := TExpression.Create;
    666               TExpression(SubItems[1]).NodeType := ntVariable;
    667               TExpression(SubItems[1]).Variable := NewVariable;
    668             end;
    669             with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    670               SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    671             end;
    672           end else begin
    673             Method := Methods.Search(Identifier);
    674             if Assigned(Method) then begin
    675               with TExpression(Expressions[Expressions.Count - 1]) do begin
    676                 SubItems[1] := TExpression.Create;
    677                 if NextCode  = '(' then               // Method with parameters
    678                 with TExpression(SubItems[1]) do begin
    679                   Expect('(');
    680                   SubItems.Add(ParseExpression(Compiler));
    681                   while NextCode = ',' do begin
    682                     Expect(',');
    683                     SubItems.Add(ParseExpression(Compiler));
    684                   end;
    685                   Expect(')');
    686                 end;
    687                 TExpression(SubItems[1]).NodeType := nTFunction;
    688                 TExpression(SubItems[1]).Method := Method;
    689               end;
    690               with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    691                 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    692               end;
    693             end else begin
    694               Constant := Constants.Search(Identifier);
    695               if Assigned(Constant) then begin
    696                 with TExpression(Expressions[Expressions.Count - 1]) do begin
    697                   SubItems[1] := TExpression.Create;
    698                   TExpression(SubItems[1]).NodeType := ntConstant;
    699                   TExpression(SubItems[1]).Value := Constant.Value;
    700                 end;
    701                 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    702                   SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    703                 end;
    704               end else begin
    705                 ErrorMessage('Neznámý identifikátor: ' + Identifier);
    706               end;
    707             end;
    708           end;
    709         end else
    710         begin
    711                 with TExpression(Expressions[Expressions.Count - 1]) do begin
    712                   SubItems[1] := TExpression.Create;
    713                   TExpression(SubItems[1]).NodeType := ntConstant;
    714 
    715                   if Identifier[1] = '''' then begin
    716                     SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
    717                     for I := 1 to Length(Identifier) do TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
    718                   end else begin
    719                     SetLength(TExpression(SubItems[1]).Value, 1);
    720                     TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
    721                   end;
    722                 end;
    723                 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    724                   SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    725                 end;
    726         end;
    727     end;
    728 
    729     // Build expression tree
    730     for II := 0 to High(Operators) do begin
    731       I := 1;
    732       while (I < Expressions.Count - 1) do begin
    733         if not TExpression(Expressions[I]).Associated and
    734           (TExpression(Expressions[I]).OperatorName = Operators[II]) then begin
    735             TExpression(Expressions[I]).Associated := True;
    736             TExpression(Expressions[I - 1]).SubItems[1] := Expressions[I];
    737             TExpression(Expressions[I + 1]).SubItems[0] := Expressions[I];
    738             Expressions.Delete(I);
    739           end else Inc(I);
    740       end;
    741     end;
    742   end;
    743   Result := TExpression(Expressions[0]).SubItems[1];
    744   TExpression(Expressions[0]).Destroy;
    745   TExpression(Expressions[1]).Destroy;
    746   Expressions.Destroy;
    747 end;
    748 
    749 procedure TCommonBlock.ParseOperation(Compiler: TCompiler);
    750 var
    751   Identifier: string;
    752   Variable: TVariable;
    753   Method: TFunction;
    754   First: TOperation;
    755   Second: TOperation;
    756   StartIndex: Integer;
    757   LoopVaraible: TVariable;
    758 begin
    759   with Compiler do begin
    760     if NextCode = 'begin' then ParseProgramCode(Compiler)
    761     else if NextCode = 'if' then begin
    762       Expect('if');
    763       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    764         Instruction := inConditionalJump;
    765         ExpressionTree := ParseExpression(Compiler);
    766         Negative := True;
    767       end;
    768       First := Operations[Operations.Count - 1];
    769       Expect('then');
    770       ParseOperation(Compiler);
    771       if NextCode = 'else' then begin
    772         with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    773           Instruction := inJump;
    774         end;
    775         Second := Operations[Operations.Count - 1];
    776         First.GotoAddress := Operations.Count;
    777         Expect('else');
    778         ParseOperation(Compiler);
    779         Second.GotoAddress := Operations.Count;
    780       end else First.GotoAddress := Operations.Count;
    781     end
    782     else if NextCode = 'repeat' then begin
    783       Expect('repeat');
    784       StartIndex := Operations.Count;
    785       ParseOperation(Compiler);
    786       Expect('until');
    787       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    788         Instruction := inConditionalJump;
    789         ExpressionTree := ParseExpression(Compiler);
    790         GotoAddress := StartIndex;
    791       end;
    792     end
    793     else if NextCode = 'while' then begin
    794       Expect('while');
    795       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    796         Instruction := inConditionalJump;
    797         ExpressionTree := ParseExpression(Compiler);
    798       end;
    799       First := Operations[Operations.Count - 1];
    800       StartIndex := Operations.Count - 1;
    801       Expect('do');
    802       ParseOperation(Compiler);
    803       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    804         Instruction := inJump;
    805         GotoAddress := StartIndex;
    806       end;
    807       First.GotoAddress := Operations.Count;
    808     end
    809     else if NextCode = 'for' then begin
    810       Expect('for');
    811       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    812         Instruction := inExpressionEvaluation;
    813         ExpressionTree := ParseExpression(Compiler);
    814         if (ExpressionTree.NodeType <> ntOperator) and
    815           (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
    816         if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
    817           ErrorMessage('Index in FOR loop have to be variable');
    818         LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
    819       end;
    820       Expect('to');
    821       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    822         Instruction := inExpressionEvaluation;
    823         ExpressionTree := TExpression.Create;
    824         with ExpressionTree do begin
    825           NodeType := ntOperator;
    826           OperatorName := '=';
    827           SubItems[0] := TExpression.Create;
    828           with TExpression(SubItems[0]) do begin
    829             NodeType := ntVariable;
    830             Variable := LoopVaraible;
    831           end;
    832           SubItems[1] := ParseExpression(Compiler);
    833         end;
    834         Negative := True;
    835       end;
    836       First := Operations[Operations.Count - 1];
    837       StartIndex := Operations.Count - 1;
    838       Expect('do');
    839       ParseOperation(Compiler);
    840       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    841         Instruction := inExpressionEvaluation;
    842         ExpressionTree := TExpression.Create;
    843         with ExpressionTree do begin
    844           NodeType := ntOperator;
    845           OperatorName := ':=';
    846           SubItems[0] := TExpression.Create;
    847           with TExpression(SubItems[0]) do begin
    848             NodeType := ntVariable;
    849             Variable := LoopVaraible;
    850           end;
    851           SubItems[1] := TExpression.Create;
    852           with TExpression(SubItems[1]) do begin
    853             NodeType := ntOperator;
    854             OperatorName := '+';
    855             SubItems[0] := TExpression.Create;
    856             with TExpression(SubItems[0]) do begin
    857               NodeType := ntVariable;
    858               Variable := LoopVaraible;
    859             end;
    860             SubItems[1] := TExpression.Create;
    861             with TExpression(SubItems[1]) do begin
    862               NodeType := ntConstant;
    863               SetLength(Value, 1);
    864               Value[0] := 1;
    865             end;
    866           end;
    867         end;
    868       end;
    869       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    870         Instruction := inJump;
    871         GotoAddress := StartIndex;
    872       end;
    873       First.GotoAddress := Operations.Count;
    874     end
    875     else begin
    876       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    877         Instruction := inExpressionEvaluation;
    878         ExpressionTree := ParseExpression(Compiler);
    879       end;
    880     end;
    881   end;
    882 end;
    883 
    884 procedure TCommonBlock.ParseProgramCode(Compiler: TCompiler);
    885 begin
    886   with Compiler do begin
    887     Expect('begin');
    888     while NextCode <> 'end' do begin
    889       ParseOperation(Compiler);
    890       Expect(';');
    891     end;
    892     Expect('end');
    893     with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    894       Instruction := inReturn;
    895     end;
    896   end;
    897   CheckReferences;
    898 end;
    899 
    900257{ TTypeList }
    901 
    902 procedure TTypeList.Parse(Compiler: TCompiler);
    903 begin
    904   with Compiler do begin
    905     Expect('type');
    906     while IsIdentificator(NextCode) do
    907       with TType(Items[Add(TType.Create)]) do begin
    908         Parent := Self;
    909         Parse(Compiler);
    910       end;
    911   end;
    912 end;
    913258
    914259function TTypeList.Search(Name: string): TType;
    … …  
    928273{ TVariableList }
    929274
    930 procedure TVariableList.Parse(Compiler: TCompiler);
    931 var
    932   Identifiers: TStringList;
    933   NewValueType: TType;
    934   TypeName: string;
    935   VariableName: string;
    936   Variable: TVariable;
    937   I: Integer;
    938 begin
    939   Identifiers := TStringList.Create;
    940   with Compiler do begin
    941     Expect('var');
    942     while IsIdentificator(NextCode) do begin
    943       VariableName := ReadCode;
    944       Variable := Search(VariableName);
    945       if not Assigned(Variable) then begin
    946         Identifiers.Add(VariableName);
    947         while NextCode = ',' do begin
    948           Expect(',');
    949           Identifiers.Add(ReadCode);
    950         end;
    951       end else ErrorMessage('Pøedefinování existující promìnné.');
    952       Expect(':');
    953       TypeName := ReadCode;
    954       NewValueType := Parent.Types.Search(TypeName);
    955       if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
    956         else for I := 0 to Identifiers.Count - 1 do
    957           with TVariable(Items[Add(TVariable.Create)]) do begin
    958             Name := Identifiers[I];
    959             ValueType := NewValueType;
    960           end;
    961       Expect(';');
    962     end;
    963   end;
    964   Identifiers.Destroy;
    965 end;
    966 
    967275function TVariableList.Search(Name: string): TVariable;
    968276var
    … …  
    981289{ TVariable }
    982290
    983 procedure TVariable.Parse(Compiler: TCompiler);
    984 begin
    985 end;
    986 
    987291{ TType }
    988292
    989 procedure TType.Parse(Compiler: TCompiler);
    990 begin
    991   with Compiler do begin
    992     Name := NextCode;
    993     Expect('=');
    994     UsedType := Parent.Search(NextCode);
    995   end;
    996 end;
    997293
    998294{ TFunctionList }
    999 
    1000 procedure TFunctionList.Parse(Compiler: TCompiler);
    1001 begin
    1002 
    1003 end;
    1004295
    1005296function TFunctionList.Search(Name: string): TFunction;
    … …  
    1031322end;
    1032323
    1033 procedure TExpression.GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
    1034 var
    1035   I: Integer;
    1036 begin
    1037   with Compiler do
    1038   case NodeType of
    1039     ntNone: ;
    1040     ntVariable: if Assigned(Variable) then AddInstruction('', 'GETVAR', Variable.Name, '');
    1041     nTFunction: AddInstruction('', 'CALL', Method.Name, '');
    1042     ntConstant: AddInstruction('', 'CONST', '', '');
    1043     ntOperator: begin
    1044       for I := 0 to SubItems.Count - 1 do
    1045         TExpression(SubItems[I]).GenerateAssembler(Compiler, LabelPrefix);
    1046       if OperatorName = '+' then AddInstruction('', 'ADD', '', '')
    1047       else if OperatorName = '-' then AddInstruction('', 'SUB', '', '')
    1048       else if OperatorName = '*' then AddInstruction('', 'MUL', '', '')
    1049       else if OperatorName = '/' then AddInstruction('', 'DIV', '', '')
    1050       else if OperatorName = 'div' then AddInstruction('', 'DIV', '', '')
    1051       else if OperatorName = 'mod' then AddInstruction('', 'MOD', '', '')
    1052       else if OperatorName = 'xor' then AddInstruction('', 'XOR', '', '')
    1053       else if OperatorName = 'or' then AddInstruction('', 'OR', '', '')
    1054       else if OperatorName = 'and' then AddInstruction('', 'AND', '', '')
    1055       else if OperatorName = 'not' then AddInstruction('', 'NEG', '', '')
    1056       else if OperatorName = ':=' then AddInstruction('', 'ST', '', '')
    1057       else if OperatorName = '>' then AddInstruction('', 'CP', '', '')
    1058       else if OperatorName = '>=' then AddInstruction('', 'CP', '', '')
    1059       else if OperatorName = '<' then AddInstruction('', 'CP', '', '')
    1060       else if OperatorName = '<=' then AddInstruction('', 'CP', '', '')
    1061       else if OperatorName = '=' then AddInstruction('', 'TST', '', '')
    1062       else if OperatorName = '<>' then AddInstruction('', 'CP', '', '');
    1063     end;
    1064   end;
    1065 end;
    1066 
    1067 { TAssemblerLine }
    1068 
    1069 function TAssemblerLine.AsString: string;
    1070 begin
    1071   if LabelName = '' then LabelName := #9 else
    1072     LabelName := LabelName + ':'#9;
    1073   if Operand2 <> '' then Operand1 := Operand1 + ', ';
    1074  
    1075   Result := LabelName + Instruction + ' ' + Operand1 + Operand2;
     324{ TOperationList }
     325
     326destructor TOperationList.Destroy;
     327var
     328  I: Integer;
     329begin
     330  for I := 0 to Count - 1 do
     331    TOperation(Items[I]).Free;
     332  inherited;
     333end;
     334
     335{ TOperation }
     336
     337destructor TOperation.Destroy;
     338begin
     339  inherited;
     340  ExpressionTree.Free;
    1076341end;
    1077342
Note: See TracChangeset for help on using the changeset viewer.