Changeset 11 for trunk

Timestamp:

Jun 20, 2008, 9:55:04 AM (17 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:

• Example.pas (modified) (1 diff)
• UMainForm.dfm (modified) (2 diffs)
• UMainForm.pas (modified) (27 diffs)

trunk/Example.pas

@@ -3 +3 @@
   A: Byte;
 begin
-  A := 10;
+  A := 'a' + (10 + 2) * 3 xor 10 / 2;
+  while A < 10 do A := A + 1;
 end;

trunk/UMainForm.dfm

@@ -22 +22 @@
     Top = 8
     Width = 401
-    Height = 593
+    Height = 529
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWindowText
@@ -42 +42 @@
   end
   object Memo2: TMemo
-    Left = 416
+    Left = 415
     Top = 8
     Width = 321
-    Height = 593
+    Height = 529
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -13
+    Font.Name = 'Lucida Console'
+    Font.Style = []
+    ParentFont = False
     ScrollBars = ssBoth
     TabOrder = 2
   end
+  object Memo3: TMemo
+    Left = 8
+    Top = 543
+    Width = 728
+    Height = 66
+    ScrollBars = ssBoth
+    TabOrder = 3
+  end
 end

trunk/UMainForm.pas

@@ -12 +12 @@
   TModuleType = (mdProgram, mdUnit, mdLibrary, mdPackage);
 
+  TInstruction = (inJump, inConditionalJump, inExpressionEvaluation);
+
+  TNodeType = (ntNone, ntVariable, ntMethod, ntConstant, ntOperator);
+
   TValue = array of Byte;
 
   TCompiler = class;
+  TCommonBlock = class;
+  TTypeList = class;
+  TConstantList = class;
+  TVariableList = class;
+  TMethodList = class;
+  TExpression = class;
+  TOperationList = class;
 
   TDevice = class
     Family: string;
     Memory: array[TMemoryType] of Integer;
+  end;
+
+  TCommonBlock = class
+    Name: string;
+    Parent: TCommonBlock;
+    Constants: TConstantList;
+    Types: TTypeList;
+    Variables: TVariableList;
+    Methods: TMethodList;
+    Operations: TOperationList;
+    procedure AllocateMemory;
+    constructor Create; virtual;
+    destructor Destroy; override;
+    procedure ParseDefinitions(Compiler: TCompiler);
+    function ParseExpression(Compiler: TCompiler): TExpression;
+    procedure ParseProgramCode(Compiler: TCompiler);
+    procedure ParseOperation(Compiler: TCompiler);
+    procedure GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
+  end;
+
+  TType = class
+    Parent: TTypeList;
+    Name: string;
+    Size: Integer;
+    UsedType: TType;
+    procedure Parse(Compiler: TCompiler);
+  end;
+
+  TTypeList = class(TList)
+    Parent: TCommonBlock;
+    procedure Parse(Compiler: TCompiler);
+    function Search(Name: string): TType;
+  end;
+
+  TConstant = class
+    Name: string;
+    ValueType: TType;
+    Value: TValue;
+    procedure Parse(Compiler: TCompiler);
+  end;
+
+  TConstantList = class(TList)
+    Parent: TCommonBlock;
+    function Search(Name: string): TConstant;
+    procedure Parse(Compiler: TCompiler);
+  end;
+
+  TVariable = class
+    Name: string;
+    ValueType: TType;
+    Value: TValue;
+    procedure Parse(Compiler: TCompiler);
+  end;
+
+  TVariableList = class(TList)
+    Parent: TCommonBlock;
+    procedure Parse(Compiler: TCompiler);
+    function Search(Name: string): TVariable;
+  end;
+
+  TExpression = class
+    NodeType: TNodeType;
+    Variable: TVariable;
+    Method: TMethod;
+    Value: TValue;
+    OperatorName: string;
+    SubItems: TList; // TList<TExpression>
+    Associated: Boolean;
+    constructor Create;
+    destructor Destroy; override;
+    procedure GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
+  end;
+
+  TOperation = class
+    Instruction: TInstruction;
+    ExpressionTree: TExpression;
+    GotoAddress: Integer;
+    Negative: Boolean;
+  end;
+
+  TOperationList = class(TList)
+
+  end;
+
+  TMethod = class(TCommonBlock)
+    Parameters: TList; // TList<TParameter>
+    ResultType: TType;
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure Parse(Compiler: TCompiler);
+  end;
+
+  TMethodList = class(TList)
+    Parent: TCommonBlock;
+    procedure Parse(Compiler: TCompiler);
+    function Search(Name: string): TMethod;
+  end;
+
+  TModule = class(TCommonBlock)
+    ModuleType: TModuleType;
+    UsedModules: TList; // TList<TModule>
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure Parse(Compiler: TCompiler);
+  private
+    procedure ParseUnit(Compiler: TCompiler);
+    procedure ParseProgram(Compiler: TCompiler);
   end;
 
@@ -27 +145 @@
     destructor Destroy; override;
     procedure Parse(Compiler: TCompiler);
-  end;
-
-  TType = class
-    Name: string;
-    Size: Integer;
-  end;
-
-  TTypeList = class(TList)
-    procedure Parse(Compiler: TCompiler);
-  end;
-
-  TConstant = class
-    Name: string;
-    ValueType: TType;
-    Value: TValue;
-    procedure Parse(Compiler: TCompiler);
-  end;
-
-  TConstantList = class(TList)
-    procedure Parse(Compiler: TCompiler);
-  end;
-
-  TVariable = class
-    Name: string;
-    ValueType: TType;
-    Value: TValue;
-  end;
-
-  TVariableList = class(TList)
-    procedure Parse(Compiler: TCompiler);
-  end;
-
-  TProgramCode = class
-    procedure Parse(Compiler: TCompiler);
-  end;
-
-  TMethod = class
-    Name: string;
-    Parameters: TList; // TList<TParameter>
-    Constants: TList; // TList<TConstant>
-    Types: TList; // TList<TType>
-    Variables: TList; // TList<TVariable>
-    ResultType: TType;
-    ProgramCode: TProgramCode;
-    constructor Create;
-    destructor Destroy; override;
-    procedure Parse(Compiler: TCompiler);
-  end;
-
-  TModule = class
-    Name: string;
-    ModuleType: TModuleType;
-    Constants: TList; // TList<TConstant>
-    Types: TList; // TList<TType>
-    Variables: TList; // TList<TVariable>
-    constructor Create;
-    destructor Destroy; override;
-    procedure Parse(Compiler: TCompiler);
-    procedure ParseDefinitions(Compiler: TCompiler);
-  private
-    procedure ParseUnit(Compiler: TCompiler);
-    procedure ParseProgram(Compiler: TCompiler);
+    procedure AllocateMemory;
+    procedure GenerateAssembler(Compiler: TCompiler);
+  end;
+
+  TAssemblerLine = class
+    LabelName: string;
+    Instruction: string;
+    Operand1: string;
+    Operand2: string;
+    SourceCode: string;
+    function AsString: string;
   end;
 
@@ -95 +162 @@
     SourceCode: TStringList;
     CodePosition: Integer;
-    AssemberCode: TStringList;
+    AssemblyCode: TList; // TList<TAssemblerLine>
     ProgramCode: TProgram;
     procedure ErrorMessage(Text: string);
@@ -106 +173 @@
     function IsIdentificator(Text: string): Boolean;
     function IsKeyword(Text: string): Boolean;
+    function IsOperator(Text: string): Boolean;
+    procedure GenerateAssemblyCode;
+    procedure AddInstruction(LabelName, Instruction, Operand1, Operand2: string);
   public
     constructor Create;
@@ -116 +186 @@
     Button1: TButton;
     Memo2: TMemo;
+    Memo3: TMemo;
     procedure FormShow(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
@@ -128 +199 @@
 
 const
-  KeyWords: array[0..40] of string = ('program', 'unit', 'uses', 'begin', 'end',
+  KeyWords: array[0..37] of string = ('program', 'unit', 'uses', 'begin', 'end',
     'type', 'const', 'var', 'array', 'record', 'absolute', 'virtual', 'class',
     'set', 'private', 'public', 'interface', 'implementation', 'finalization',
-    'initialization', 'for', 'while', 'if', 'case', 'of', 'as', 'in', 'is', 'pointer',
+    'initialization', 'for', 'while', 'if', 'case', 'of', 'pointer',
     'object', 'packed', 'procedure', 'function', 'to', 'do', 'downto', 'repeat',
     'until', 'then', 'asm', 'else');
+  Operators: array[0..22] of string = ('@', 'not', '*', 'and', '/', 'shl',
+    'shr', 'as', 'div', 'mod', 'or', 'xor', '-', '+', '=', '>', '<', '<>', '<=',
+     '>=', 'is', 'in', ':=');
+
 var
   MainForm: TMainForm;
@@ -142 +217 @@
 
 procedure TMainForm.Button1Click(Sender: TObject);
+var
+  I: Integer;
 begin
   Compiler.Compile(Memo1.Lines);
-  Memo2.Assign(Compiler.AssemberCode);
+  Memo2.Clear;
+  for I := 0 to Compiler.AssemblyCode.Count - 1 do
+    Memo2.Lines.Add(TAssemblerLine(Compiler.AssemblyCode[I]).AsString);
 end;
 
@@ -163 +242 @@
 
 procedure TMainForm.FormShow(Sender: TObject);
+var
+  I: Integer;
 begin
   Memo1.Lines.LoadFromFile('Example.pas');
   Compiler.Compile(Memo1.Lines);
+  Memo2.Clear;
+  for I := 0 to Compiler.AssemblyCode.Count - 1 do
+    Memo2.Lines.Add(TAssemblerLine(Compiler.AssemblyCode[I]).AsString);
+
 end;
 
 { TCompiler }
 
+procedure TCompiler.AddInstruction(LabelName, Instruction, Operand1,
+  Operand2: string);
+var
+  NewLine: TAssemblerLine;
+begin
+  NewLine := TAssemblerLine.Create;
+  AssemblyCode.Add(NewLine);
+  NewLine.LabelName := LabelName;
+  NewLine.Instruction := Instruction;
+  NewLine.Operand1 := Operand1;
+  NewLine.Operand2 := Operand2;
+end;
+
 procedure TCompiler.Compile(SourceCode: TStrings);
 begin
+  MainForm.Memo3.Clear;
   Self.SourceCode.Assign(SourceCode);
   CodePosition := 1;
   ProgramCode.Parse(Self);
+  ProgramCode.AllocateMemory;
+  GenerateAssemblyCode;
 end;
 
@@ -180 +281 @@
 begin
   SourceCode := TStringList.Create;
-  AssemberCode := TStringList.Create;
+  AssemblyCode := TList.Create;
   ProgramCode := TProgram.Create;
 end;
@@ -187 +288 @@
 begin
   ProgramCode.Free;
-  AssemberCode.Free;
+  AssemblyCode.Free;
   SourceCode.Free;
 end;
@@ -193 +294 @@
 procedure TCompiler.ErrorMessage(Text: string);
 begin
-  ShowMessage(Text);
+  //ShowMessage(Text);
+  MainForm.Memo3.Lines.Add(Text);
 end;
 
@@ -202 +304 @@
   end;
   ReadCode;
+end;
+
+procedure TCompiler.GenerateAssemblyCode;
+begin
+  ProgramCode.GenerateAssembler(Self);
 end;
 
@@ -221 +328 @@
   for I := 0 to High(Keywords) do
     if Keywords[I] = Text then
+      Result := True;
+end;
+
+function TCompiler.IsOperator(Text: string): Boolean;
+var
+  I: Integer;
+begin
+  Result := False;
+  for I := 0 to High(Operators) do
+    if Operators[I] = Text then
       Result := True;
 end;
@@ -274 +391 @@
     end else
     if Text[J] = '''' then begin
+      I := J + 1;
       while not ((Text[I] = '''') and (Text[I + 1] <> '''')) do Inc(I);
-      Result := Copy(Text, J, I - J);
+      Inc(I);
+      Result := Copy(Text, J, I - J );
     end else
     if (Text[J] in SpecChar) then begin
@@ -285 +404 @@
             Break;
           end;
+        I := J;
       end;
       if Result = '' then begin
@@ -292 +412 @@
     end else begin
       while IsAlphanumeric(Text[I]) do Inc(I);
-      Result := Copy(Text, J, I - J);
+      Result := LowerCase(Copy(Text, J, I - J));
     end;
     J := I;
@@ -322 +442 @@
 constructor TMethod.Create;
 begin
+  inherited;
   Parameters := TList.Create;
-  Constants := TConstantList.Create;
-  Types := TTypeList.Create;
-  Variables := TVariableList.Create;
   ResultType := TType.Create;
 end;
@@ -332 +450 @@
 begin
   Parameters.Free;
-  Constants.Free;
-  Types.Free;
-  Variables.Free;
   ResultType.Free;
+  inherited;
 end;
 
@@ -350 +466 @@
 { TProgram }
 
+procedure TProgram.AllocateMemory;
+var
+  I: Integer;
+begin
+  for I := 0 to Modules.Count - 1 do
+    TModule(Modules[I]).AllocateMemory;
+end;
+
 constructor TProgram.Create;
 begin
@@ -355 +479 @@
   Modules := TList.Create;
   with TModule(Modules[Modules.Add(TModule.Create)]) do begin
-    Name := 'Main';
+    Name := 'main';
+    with TType(Types[Types.Add(TType.Create)]) do begin
+      Name := 'byte';
+      Size := 1;
+      UsedType := nil;
+    end;
   end;
 end;
@@ -364 +493 @@
 end;
 
+procedure TProgram.GenerateAssembler(Compiler: TCompiler);
+var
+  I: Integer;
+begin
+  for I := 0 to Modules.Count - 1 do
+    TModule(Modules[I]).GenerateAssembler(Compiler, '');
+end;
+
 procedure TProgram.Parse(Compiler: TCompiler);
 begin
@@ -380 +517 @@
 procedure TConstantList.Parse(Compiler: TCompiler);
 begin
-  Compiler.Expect('const');
-  while Compiler.IsIdentificator(Compiler.NextCode) do
-    TConstant(Items[Add(TConstant.Create)]).Parse(Compiler);
+//  Compiler.Expect('const');
+//  while Compiler.IsIdentificator(Compiler.NextCode) do
+//    TConstant(Items[Add(TConstant.Create)]).Parse(Compiler);
+end;
+
+function TConstantList.Search(Name: string): TConstant;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TConstant(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := Items[I] else begin
+    if Assigned(Parent.Parent) then Result := Parent.Parent.Constants.Search(Name)
+      else begin
+        Result := nil;
+      end;
+  end;
 end;
 
@@ -389 +540 @@
 constructor TModule.Create;
 begin
-  Constants := TConstantList.Create;
-  Types := TTypeList.Create;
-  Variables := TVariableList.Create;
+  inherited;
+  UsedModules := TList.Create;
 end;
 
 destructor TModule.Destroy;
 begin
-  Constants.Destroy;
-  Types.Destroy;
-  Variables.Destroy;
+  UsedModules.Destroy;
   inherited;
 end;
 
 procedure TModule.ParseProgram(Compiler: TCompiler);
+var
+  Identifier: string;
 begin
   with Compiler do begin
@@ -411 +561 @@
       Expect(';');
     end else Name := '';
+
+    // Uses section
+    if NextCode = 'uses' then begin
+      Identifier := ReadCode;
+      while NextCode = ',' do begin
+        Identifier := ReadCode;
+
+      end;
+    end;
     ParseDefinitions(Compiler);
   end;
@@ -424 +583 @@
 end;
 
-procedure TModule.ParseDefinitions(Compiler: TCompiler);
+procedure TCommonBlock.AllocateMemory;
+begin
+//  for I := 0 to Variables - 1 do
+    
+end;
+
+constructor TCommonBlock.Create;
+begin
+  Constants := TConstantList.Create;
+  Constants.Parent := Self;
+  Types := TTypeList.Create;
+  Types.Parent := Self;
+  Variables := TVariableList.Create;
+  Variables.Parent := Self;
+  Methods := TMethodList.Create;
+  Methods.Parent := Self;
+  Operations := TOperationList.Create;
+end;
+
+destructor TCommonBlock.Destroy;
+begin
+  Constants.Destroy;
+  Types.Destroy;
+  Variables.Destroy;
+  Methods.Destroy;
+  Operations.Destroy;
+  inherited;
+end;
+
+procedure TCommonBlock.GenerateAssembler(Compiler: TCompiler; LabelPrefix: string);
+var
+  I: Integer;
+begin
+  with Compiler do
+  for I := 0 to Operations.Count - 1 do
+  with TOperation(Operations[I]) do begin
+    case Instruction of
+      inJump: begin
+        AddInstruction('', 'JMP', Name + '_L' + IntToStr(GotoAddress), '');
+      end;
+      inConditionalJump: begin
+        ExpressionTree.GenerateAssembler(Compiler, LabelPrefix + '_L' + IntToStr(GotoAddress));
+        AddInstruction('', 'BRCS', Name + '_L' + IntToStr(GotoAddress), '');
+      end;
+      inExpressionEvaluation: begin
+        ExpressionTree.GenerateAssembler(Compiler, Name + '_L' + IntToStr(GotoAddress));
+      end;
+    end;
+  end;
+end;
+
+procedure TCommonBlock.ParseDefinitions(Compiler: TCompiler);
 begin
   with Compiler do begin
-    if NextCode = 'var' then TVariableList(Variables).Parse(Compiler)
-    else if NextCode = 'const' then TConstantList(Constants).Parse(Compiler)
-    else if NextCode = 'type' then TTypeList(Types).Parse(Compiler)
-    else ParseProgram(Compiler);
+    while NextCode <> '.' do begin
+      if NextCode = 'var' then TVariableList(Variables).Parse(Compiler)
+      else if NextCode = 'const' then TConstantList(Constants).Parse(Compiler)
+      else if NextCode = 'type' then TTypeList(Types).Parse(Compiler)
+      else begin
+        ParseProgramCode(Compiler);
+        Break;
+      end;
+    end;
+  end;
+end;
+
+function TCommonBlock.ParseExpression(Compiler: TCompiler): TExpression;
+var
+  Identifier: string;
+  Variable: TVariable;
+  Method: TMethod;
+  Constant: TConstant;
+//  Brackets: Integer;
+  Expressions: TList; // TList<TExpression>;
+  I: Integer;
+  II: Integer;
+begin
+  Expressions := TList.Create;
+  Expressions.Add(TExpression.Create);
+  with Compiler do begin
+    while ((NextCode <> ';') and (NextCode <> ',') and (not IsKeyWord(NextCode))) and
+      not (((NextCode = ')') or (NextCode = ']'))) do begin
+        Identifier := ReadCode;
+        if Identifier = '(' then begin
+          with TExpression(Expressions[Expressions.Count - 1]) do begin
+            SubItems[1] := ParseExpression(Compiler);
+          end;
+          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
+            SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
+          end;
+          Expect(')');
+        end else
+        if IsOperator(Identifier) then begin
+          TExpression(Expressions[Expressions.Count - 1]).OperatorName := Identifier;
+          TExpression(Expressions[Expressions.Count - 1]).NodeType := ntOperator;
+        end else
+        if IsIdentificator(Identifier) then begin
+          Variable := Variables.Search(Identifier);
+          if Assigned(Variable) then begin
+            with TExpression(Expressions[Expressions.Count - 1]) do begin
+              SubItems[1] := TExpression.Create;
+              TExpression(SubItems[1]).NodeType := ntVariable;
+              TExpression(SubItems[1]).Variable := Variable;
+            end;
+            with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
+              SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
+            end;
+          end else begin
+            Method := Methods.Search(Identifier);
+            if Assigned(Method) then begin
+              with TExpression(Expressions[Expressions.Count - 1]) do begin
+                SubItems[1] := TExpression.Create;
+                if NextCode  = '(' then               // Method with parameters
+                with TExpression(SubItems[1]) do begin
+                  Expect('(');
+                  SubItems.Add(ParseExpression(Compiler));
+                  while NextCode = ',' do begin
+                    Expect(',');
+                    SubItems.Add(ParseExpression(Compiler));
+                  end;
+                  Expect(')');
+                end;
+                TExpression(SubItems[1]).NodeType := ntMethod;
+                TExpression(SubItems[1]).Method := Method;
+              end;
+              with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
+                SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
+              end;
+            end else begin
+              Constant := Constants.Search(Identifier);
+              if Assigned(Constant) then begin
+                with TExpression(Expressions[Expressions.Count - 1]) do begin
+                  SubItems[1] := TExpression.Create;
+                  TExpression(SubItems[1]).NodeType := ntConstant;
+                  TExpression(SubItems[1]).Value := Constant.Value;
+                end;
+                with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
+                  SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
+                end;
+              end;
+            end;
+          end;
+        end else
+        begin
+                with TExpression(Expressions[Expressions.Count - 1]) do begin
+                  SubItems[1] := TExpression.Create;
+                  TExpression(SubItems[1]).NodeType := ntConstant;
+
+                  if Identifier[1] = '''' then begin
+                    SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
+                    for I := 1 to Length(Identifier) do TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
+                  end else begin
+                    SetLength(TExpression(SubItems[1]).Value, 1);
+                    TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
+                  end;
+                end;
+                with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
+                  SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
+                end;
+        end;
+    end;
+
+    // Build expression tree
+    for II := 0 to High(Operators) do begin
+      I := 1;
+      while (I < Expressions.Count - 1) do begin
+        if not TExpression(Expressions[I]).Associated and
+          (TExpression(Expressions[I]).OperatorName = Operators[II]) then begin
+            TExpression(Expressions[I]).Associated := True;
+            TExpression(Expressions[I - 1]).SubItems[1] := Expressions[I];
+            TExpression(Expressions[I + 1]).SubItems[0] := Expressions[I];
+            Expressions.Delete(I);
+          end else Inc(I);
+      end;
+    end;
+  end;
+  Result := TExpression(Expressions[0]).SubItems[1];
+  TExpression(Expressions[0]).Destroy;
+  TExpression(Expressions[1]).Destroy;
+  Expressions.Destroy;
+end;
+
+procedure TCommonBlock.ParseOperation(Compiler: TCompiler);
+var
+  Identifier: string;
+  Variable: TVariable;
+  Method: TMethod;
+  First: TOperation;
+  Second: TOperation;
+  StartIndex: Integer;
+  LoopVaraible: TVariable;
+begin
+  with Compiler do begin
+    if NextCode = 'begin' then ParseProgramCode(Compiler)
+    else if NextCode = 'if' then begin
+      Expect('if');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inConditionalJump;
+        ExpressionTree := ParseExpression(Compiler);
+        Negative := True;
+      end;
+      First := Operations[Operations.Count - 1];
+      Expect('then');
+      ParseOperation(Compiler);
+      if NextCode = 'else' then begin
+        with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+          Instruction := inJump;
+        end;
+        Second := Operations[Operations.Count - 1];
+        First.GotoAddress := Operations.Count;
+        Expect('else');
+        ParseOperation(Compiler);
+        Second.GotoAddress := Operations.Count;
+      end else First.GotoAddress := Operations.Count;
+    end
+    else if NextCode = 'repeat' then begin
+      Expect('repeat');
+      StartIndex := Operations.Count;
+      ParseOperation(Compiler);
+      Expect('until');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inConditionalJump;
+        ExpressionTree := ParseExpression(Compiler);
+        GotoAddress := StartIndex;
+      end;
+    end
+    else if NextCode = 'while' then begin
+      Expect('while');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inConditionalJump;
+        ExpressionTree := ParseExpression(Compiler);
+      end;
+      First := Operations[Operations.Count - 1];
+      StartIndex := Operations.Count - 1;
+      Expect('do');
+      ParseOperation(Compiler);
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inJump;
+        GotoAddress := StartIndex;
+      end;
+      First.GotoAddress := Operations.Count;
+    end
+    else if NextCode = 'for' then begin
+      Expect('for');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inExpressionEvaluation;
+        ExpressionTree := ParseExpression(Compiler);
+        if (ExpressionTree.NodeType <> ntOperator) and
+          (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
+        if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
+          ErrorMessage('Index in FOR loop have to be variable');
+        LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
+      end;
+      Expect('to');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inExpressionEvaluation;
+        ExpressionTree := TExpression.Create;
+        with ExpressionTree do begin
+          NodeType := ntOperator;
+          OperatorName := '=';
+          SubItems[0] := TExpression.Create;
+          with TExpression(SubItems[0]) do begin
+            NodeType := ntVariable;
+            Variable := LoopVaraible;
+          end;
+          SubItems[1] := ParseExpression(Compiler);
+        end;
+        Negative := True;
+      end;
+      First := Operations[Operations.Count - 1];
+      StartIndex := Operations.Count - 1;
+      Expect('do');
+      ParseOperation(Compiler);
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inExpressionEvaluation;
+        ExpressionTree := TExpression.Create;
+        with ExpressionTree do begin
+          NodeType := ntOperator;
+          OperatorName := ':=';
+          SubItems[0] := TExpression.Create;
+          with TExpression(SubItems[0]) do begin
+            NodeType := ntVariable;
+            Variable := LoopVaraible;
+          end;
+          SubItems[1] := TExpression.Create;
+          with TExpression(SubItems[1]) do begin
+            NodeType := ntOperator;
+            OperatorName := '+';
+            SubItems[0] := TExpression.Create;
+            with TExpression(SubItems[0]) do begin
+              NodeType := ntVariable;
+              Variable := LoopVaraible;
+            end;
+            SubItems[1] := TExpression.Create;
+            with TExpression(SubItems[1]) do begin
+              NodeType := ntConstant;
+              SetLength(Value, 1);
+              Value[0] := 1;
+            end;
+          end;
+        end;
+      end;
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inJump;
+        GotoAddress := StartIndex;
+      end;
+      First.GotoAddress := Operations.Count;
+    end
+    else begin
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inExpressionEvaluation;
+        ExpressionTree := ParseExpression(Compiler);
+      end;
+    end;
+  end;
+end;
+
+procedure TCommonBlock.ParseProgramCode(Compiler: TCompiler);
+begin
+  with Compiler do begin
+    Expect('begin');
+    while NextCode <> 'end' do begin
+      ParseOperation(Compiler);
+      Expect(';');
+    end;
+    Expect('end');
   end;
 end;
@@ -438 +916 @@
 procedure TTypeList.Parse(Compiler: TCompiler);
 begin
-
+  with Compiler do begin
+    Expect('type');
+    while IsIdentificator(NextCode) do
+      with TType(Items[Add(TType.Create)]) do begin
+        Parent := Self;
+        Parse(Compiler);
+      end;
+  end;
+end;
+
+function TTypeList.Search(Name: string): TType;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TType(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := Items[I] else begin
+    if Assigned(Parent.Parent) then Result := Parent.Parent.Types.Search(Name)
+      else begin
+        Result := nil;
+      end;
+  end;
 end;
 
@@ -444 +943 @@
 
 procedure TVariableList.Parse(Compiler: TCompiler);
-begin
-
-end;
-
-{ TProgramCode }
-
-procedure TProgramCode.Parse(Compiler: TCompiler);
-begin
-
+var
+  Identifiers: TStringList;
+  NewValueType: TType;
+  TypeName: string;
+  VariableName: string;
+  Variable: TVariable;
+  I: Integer;
+begin
+  Identifiers := TStringList.Create;
+  with Compiler do begin
+    Expect('var');
+    while IsIdentificator(NextCode) do begin
+      VariableName := ReadCode;
+      Variable := Search(VariableName);
+      if not Assigned(Variable) then begin
+        Identifiers.Add(VariableName);
+        while NextCode = ',' do begin
+          Expect(',');
+          Identifiers.Add(ReadCode);
+        end;
+      end else ErrorMessage('Pøedefinování existující promìnné.');
+      Expect(':');
+      TypeName := ReadCode;
+      NewValueType := Parent.Types.Search(TypeName);
+      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
+        else for I := 0 to Identifiers.Count - 1 do
+          with TVariable(Items[Add(TVariable.Create)]) do begin
+            Name := Identifiers[I];
+            ValueType := NewValueType;
+          end;
+      Expect(';');
+    end;
+  end;
+  Identifiers.Destroy;
+end;
+
+function TVariableList.Search(Name: string): TVariable;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TVariable(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := Items[I] else begin
+    if Assigned(Parent.Parent) then Result := Parent.Parent.Variables.Search(Name)
+      else begin
+        Result := nil;
+      end;
+  end;
+end;
+
+{ TVariable }
+
+procedure TVariable.Parse(Compiler: TCompiler);
+begin
+end;
+
+{ TType }
+
+procedure TType.Parse(Compiler: TCompiler);
+begin
+  with Compiler do begin
+    Name := NextCode;
+    Expect('=');
+    UsedType := Parent.Search(NextCode);
+  end;
+end;
+
+{ TMethodList }
+
+procedure TMethodList.Parse(Compiler: TCompiler);
+begin
+
+end;
+
+function TMethodList.Search(Name: string): TMethod;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TMethod(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := Items[I] else begin
+    if Assigned(Parent.Parent) then Result := Parent.Parent.Methods.Search(Name)
+      else begin
+        Result := nil;
+      end;
+  end;
+end;
+
+{ TExpression }
+
+constructor TExpression.Create;
+begin
+  SubItems := TList.Create;
+  SubItems.Count := 2;
+end;
+
+destructor TExpression.Destroy;
+begin
+  SubItems.Destroy;
+  inherited;
+end;
+
+procedure TExpression.GenerateAssembler(Compiler: TCompiler;
+  LabelPrefix: string);
+var
+  I: Integer;
+begin
+  with Compiler do
+  case NodeType of
+    ntNone: ;
+    ntVariable: AddInstruction('', 'CALL', '', '');
+    ntMethod: AddInstruction('', 'CALL', '', '');
+    ntConstant: AddInstruction('', 'CONST', '', '');
+    ntOperator: begin
+      for I := 0 to SubItems.Count - 1 do
+        TExpression(SubItems[I]).GenerateAssembler(Compiler, LabelPrefix);
+      if OperatorName = '+' then AddInstruction('', 'ADD', '', '')
+      else if OperatorName = '-' then AddInstruction('', 'SUB', '', '')
+      else if OperatorName = '*' then AddInstruction('', 'MUL', '', '')
+      else if OperatorName = '/' then AddInstruction('', 'DIV', '', '')
+      else if OperatorName = 'div' then AddInstruction('', 'DIV', '', '')
+      else if OperatorName = 'mod' then AddInstruction('', 'MOD', '', '')
+      else if OperatorName = 'xor' then AddInstruction('', 'XOR', '', '')
+      else if OperatorName = 'or' then AddInstruction('', 'OR', '', '')
+      else if OperatorName = 'and' then AddInstruction('', 'AND', '', '')
+      else if OperatorName = 'not' then AddInstruction('', 'NEG', '', '')
+      else if OperatorName = ':=' then AddInstruction('', 'ST', '', '')
+      else if OperatorName = '>' then AddInstruction('', 'CP', '', '')
+      else if OperatorName = '>=' then AddInstruction('', 'CP', '', '')
+      else if OperatorName = '<' then AddInstruction('', 'CP', '', '')
+      else if OperatorName = '<=' then AddInstruction('', 'CP', '', '')
+      else if OperatorName = '=' then AddInstruction('', 'TST', '', '')
+      else if OperatorName = '<>' then AddInstruction('', 'CP', '', '');
+    end;
+  end;
+end;
+
+{ TAssemblerLine }
+
+function TAssemblerLine.AsString: string;
+begin
+  Result := LabelName + ': ' + Instruction + ' ' + Operand1 + ',' + Operand2;
 end;