Changeset 11 for trunk


Ignore:
Timestamp:
Jun 20, 2008, 9:55:04 AM (16 years ago)
Author:
george
Message:

Přidáno: Zprovozněn základní převod zdrojového kódu do interní reprezentace.
Přidáno: Vytvořen základ pro generování kódu v assembleru.

Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/Example.pas

    r10 r11  
    33  A: Byte;
    44begin
    5   A := 10;
     5  A := 'a' + (10 + 2) * 3 xor 10 / 2;
     6  while A < 10 do A := A + 1;
    67end;
  • trunk/UMainForm.dfm

    r10 r11  
    2222    Top = 8
    2323    Width = 401
    24     Height = 593
     24    Height = 529
    2525    Font.Charset = DEFAULT_CHARSET
    2626    Font.Color = clWindowText
     
    4242  end
    4343  object Memo2: TMemo
    44     Left = 416
     44    Left = 415
    4545    Top = 8
    4646    Width = 321
    47     Height = 593
     47    Height = 529
     48    Font.Charset = DEFAULT_CHARSET
     49    Font.Color = clWindowText
     50    Font.Height = -13
     51    Font.Name = 'Lucida Console'
     52    Font.Style = []
     53    ParentFont = False
    4854    ScrollBars = ssBoth
    4955    TabOrder = 2
    5056  end
     57  object Memo3: TMemo
     58    Left = 8
     59    Top = 543
     60    Width = 728
     61    Height = 66
     62    ScrollBars = ssBoth
     63    TabOrder = 3
     64  end
    5165end
  • trunk/UMainForm.pas

    r10 r11  
    1212  TModuleType = (mdProgram, mdUnit, mdLibrary, mdPackage);
    1313
     14  TInstruction = (inJump, inConditionalJump, inExpressionEvaluation);
     15
     16  TNodeType = (ntNone, ntVariable, ntMethod, ntConstant, ntOperator);
     17
    1418  TValue = array of Byte;
    1519
    1620  TCompiler = class;
     21  TCommonBlock = class;
     22  TTypeList = class;
     23  TConstantList = class;
     24  TVariableList = class;
     25  TMethodList = class;
     26  TExpression = class;
     27  TOperationList = class;
    1728
    1829  TDevice = class
    1930    Family: string;
    2031    Memory: array[TMemoryType] of Integer;
     32  end;
     33
     34  TCommonBlock = class
     35    Name: string;
     36    Parent: TCommonBlock;
     37    Constants: TConstantList;
     38    Types: TTypeList;
     39    Variables: TVariableList;
     40    Methods: TMethodList;
     41    Operations: TOperationList;
     42    procedure AllocateMemory;
     43    constructor Create; virtual;
     44    destructor Destroy; override;
     45    procedure ParseDefinitions(Compiler: TCompiler);
     46    function ParseExpression(Compiler: TCompiler): TExpression;
     47    procedure ParseProgramCode(Compiler: TCompiler);
     48    procedure ParseOperation(Compiler: TCompiler);
     49    procedure GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
     50  end;
     51
     52  TType = class
     53    Parent: TTypeList;
     54    Name: string;
     55    Size: Integer;
     56    UsedType: TType;
     57    procedure Parse(Compiler: TCompiler);
     58  end;
     59
     60  TTypeList = class(TList)
     61    Parent: TCommonBlock;
     62    procedure Parse(Compiler: TCompiler);
     63    function Search(Name: string): TType;
     64  end;
     65
     66  TConstant = class
     67    Name: string;
     68    ValueType: TType;
     69    Value: TValue;
     70    procedure Parse(Compiler: TCompiler);
     71  end;
     72
     73  TConstantList = class(TList)
     74    Parent: TCommonBlock;
     75    function Search(Name: string): TConstant;
     76    procedure Parse(Compiler: TCompiler);
     77  end;
     78
     79  TVariable = class
     80    Name: string;
     81    ValueType: TType;
     82    Value: TValue;
     83    procedure Parse(Compiler: TCompiler);
     84  end;
     85
     86  TVariableList = class(TList)
     87    Parent: TCommonBlock;
     88    procedure Parse(Compiler: TCompiler);
     89    function Search(Name: string): TVariable;
     90  end;
     91
     92  TExpression = class
     93    NodeType: TNodeType;
     94    Variable: TVariable;
     95    Method: TMethod;
     96    Value: TValue;
     97    OperatorName: string;
     98    SubItems: TList; // TList<TExpression>
     99    Associated: Boolean;
     100    constructor Create;
     101    destructor Destroy; override;
     102    procedure GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
     103  end;
     104
     105  TOperation = class
     106    Instruction: TInstruction;
     107    ExpressionTree: TExpression;
     108    GotoAddress: Integer;
     109    Negative: Boolean;
     110  end;
     111
     112  TOperationList = class(TList)
     113
     114  end;
     115
     116  TMethod = class(TCommonBlock)
     117    Parameters: TList; // TList<TParameter>
     118    ResultType: TType;
     119    constructor Create; override;
     120    destructor Destroy; override;
     121    procedure Parse(Compiler: TCompiler);
     122  end;
     123
     124  TMethodList = class(TList)
     125    Parent: TCommonBlock;
     126    procedure Parse(Compiler: TCompiler);
     127    function Search(Name: string): TMethod;
     128  end;
     129
     130  TModule = class(TCommonBlock)
     131    ModuleType: TModuleType;
     132    UsedModules: TList; // TList<TModule>
     133    constructor Create; override;
     134    destructor Destroy; override;
     135    procedure Parse(Compiler: TCompiler);
     136  private
     137    procedure ParseUnit(Compiler: TCompiler);
     138    procedure ParseProgram(Compiler: TCompiler);
    21139  end;
    22140
     
    27145    destructor Destroy; override;
    28146    procedure Parse(Compiler: TCompiler);
    29   end;
    30 
    31   TType = class
    32     Name: string;
    33     Size: Integer;
    34   end;
    35 
    36   TTypeList = class(TList)
    37     procedure Parse(Compiler: TCompiler);
    38   end;
    39 
    40   TConstant = class
    41     Name: string;
    42     ValueType: TType;
    43     Value: TValue;
    44     procedure Parse(Compiler: TCompiler);
    45   end;
    46 
    47   TConstantList = class(TList)
    48     procedure Parse(Compiler: TCompiler);
    49   end;
    50 
    51   TVariable = class
    52     Name: string;
    53     ValueType: TType;
    54     Value: TValue;
    55   end;
    56 
    57   TVariableList = class(TList)
    58     procedure Parse(Compiler: TCompiler);
    59   end;
    60 
    61   TProgramCode = class
    62     procedure Parse(Compiler: TCompiler);
    63   end;
    64 
    65   TMethod = class
    66     Name: string;
    67     Parameters: TList; // TList<TParameter>
    68     Constants: TList; // TList<TConstant>
    69     Types: TList; // TList<TType>
    70     Variables: TList; // TList<TVariable>
    71     ResultType: TType;
    72     ProgramCode: TProgramCode;
    73     constructor Create;
    74     destructor Destroy; override;
    75     procedure Parse(Compiler: TCompiler);
    76   end;
    77 
    78   TModule = class
    79     Name: string;
    80     ModuleType: TModuleType;
    81     Constants: TList; // TList<TConstant>
    82     Types: TList; // TList<TType>
    83     Variables: TList; // TList<TVariable>
    84     constructor Create;
    85     destructor Destroy; override;
    86     procedure Parse(Compiler: TCompiler);
    87     procedure ParseDefinitions(Compiler: TCompiler);
    88   private
    89     procedure ParseUnit(Compiler: TCompiler);
    90     procedure ParseProgram(Compiler: TCompiler);
     147    procedure AllocateMemory;
     148    procedure GenerateAssembler(Compiler: TCompiler);
     149  end;
     150
     151  TAssemblerLine = class
     152    LabelName: string;
     153    Instruction: string;
     154    Operand1: string;
     155    Operand2: string;
     156    SourceCode: string;
     157    function AsString: string;
    91158  end;
    92159
     
    95162    SourceCode: TStringList;
    96163    CodePosition: Integer;
    97     AssemberCode: TStringList;
     164    AssemblyCode: TList; // TList<TAssemblerLine>
    98165    ProgramCode: TProgram;
    99166    procedure ErrorMessage(Text: string);
     
    106173    function IsIdentificator(Text: string): Boolean;
    107174    function IsKeyword(Text: string): Boolean;
     175    function IsOperator(Text: string): Boolean;
     176    procedure GenerateAssemblyCode;
     177    procedure AddInstruction(LabelName, Instruction, Operand1, Operand2: string);
    108178  public
    109179    constructor Create;
     
    116186    Button1: TButton;
    117187    Memo2: TMemo;
     188    Memo3: TMemo;
    118189    procedure FormShow(Sender: TObject);
    119190    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     
    128199
    129200const
    130   KeyWords: array[0..40] of string = ('program', 'unit', 'uses', 'begin', 'end',
     201  KeyWords: array[0..37] of string = ('program', 'unit', 'uses', 'begin', 'end',
    131202    'type', 'const', 'var', 'array', 'record', 'absolute', 'virtual', 'class',
    132203    'set', 'private', 'public', 'interface', 'implementation', 'finalization',
    133     'initialization', 'for', 'while', 'if', 'case', 'of', 'as', 'in', 'is', 'pointer',
     204    'initialization', 'for', 'while', 'if', 'case', 'of', 'pointer',
    134205    'object', 'packed', 'procedure', 'function', 'to', 'do', 'downto', 'repeat',
    135206    'until', 'then', 'asm', 'else');
     207  Operators: array[0..22] of string = ('@', 'not', '*', 'and', '/', 'shl',
     208    'shr', 'as', 'div', 'mod', 'or', 'xor', '-', '+', '=', '>', '<', '<>', '<=',
     209     '>=', 'is', 'in', ':=');
     210
    136211var
    137212  MainForm: TMainForm;
     
    142217
    143218procedure TMainForm.Button1Click(Sender: TObject);
     219var
     220  I: Integer;
    144221begin
    145222  Compiler.Compile(Memo1.Lines);
    146   Memo2.Assign(Compiler.AssemberCode);
     223  Memo2.Clear;
     224  for I := 0 to Compiler.AssemblyCode.Count - 1 do
     225    Memo2.Lines.Add(TAssemblerLine(Compiler.AssemblyCode[I]).AsString);
    147226end;
    148227
     
    163242
    164243procedure TMainForm.FormShow(Sender: TObject);
     244var
     245  I: Integer;
    165246begin
    166247  Memo1.Lines.LoadFromFile('Example.pas');
    167248  Compiler.Compile(Memo1.Lines);
     249  Memo2.Clear;
     250  for I := 0 to Compiler.AssemblyCode.Count - 1 do
     251    Memo2.Lines.Add(TAssemblerLine(Compiler.AssemblyCode[I]).AsString);
     252
    168253end;
    169254
    170255{ TCompiler }
    171256
     257procedure TCompiler.AddInstruction(LabelName, Instruction, Operand1,
     258  Operand2: string);
     259var
     260  NewLine: TAssemblerLine;
     261begin
     262  NewLine := TAssemblerLine.Create;
     263  AssemblyCode.Add(NewLine);
     264  NewLine.LabelName := LabelName;
     265  NewLine.Instruction := Instruction;
     266  NewLine.Operand1 := Operand1;
     267  NewLine.Operand2 := Operand2;
     268end;
     269
    172270procedure TCompiler.Compile(SourceCode: TStrings);
    173271begin
     272  MainForm.Memo3.Clear;
    174273  Self.SourceCode.Assign(SourceCode);
    175274  CodePosition := 1;
    176275  ProgramCode.Parse(Self);
     276  ProgramCode.AllocateMemory;
     277  GenerateAssemblyCode;
    177278end;
    178279
     
    180281begin
    181282  SourceCode := TStringList.Create;
    182   AssemberCode := TStringList.Create;
     283  AssemblyCode := TList.Create;
    183284  ProgramCode := TProgram.Create;
    184285end;
     
    187288begin
    188289  ProgramCode.Free;
    189   AssemberCode.Free;
     290  AssemblyCode.Free;
    190291  SourceCode.Free;
    191292end;
     
    193294procedure TCompiler.ErrorMessage(Text: string);
    194295begin
    195   ShowMessage(Text);
     296  //ShowMessage(Text);
     297  MainForm.Memo3.Lines.Add(Text);
    196298end;
    197299
     
    202304  end;
    203305  ReadCode;
     306end;
     307
     308procedure TCompiler.GenerateAssemblyCode;
     309begin
     310  ProgramCode.GenerateAssembler(Self);
    204311end;
    205312
     
    221328  for I := 0 to High(Keywords) do
    222329    if Keywords[I] = Text then
     330      Result := True;
     331end;
     332
     333function TCompiler.IsOperator(Text: string): Boolean;
     334var
     335  I: Integer;
     336begin
     337  Result := False;
     338  for I := 0 to High(Operators) do
     339    if Operators[I] = Text then
    223340      Result := True;
    224341end;
     
    274391    end else
    275392    if Text[J] = '''' then begin
     393      I := J + 1;
    276394      while not ((Text[I] = '''') and (Text[I + 1] <> '''')) do Inc(I);
    277       Result := Copy(Text, J, I - J);
     395      Inc(I);
     396      Result := Copy(Text, J, I - J );
    278397    end else
    279398    if (Text[J] in SpecChar) then begin
     
    285404            Break;
    286405          end;
     406        I := J;
    287407      end;
    288408      if Result = '' then begin
     
    292412    end else begin
    293413      while IsAlphanumeric(Text[I]) do Inc(I);
    294       Result := Copy(Text, J, I - J);
     414      Result := LowerCase(Copy(Text, J, I - J));
    295415    end;
    296416    J := I;
     
    322442constructor TMethod.Create;
    323443begin
     444  inherited;
    324445  Parameters := TList.Create;
    325   Constants := TConstantList.Create;
    326   Types := TTypeList.Create;
    327   Variables := TVariableList.Create;
    328446  ResultType := TType.Create;
    329447end;
     
    332450begin
    333451  Parameters.Free;
    334   Constants.Free;
    335   Types.Free;
    336   Variables.Free;
    337452  ResultType.Free;
     453  inherited;
    338454end;
    339455
     
    350466{ TProgram }
    351467
     468procedure TProgram.AllocateMemory;
     469var
     470  I: Integer;
     471begin
     472  for I := 0 to Modules.Count - 1 do
     473    TModule(Modules[I]).AllocateMemory;
     474end;
     475
    352476constructor TProgram.Create;
    353477begin
     
    355479  Modules := TList.Create;
    356480  with TModule(Modules[Modules.Add(TModule.Create)]) do begin
    357     Name := 'Main';
     481    Name := 'main';
     482    with TType(Types[Types.Add(TType.Create)]) do begin
     483      Name := 'byte';
     484      Size := 1;
     485      UsedType := nil;
     486    end;
    358487  end;
    359488end;
     
    364493end;
    365494
     495procedure TProgram.GenerateAssembler(Compiler: TCompiler);
     496var
     497  I: Integer;
     498begin
     499  for I := 0 to Modules.Count - 1 do
     500    TModule(Modules[I]).GenerateAssembler(Compiler, '');
     501end;
     502
    366503procedure TProgram.Parse(Compiler: TCompiler);
    367504begin
     
    380517procedure TConstantList.Parse(Compiler: TCompiler);
    381518begin
    382   Compiler.Expect('const');
    383   while Compiler.IsIdentificator(Compiler.NextCode) do
    384     TConstant(Items[Add(TConstant.Create)]).Parse(Compiler);
     519//  Compiler.Expect('const');
     520//  while Compiler.IsIdentificator(Compiler.NextCode) do
     521//    TConstant(Items[Add(TConstant.Create)]).Parse(Compiler);
     522end;
     523
     524function TConstantList.Search(Name: string): TConstant;
     525var
     526  I: Integer;
     527begin
     528  I := 0;
     529  while (I < Count) and (TConstant(Items[I]).Name <> Name) do Inc(I);
     530  if I < Count then Result := Items[I] else begin
     531    if Assigned(Parent.Parent) then Result := Parent.Parent.Constants.Search(Name)
     532      else begin
     533        Result := nil;
     534      end;
     535  end;
    385536end;
    386537
     
    389540constructor TModule.Create;
    390541begin
    391   Constants := TConstantList.Create;
    392   Types := TTypeList.Create;
    393   Variables := TVariableList.Create;
     542  inherited;
     543  UsedModules := TList.Create;
    394544end;
    395545
    396546destructor TModule.Destroy;
    397547begin
    398   Constants.Destroy;
    399   Types.Destroy;
    400   Variables.Destroy;
     548  UsedModules.Destroy;
    401549  inherited;
    402550end;
    403551
    404552procedure TModule.ParseProgram(Compiler: TCompiler);
     553var
     554  Identifier: string;
    405555begin
    406556  with Compiler do begin
     
    411561      Expect(';');
    412562    end else Name := '';
     563
     564    // Uses section
     565    if NextCode = 'uses' then begin
     566      Identifier := ReadCode;
     567      while NextCode = ',' do begin
     568        Identifier := ReadCode;
     569
     570      end;
     571    end;
    413572    ParseDefinitions(Compiler);
    414573  end;
     
    424583end;
    425584
    426 procedure TModule.ParseDefinitions(Compiler: TCompiler);
     585procedure TCommonBlock.AllocateMemory;
     586begin
     587//  for I := 0 to Variables - 1 do
     588   
     589end;
     590
     591constructor TCommonBlock.Create;
     592begin
     593  Constants := TConstantList.Create;
     594  Constants.Parent := Self;
     595  Types := TTypeList.Create;
     596  Types.Parent := Self;
     597  Variables := TVariableList.Create;
     598  Variables.Parent := Self;
     599  Methods := TMethodList.Create;
     600  Methods.Parent := Self;
     601  Operations := TOperationList.Create;
     602end;
     603
     604destructor TCommonBlock.Destroy;
     605begin
     606  Constants.Destroy;
     607  Types.Destroy;
     608  Variables.Destroy;
     609  Methods.Destroy;
     610  Operations.Destroy;
     611  inherited;
     612end;
     613
     614procedure TCommonBlock.GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
     615var
     616  I: Integer;
     617begin
     618  with Compiler do
     619  for I := 0 to Operations.Count - 1 do
     620  with TOperation(Operations[I]) do begin
     621    case Instruction of
     622      inJump: begin
     623        AddInstruction('', 'JMP', Name + '_L' + IntToStr(GotoAddress), '');
     624      end;
     625      inConditionalJump: begin
     626        ExpressionTree.GenerateAssembler(Compiler, LabelPrefix + '_L' + IntToStr(GotoAddress));
     627        AddInstruction('', 'BRCS', Name + '_L' + IntToStr(GotoAddress), '');
     628      end;
     629      inExpressionEvaluation: begin
     630        ExpressionTree.GenerateAssembler(Compiler, Name + '_L' + IntToStr(GotoAddress));
     631      end;
     632    end;
     633  end;
     634end;
     635
     636procedure TCommonBlock.ParseDefinitions(Compiler: TCompiler);
    427637begin
    428638  with Compiler do begin
    429     if NextCode = 'var' then TVariableList(Variables).Parse(Compiler)
    430     else if NextCode = 'const' then TConstantList(Constants).Parse(Compiler)
    431     else if NextCode = 'type' then TTypeList(Types).Parse(Compiler)
    432     else ParseProgram(Compiler);
     639    while NextCode <> '.' do begin
     640      if NextCode = 'var' then TVariableList(Variables).Parse(Compiler)
     641      else if NextCode = 'const' then TConstantList(Constants).Parse(Compiler)
     642      else if NextCode = 'type' then TTypeList(Types).Parse(Compiler)
     643      else begin
     644        ParseProgramCode(Compiler);
     645        Break;
     646      end;
     647    end;
     648  end;
     649end;
     650
     651function TCommonBlock.ParseExpression(Compiler: TCompiler): TExpression;
     652var
     653  Identifier: string;
     654  Variable: TVariable;
     655  Method: TMethod;
     656  Constant: TConstant;
     657//  Brackets: Integer;
     658  Expressions: TList; // TList<TExpression>;
     659  I: Integer;
     660  II: Integer;
     661begin
     662  Expressions := TList.Create;
     663  Expressions.Add(TExpression.Create);
     664  with Compiler do begin
     665    while ((NextCode <> ';') and (NextCode <> ',') and (not IsKeyWord(NextCode))) and
     666      not (((NextCode = ')') or (NextCode = ']'))) do begin
     667        Identifier := ReadCode;
     668        if Identifier = '(' then begin
     669          with TExpression(Expressions[Expressions.Count - 1]) do begin
     670            SubItems[1] := ParseExpression(Compiler);
     671          end;
     672          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
     673            SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     674          end;
     675          Expect(')');
     676        end else
     677        if IsOperator(Identifier) then begin
     678          TExpression(Expressions[Expressions.Count - 1]).OperatorName := Identifier;
     679          TExpression(Expressions[Expressions.Count - 1]).NodeType := ntOperator;
     680        end else
     681        if IsIdentificator(Identifier) then begin
     682          Variable := Variables.Search(Identifier);
     683          if Assigned(Variable) then begin
     684            with TExpression(Expressions[Expressions.Count - 1]) do begin
     685              SubItems[1] := TExpression.Create;
     686              TExpression(SubItems[1]).NodeType := ntVariable;
     687              TExpression(SubItems[1]).Variable := Variable;
     688            end;
     689            with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
     690              SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     691            end;
     692          end else begin
     693            Method := Methods.Search(Identifier);
     694            if Assigned(Method) then begin
     695              with TExpression(Expressions[Expressions.Count - 1]) do begin
     696                SubItems[1] := TExpression.Create;
     697                if NextCode  = '(' then               // Method with parameters
     698                with TExpression(SubItems[1]) do begin
     699                  Expect('(');
     700                  SubItems.Add(ParseExpression(Compiler));
     701                  while NextCode = ',' do begin
     702                    Expect(',');
     703                    SubItems.Add(ParseExpression(Compiler));
     704                  end;
     705                  Expect(')');
     706                end;
     707                TExpression(SubItems[1]).NodeType := ntMethod;
     708                TExpression(SubItems[1]).Method := Method;
     709              end;
     710              with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
     711                SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     712              end;
     713            end else begin
     714              Constant := Constants.Search(Identifier);
     715              if Assigned(Constant) then begin
     716                with TExpression(Expressions[Expressions.Count - 1]) do begin
     717                  SubItems[1] := TExpression.Create;
     718                  TExpression(SubItems[1]).NodeType := ntConstant;
     719                  TExpression(SubItems[1]).Value := Constant.Value;
     720                end;
     721                with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
     722                  SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     723                end;
     724              end;
     725            end;
     726          end;
     727        end else
     728        begin
     729                with TExpression(Expressions[Expressions.Count - 1]) do begin
     730                  SubItems[1] := TExpression.Create;
     731                  TExpression(SubItems[1]).NodeType := ntConstant;
     732
     733                  if Identifier[1] = '''' then begin
     734                    SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
     735                    for I := 1 to Length(Identifier) do TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
     736                  end else begin
     737                    SetLength(TExpression(SubItems[1]).Value, 1);
     738                    TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
     739                  end;
     740                end;
     741                with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
     742                  SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     743                end;
     744        end;
     745    end;
     746
     747    // Build expression tree
     748    for II := 0 to High(Operators) do begin
     749      I := 1;
     750      while (I < Expressions.Count - 1) do begin
     751        if not TExpression(Expressions[I]).Associated and
     752          (TExpression(Expressions[I]).OperatorName = Operators[II]) then begin
     753            TExpression(Expressions[I]).Associated := True;
     754            TExpression(Expressions[I - 1]).SubItems[1] := Expressions[I];
     755            TExpression(Expressions[I + 1]).SubItems[0] := Expressions[I];
     756            Expressions.Delete(I);
     757          end else Inc(I);
     758      end;
     759    end;
     760  end;
     761  Result := TExpression(Expressions[0]).SubItems[1];
     762  TExpression(Expressions[0]).Destroy;
     763  TExpression(Expressions[1]).Destroy;
     764  Expressions.Destroy;
     765end;
     766
     767procedure TCommonBlock.ParseOperation(Compiler: TCompiler);
     768var
     769  Identifier: string;
     770  Variable: TVariable;
     771  Method: TMethod;
     772  First: TOperation;
     773  Second: TOperation;
     774  StartIndex: Integer;
     775  LoopVaraible: TVariable;
     776begin
     777  with Compiler do begin
     778    if NextCode = 'begin' then ParseProgramCode(Compiler)
     779    else if NextCode = 'if' then begin
     780      Expect('if');
     781      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     782        Instruction := inConditionalJump;
     783        ExpressionTree := ParseExpression(Compiler);
     784        Negative := True;
     785      end;
     786      First := Operations[Operations.Count - 1];
     787      Expect('then');
     788      ParseOperation(Compiler);
     789      if NextCode = 'else' then begin
     790        with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     791          Instruction := inJump;
     792        end;
     793        Second := Operations[Operations.Count - 1];
     794        First.GotoAddress := Operations.Count;
     795        Expect('else');
     796        ParseOperation(Compiler);
     797        Second.GotoAddress := Operations.Count;
     798      end else First.GotoAddress := Operations.Count;
     799    end
     800    else if NextCode = 'repeat' then begin
     801      Expect('repeat');
     802      StartIndex := Operations.Count;
     803      ParseOperation(Compiler);
     804      Expect('until');
     805      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     806        Instruction := inConditionalJump;
     807        ExpressionTree := ParseExpression(Compiler);
     808        GotoAddress := StartIndex;
     809      end;
     810    end
     811    else if NextCode = 'while' then begin
     812      Expect('while');
     813      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     814        Instruction := inConditionalJump;
     815        ExpressionTree := ParseExpression(Compiler);
     816      end;
     817      First := Operations[Operations.Count - 1];
     818      StartIndex := Operations.Count - 1;
     819      Expect('do');
     820      ParseOperation(Compiler);
     821      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     822        Instruction := inJump;
     823        GotoAddress := StartIndex;
     824      end;
     825      First.GotoAddress := Operations.Count;
     826    end
     827    else if NextCode = 'for' then begin
     828      Expect('for');
     829      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     830        Instruction := inExpressionEvaluation;
     831        ExpressionTree := ParseExpression(Compiler);
     832        if (ExpressionTree.NodeType <> ntOperator) and
     833          (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
     834        if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
     835          ErrorMessage('Index in FOR loop have to be variable');
     836        LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
     837      end;
     838      Expect('to');
     839      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     840        Instruction := inExpressionEvaluation;
     841        ExpressionTree := TExpression.Create;
     842        with ExpressionTree do begin
     843          NodeType := ntOperator;
     844          OperatorName := '=';
     845          SubItems[0] := TExpression.Create;
     846          with TExpression(SubItems[0]) do begin
     847            NodeType := ntVariable;
     848            Variable := LoopVaraible;
     849          end;
     850          SubItems[1] := ParseExpression(Compiler);
     851        end;
     852        Negative := True;
     853      end;
     854      First := Operations[Operations.Count - 1];
     855      StartIndex := Operations.Count - 1;
     856      Expect('do');
     857      ParseOperation(Compiler);
     858      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     859        Instruction := inExpressionEvaluation;
     860        ExpressionTree := TExpression.Create;
     861        with ExpressionTree do begin
     862          NodeType := ntOperator;
     863          OperatorName := ':=';
     864          SubItems[0] := TExpression.Create;
     865          with TExpression(SubItems[0]) do begin
     866            NodeType := ntVariable;
     867            Variable := LoopVaraible;
     868          end;
     869          SubItems[1] := TExpression.Create;
     870          with TExpression(SubItems[1]) do begin
     871            NodeType := ntOperator;
     872            OperatorName := '+';
     873            SubItems[0] := TExpression.Create;
     874            with TExpression(SubItems[0]) do begin
     875              NodeType := ntVariable;
     876              Variable := LoopVaraible;
     877            end;
     878            SubItems[1] := TExpression.Create;
     879            with TExpression(SubItems[1]) do begin
     880              NodeType := ntConstant;
     881              SetLength(Value, 1);
     882              Value[0] := 1;
     883            end;
     884          end;
     885        end;
     886      end;
     887      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     888        Instruction := inJump;
     889        GotoAddress := StartIndex;
     890      end;
     891      First.GotoAddress := Operations.Count;
     892    end
     893    else begin
     894      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     895        Instruction := inExpressionEvaluation;
     896        ExpressionTree := ParseExpression(Compiler);
     897      end;
     898    end;
     899  end;
     900end;
     901
     902procedure TCommonBlock.ParseProgramCode(Compiler: TCompiler);
     903begin
     904  with Compiler do begin
     905    Expect('begin');
     906    while NextCode <> 'end' do begin
     907      ParseOperation(Compiler);
     908      Expect(';');
     909    end;
     910    Expect('end');
    433911  end;
    434912end;
     
    438916procedure TTypeList.Parse(Compiler: TCompiler);
    439917begin
    440 
     918  with Compiler do begin
     919    Expect('type');
     920    while IsIdentificator(NextCode) do
     921      with TType(Items[Add(TType.Create)]) do begin
     922        Parent := Self;
     923        Parse(Compiler);
     924      end;
     925  end;
     926end;
     927
     928function TTypeList.Search(Name: string): TType;
     929var
     930  I: Integer;
     931begin
     932  I := 0;
     933  while (I < Count) and (TType(Items[I]).Name <> Name) do Inc(I);
     934  if I < Count then Result := Items[I] else begin
     935    if Assigned(Parent.Parent) then Result := Parent.Parent.Types.Search(Name)
     936      else begin
     937        Result := nil;
     938      end;
     939  end;
    441940end;
    442941
     
    444943
    445944procedure TVariableList.Parse(Compiler: TCompiler);
    446 begin
    447 
    448 end;
    449 
    450 { TProgramCode }
    451 
    452 procedure TProgramCode.Parse(Compiler: TCompiler);
    453 begin
    454 
     945var
     946  Identifiers: TStringList;
     947  NewValueType: TType;
     948  TypeName: string;
     949  VariableName: string;
     950  Variable: TVariable;
     951  I: Integer;
     952begin
     953  Identifiers := TStringList.Create;
     954  with Compiler do begin
     955    Expect('var');
     956    while IsIdentificator(NextCode) do begin
     957      VariableName := ReadCode;
     958      Variable := Search(VariableName);
     959      if not Assigned(Variable) then begin
     960        Identifiers.Add(VariableName);
     961        while NextCode = ',' do begin
     962          Expect(',');
     963          Identifiers.Add(ReadCode);
     964        end;
     965      end else ErrorMessage('Pøedefinování existující promìnné.');
     966      Expect(':');
     967      TypeName := ReadCode;
     968      NewValueType := Parent.Types.Search(TypeName);
     969      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
     970        else for I := 0 to Identifiers.Count - 1 do
     971          with TVariable(Items[Add(TVariable.Create)]) do begin
     972            Name := Identifiers[I];
     973            ValueType := NewValueType;
     974          end;
     975      Expect(';');
     976    end;
     977  end;
     978  Identifiers.Destroy;
     979end;
     980
     981function TVariableList.Search(Name: string): TVariable;
     982var
     983  I: Integer;
     984begin
     985  I := 0;
     986  while (I < Count) and (TVariable(Items[I]).Name <> Name) do Inc(I);
     987  if I < Count then Result := Items[I] else begin
     988    if Assigned(Parent.Parent) then Result := Parent.Parent.Variables.Search(Name)
     989      else begin
     990        Result := nil;
     991      end;
     992  end;
     993end;
     994
     995{ TVariable }
     996
     997procedure TVariable.Parse(Compiler: TCompiler);
     998begin
     999end;
     1000
     1001{ TType }
     1002
     1003procedure TType.Parse(Compiler: TCompiler);
     1004begin
     1005  with Compiler do begin
     1006    Name := NextCode;
     1007    Expect('=');
     1008    UsedType := Parent.Search(NextCode);
     1009  end;
     1010end;
     1011
     1012{ TMethodList }
     1013
     1014procedure TMethodList.Parse(Compiler: TCompiler);
     1015begin
     1016
     1017end;
     1018
     1019function TMethodList.Search(Name: string): TMethod;
     1020var
     1021  I: Integer;
     1022begin
     1023  I := 0;
     1024  while (I < Count) and (TMethod(Items[I]).Name <> Name) do Inc(I);
     1025  if I < Count then Result := Items[I] else begin
     1026    if Assigned(Parent.Parent) then Result := Parent.Parent.Methods.Search(Name)
     1027      else begin
     1028        Result := nil;
     1029      end;
     1030  end;
     1031end;
     1032
     1033{ TExpression }
     1034
     1035constructor TExpression.Create;
     1036begin
     1037  SubItems := TList.Create;
     1038  SubItems.Count := 2;
     1039end;
     1040
     1041destructor TExpression.Destroy;
     1042begin
     1043  SubItems.Destroy;
     1044  inherited;
     1045end;
     1046
     1047procedure TExpression.GenerateAssembler(Compiler: TCompiler;
     1048  LabelPrefix: string);
     1049var
     1050  I: Integer;
     1051begin
     1052  with Compiler do
     1053  case NodeType of
     1054    ntNone: ;
     1055    ntVariable: AddInstruction('', 'CALL', '', '');
     1056    ntMethod: AddInstruction('', 'CALL', '', '');
     1057    ntConstant: AddInstruction('', 'CONST', '', '');
     1058    ntOperator: begin
     1059      for I := 0 to SubItems.Count - 1 do
     1060        TExpression(SubItems[I]).GenerateAssembler(Compiler, LabelPrefix);
     1061      if OperatorName = '+' then AddInstruction('', 'ADD', '', '')
     1062      else if OperatorName = '-' then AddInstruction('', 'SUB', '', '')
     1063      else if OperatorName = '*' then AddInstruction('', 'MUL', '', '')
     1064      else if OperatorName = '/' then AddInstruction('', 'DIV', '', '')
     1065      else if OperatorName = 'div' then AddInstruction('', 'DIV', '', '')
     1066      else if OperatorName = 'mod' then AddInstruction('', 'MOD', '', '')
     1067      else if OperatorName = 'xor' then AddInstruction('', 'XOR', '', '')
     1068      else if OperatorName = 'or' then AddInstruction('', 'OR', '', '')
     1069      else if OperatorName = 'and' then AddInstruction('', 'AND', '', '')
     1070      else if OperatorName = 'not' then AddInstruction('', 'NEG', '', '')
     1071      else if OperatorName = ':=' then AddInstruction('', 'ST', '', '')
     1072      else if OperatorName = '>' then AddInstruction('', 'CP', '', '')
     1073      else if OperatorName = '>=' then AddInstruction('', 'CP', '', '')
     1074      else if OperatorName = '<' then AddInstruction('', 'CP', '', '')
     1075      else if OperatorName = '<=' then AddInstruction('', 'CP', '', '')
     1076      else if OperatorName = '=' then AddInstruction('', 'TST', '', '')
     1077      else if OperatorName = '<>' then AddInstruction('', 'CP', '', '');
     1078    end;
     1079  end;
     1080end;
     1081
     1082{ TAssemblerLine }
     1083
     1084function TAssemblerLine.AsString: string;
     1085begin
     1086  Result := LabelName + ': ' + Instruction + ' ' + Operand1 + ',' + Operand2;
    4551087end;
    4561088
Note: See TracChangeset for help on using the changeset viewer.