Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Курсовая работа1 / Parser / UCcSyntaxEntries

.pas
Скачиваний:
12
Добавлен:
01.05.2014
Размер:
47 Кб
Скачать
☆
{
  C-like language compiler v0.1.0.485

  12 november 2007

  Copyright (C) 2006, 2007 Igor Krooshch
  rheo.ikro@gmail.com

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
  License as published by the Free Software Foundation; either
  version 2.1 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  Lesser General Public License for more details.

  You should have received a copy of the GNU Lesser General Public
  License along with this library; if not, write to the Free Software
  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
}

unit UCcSyntaxEntries;

interface

uses
  SysUtils, Classes,
  UCcTokenizer, UCcCodeGenerator, UCcCodeGeneratorCommands, UCcBuffer,
  UCcSyntaxEntriesTypes;

type
  ECcWarningException = class(ECcBufferException);
  ECcSymanticException = class(ECcBufferException);

  TCcSyntaxObjectClass = class of TCcSyntaxObject;

  TCcSyntaxObject = class
  private
    FPosition: TCcPosition;
  public
    constructor Create(APosition: TCcPosition); virtual;
    procedure Generate(AGenerator: TCcCodeGenerator); virtual;

    property Position: TCcPosition read FPosition write FPosition;
  end;


  TCcExpression = class(TCcSyntaxObject)
  public
    function Evaluate: TCcExpression; virtual;
    procedure GenerateLValue(AGenerator: TCcCodeGenerator); virtual;

    function ResultType: TCcExpressionType; virtual;

    function CleansStack: boolean; virtual;

    function Size: integer; virtual;
  end;


  TCcEmptyExpression = class(TCcExpression);


  TCcFuncCall = class(TCcExpression)
  private
    FSymbol: TObject;
    FName: string;
    FArguments: TList;

    procedure DoIntToFloatTranform(AGenerator: TCcCodeGenerator);
  public
    constructor Create(
      APosition: TCcPosition; const AName: string;
      ASymbol: TObject = nil); reintroduce;
    destructor Destroy; override;

    procedure AddArgument(A: TCcExpression);

    procedure Generate(AGenerator: TCcCodeGenerator); override;
    function CleansStack: Boolean; override;

    function ResultType: TCcExpressionType; override;

    property Name: string read FName;
    property Arguments: TList read FArguments;
    property Symbol: TObject read FSymbol;
  end;


  TCcUnaryOperation = class(TCcExpression)
  private
    FArgument: TCcExpression;
    FOperator: TCcTokenOperators;
    FIsPostfix: boolean;
  public
    constructor Create(
      APosition: TCcPosition; AOperator: TCcTokenOperators;
      AArgument: TCcExpression; const AIsPostfix: boolean = true); reintroduce;
    destructor Destroy; override;

    function Evaluate: TCcExpression; override;
    procedure Generate(AGenerator: TCcCodeGenerator); override;

    function ResultType: TCcExpressionType; override;

    property Argument: TCcExpression read FArgument;
    property IsPostfix: boolean read FIsPostfix;
    property Operation: TCcTokenOperators read FOperator;
  end;


  TCcItemSelectionOperation = class(TCcExpression)
  private
    FName: TCcExpression;
    FIndex: TCcExpression;
    FDimension: integer;
    FType: TObject;
  public
    constructor Create(
      APosition: TCcPosition; AName: TCcExpression; AIndex: TCcExpression;
      AType: TObject); reintroduce;
    destructor Destroy; override;

    procedure Generate(AGenerator: TCcCodeGenerator); override;
    procedure GenerateLValue(AGenerator: TCcCodeGenerator); override;

    function Size: integer; override;
    function LValueType: TObject;
    function ResultType: TCcExpressionType; override;

    property Name: TCcExpression read FName;
    property Index: TCcExpression read FIndex;
    property Dimension: integer read FDimension;
  end;


  TCcAbstractBinaryOperation = class(TCcExpression)
  private
    FLeft: TCcExpression;
    FRight: TCcExpression;
  public
    constructor Create(
      APosition: TCcPosition; ALeft, ARight: TCcExpression); reintroduce;
    destructor Destroy; override;

    function OperationStr: string; virtual; abstract;

    property Left: TCcExpression read FLeft;
    property Right: TCcExpression read FRight;
  end;


  TCcBinaryOperation = class(TCcAbstractBinaryOperation)
  private
    FOperator: TCcTokenOperators;
  public
    constructor Create(
      APosition: TCcPosition; AOperator: TCcTokenOperators;
      ALeft, ARight: TCcExpression); reintroduce;

    function Evaluate: TCcExpression; override;
    procedure Generate(AGenerator: TCcCodeGenerator); override;

    function ResultType: TCcExpressionType; override;
    function OperationStr: string; override;

    property Operation: TCcTokenOperators read FOperator;
  end;


  TCcBinaryDelimOperation = class(TCcAbstractBinaryOperation)
  private
    FOperator: TCcTokenDelimiters;
    FTableStack: TObject;
  public
    constructor Create(
      APosition: TCcPosition; AOperator: TCcTokenDelimiters;
      ALeft, ARight: TCcExpression; ATableStack: TObject); reintroduce;

    procedure GenerateLValue(AGenerator: TCcCodeGenerator); override;
    procedure Generate(AGenerator: TCcCodeGenerator); override;

    function ResultType: TCcExpressionType; override;

    function OperationStr: string; override;

    property Operation: TCcTokenDelimiters read FOperator;
  end;


  TCcConditionOperation = class(TCcExpression)
  private
    FTrue: TCcExpression;
    FFalse: TCcExpression;
    FCondition: TCcExpression;
  public
    constructor Create(
      APosition: TCcPosition;
      ACondition, ATrue, AFalse: TCcExpression); reintroduce;
    destructor Destroy; override;

    function Evaluate: TCcExpression; override;

    function ResultType: TCcExpressionType; override;

    property Condition: TCcExpression read FCondition;
    property TrueExpr: TCcExpression read FTrue;
    property FalseExpr: TCcExpression read FFalse;
  end;


  TCcSyntaxVarClass = class of TCcSyntaxVar;

  TCcSyntaxVar = class(TCcExpression)
  private
    FName: string;
    FVariable: TObject;
  public
    constructor Create(
      APosition: TCcPosition; const AName: string;
      AVariable: TObject); reintroduce;

    procedure Generate(AGenerator: TCcCodeGenerator); override;
    procedure GenerateLValue(AGenerator: TCcCodeGenerator); override;

    function Size: integer; override;

    function ResultType: TCcExpressionType; override;

    property Name: string read FName;
    property Variable: TObject read FVariable;
  end;


  TCcSyntaxStructField = class(TCcSyntaxVar)
  private
    procedure GenerateValInEax(AGenerator: TCcCodeGenerator);
  public
    procedure GenerateLValue(AGenerator: TCcCodeGenerator); override;
    procedure Generate(AGenerator: TCcCodeGenerator); override;
  end;


  TCcSyntaxConst = class(TCcExpression)
  end;


  TCcSyntaxConstInteger = class(TCcSyntaxConst)
  private
    FValue: integer;
  public
    constructor Create(
      APosition: TCcPosition; const AValue: integer); reintroduce;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    function ResultType: TCcExpressionType; override;

    property Value: integer read FValue;
  end;


  TCcSyntaxConstFloat = class(TCcSyntaxConst)
  private
    FValue: single;
  public
    constructor Create(
      APosition: TCcPosition; const AValue: single); reintroduce;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    function ResultType: TCcExpressionType; override;

    property Value: single read FValue;
  end;


  TCcSyntaxConstString = class(TCcSyntaxConst)
  private
    FValue: string;
    FName: string;
  public
    constructor Create(
      APosition: TCcPosition; const AValue: string;
      AGenerator: TCcCodeGenerator); reintroduce;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Value: string read FValue;
    property Name: string read FName;
  end;


  // *********** STATEMENTS ****************

  TCcStatement = class(TCcSyntaxObject);

  TCcEmptyStatement = class(TCcStatement)
  public
    procedure Generate(AGenerator: TCcCodeGenerator); override;
  end;


  TCcExprStatement = class(TCcStatement)
  private
    FExpression: TCcExpression;
  public
    constructor Create(
      APosition: TCcPosition; AExpr: TCcExpression); reintroduce;
    destructor Destroy; override;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Expression: TCcExpression read FExpression;
  end;


  TCcWhileStatement = class(TCcStatement)
  private
    FExpression: TCcExpression;
    FStatement: TCcStatement;
  public
    constructor Create(
      APosition: TCcPosition; AExpr: TCcExpression;
      AStatement: TCcStatement); reintroduce;
    destructor Destroy; override;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Expression: TCcExpression read FExpression;
    property Statement: TCcStatement read FStatement;
  end;


  TCcDoWhileStatement = class(TCcWhileStatement)
  public
    procedure Generate(AGenerator: TCcCodeGenerator); override;
  end;


  TCcBlockStatement = class(TCcStatement)
  private
    FStatements: TList;
  public
    constructor Create(APosition: TCcPosition); reintroduce;
    destructor Destroy; override;

    procedure AddStatement(AStmt: TCcStatement);
    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Statements: TList read FStatements;
  end;


  TCcForStatement = class(TCcStatement)
  private
    FExpr1: TCcExpression;
    FExpr2: TCcExpression;
    FExpr3: TCcExpression;
    FStatement: TCcStatement;
  public
    constructor Create(
      APosition: TCcPosition; AExpr1, AExpr2, AExpr3: TCcExpression;
      AStmt: TCcStatement); reintroduce;
    destructor Destroy; override;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Expr1: TCcExpression read FExpr1;
    property Expr2: TCcExpression read FExpr2;
    property Expr3: TCcExpression read FExpr3;
    property Statement: TCcStatement read FStatement;
  end;


  TCcControlStatement = class(TCcStatement)
  private
    FControlType: TCcControlStatementType;
  public
    constructor Create(
      APosition: TCcPosition; AType: TCcControlStatementType); reintroduce;
    destructor Destroy; override;

    procedure Generate(AGenerator: TCcCodeGenerator); override;
  end;


  TCcReturnStatement = class(TCcStatement)
  private
    FExpression: TCcExpression;
    FFunc: TObject;
  public
    constructor Create(
      APosition: TCcPosition; AExpr: TCcExpression;
      AFunc: TObject); reintroduce;
    destructor Destroy; override;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Expression: TCcExpression read FExpression;
  end;


  TCcIfStatement = class(TCcStatement)
  private
    FExpression: TCcExpression;
    FThenStmt: TCcStatement;
    FElseStmt: TCcStatement;
  public
    constructor Create(
      APosition: TCcPosition; AExpr: TCcExpression;
      AThen, AElse: TCcStatement); reintroduce;
    destructor Destroy; override;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Expression: TCcExpression read FExpression;
    property ThenStmt: TCcStatement read FThenStmt;
    property ElseStmt: TCcStatement read FElseStmt;
  end;


  TCcVarDeclStatement = class(TCcStatement)
  private
    FTable: TObject;
    FGenerated: boolean;
  public
    constructor Create(APosition: TCcPosition; ATable: TObject); reintroduce;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Table: TObject read FTable;
  end;


  TCcFuncDeclStatement = class(TCcStatement)
  private
    FFunc: TObject;
  public
    constructor Create(APosition: TCcPosition; AFunc: TObject); reintroduce;
    procedure Generate(AGenerator: TCcCodeGenerator); override;

    property Func: TObject read FFunc;
  end;


  function DoEval(AExpr: TCcExpression): TCcExpression;

  function BreakStmt: TCcStatement;
  function ContinueStmt: TCcStatement;

  procedure SymanticWarning(APos: TCcPosition; const AMsg: string);
  procedure SymanticError(
    APos: TCcPosition; const AMsg: string);
  procedure SymanticErrorFmt(
    APos: TCcPosition; const AFmt: string; const AArgs: array of const);


implementation

uses
  UCcSymbols, UCcSymanticConsts, UCcTokenizerConsts, UCcParserConsts,
  UCcCodeTemplate;

const
  ASSIGN_CMDS:
    array[TCcTokenAssignmentOperators] of TCcCommandType = (
      ctMov, ctImul, ctIdiv, ctNop, ctAdd, ctSub, ctShl, ctShr, ctAnd, ctXor,
      ctOr
    );

  COMPARE_CMDS:
    array[TCcTokenCompareOperators] of TCcCommandType = (
      ctSetL, ctSetG, ctSetE, ctSetLE, ctSetGE, ctSetNE
    );

  BINOP_CMDS:
    array[TCcTokenBinaryOperators] of TCcCommandType  = (
      ctAnd, ctOr, ctXor, ctAnd, ctOr, ctNop, ctNop, ctShl, ctShr,
      ctAdd, ctSub, ctIdiv, ctImul, ctNop
    );

  BINOP_FLOAT_CMDS:
    array[TCcTokenBinaryOperators] of TCcCommandType  = (
      ctAnd, ctOr, ctXor, ctAnd, ctOr, ctNop, ctNop, ctShl, ctShr,
      ctFadd, ctFsub, ctFdiv, ctFmul, ctNop
    );

  CMP_OPERATORS =
    [Low(TCcTokenCompareOperators)..High(TCcTokenCompareOperators)];
  BIN_OPERATORS =
    [Low(TCcTokenBinaryOperators)..High(TCcTokenBinaryOperators)];
  ASG_OPERATORS =
    [Low(TCcTokenAssignmentOperators)..High(TCcTokenAssignmentOperators)];


var
  BreakStatement: TCcControlStatement;
  ContinueStatement: TCcControlStatement;
  finaliz: boolean = false;

function CalcOffset(ATable: TCcSymTable; AVar: TCcSymVariable): integer;
begin
  if (AVar.Table <> ATable) then
    SymanticErrorFmt(
      CcPosition(0, 0), SCcSymanticInternalErrorFmt, [SCcInternalCO01]);

  if ATable.IsParams then
    Result := ATable.Offset + ATable.Size - AVar.Offset - AVar.Size
  else
    Result := ATable.Offset + AVar.Offset + AVar.Size;
end;


function DoEval(AExpr: TCcExpression): TCcExpression;
begin
  Result := AExpr.Evaluate;
  if (Result <> AExpr) then
    AExpr.Free;
end;


function BreakStmt: TCcStatement;
begin
  Result := BreakStatement;
end;


function ContinueStmt: TCcStatement;
begin
  Result := ContinueStatement;
end;


function CheckExpressionEx(AExpr: TCcExpression): boolean;
begin
  Result :=
    (
      (AExpr is TCcUnaryOperation) and
      (TCcUnaryOperation(AExpr).Operation = tstAnd)
    );
end;


procedure CheckExpression(AExpr: TCcExpression; APos: TCcPosition);
begin
  if CheckExpressionEx(AExpr) then
    SymanticError(APos, SCcSymanticUnacceptableSequance);
end;


function CheckType(AType: TCcSymType): TCcExpressionType;
begin
  if AType.IsType(TCcSymTypeInt) then
    Result := etIntegral
  else if AType.IsType(TCcSymTypeFloat) then
    Result := etFloat
  else
    Result := etOther;
end;


procedure SymanticWarning(APos: TCcPosition; const AMsg: string);
begin
  writeln(
    Format(
      '!Warning: ' + SCcErrorPrefix + '%s', [
        APos.Line, APos.Offset, AMsg]
    )
  );
end;


procedure SymanticError(APos: TCcPosition; const AMsg: string);
begin
  raise ECcSymanticException.Create(AMsg, APos);
end;


procedure SymanticErrorFmt(
  APos: TCcPosition; const AFmt: string; const AArgs: array of const);
begin
  raise ECcSymanticException.Create(Format(AFmt, AArgs), APos);
end;


{ TCcUnaryOperation }

constructor TCcUnaryOperation.Create(
  APosition: TCcPosition; AOperator: TCcTokenOperators;
  AArgument: TCcExpression; const AIsPostfix: boolean);
begin
  inherited Create(APosition);
  CheckExpression(AArgument, APosition);

  if
    (CheckExpressionEx(AArgument)) and
    (not (AOperator in [tstPlus, tstMinus])) and
    (AArgument.ResultType <> etIntegral)
  then
    SymanticError(APosition, SCcSymanticUnsupportedOpForType);

  FArgument := AArgument;
  FOperator := AOperator;
  FIsPostfix := AIsPostfix;
end;


destructor TCcUnaryOperation.Destroy;
begin
  FreeAndNil(FArgument);
  inherited;
end;


function TCcUnaryOperation.Evaluate: TCcExpression;
var
  arg, res: integer;
  fr: single;
begin
  Result := Self;
  if (Argument is TCcSyntaxConstInteger) then begin
    arg := TCcSyntaxConstInteger(Argument).Value;
    res := arg;
    case Operation of
      tstPlus:
        res := arg;
      tstMinus:
        res := -arg;
      tstInc:
        res := arg + 1;
      tstDec:
        res := arg - 1;
      tstNot:
        res := Ord(arg = 0);
      tstAddition:
        res := not arg;
    end;
    Result := TCcSyntaxConstInteger.Create(Position, res)
  end
  else if (Argument is TCcSyntaxConstFloat) then begin
    fr := TCcSyntaxConstFloat(Argument).Value;
    if Operation = tstMinus then
      fr := -fr;
    Result := TCcSyntaxConstFloat.Create(Position, fr);
  end;
end;


procedure TCcUnaryOperation.Generate(AGenerator: TCcCodeGenerator);
begin
  if (Operation in [tstInc..tstDec]) then begin
    if
      not (
        (Argument is TCcSyntaxVar) or (Argument is TCcItemSelectionOperation) or
        (Argument is TCcBinaryDelimOperation)
      )
    then
      SymanticError(Position, SCcSymanticLValueExpected);

    Argument.GenerateLValue(AGenerator);
    AGenerator.Gen(ctPop, 'eax');
    if IsPostfix then begin
      AGenerator.Gen(ctPush, 'dword ptr [eax]');
      if Operation = tstInc then
        AGenerator.Gen(ctInc, 'dword ptr [eax]')
      else
        AGenerator.Gen(ctDec, 'dword ptr [eax]');
    end
    else begin
      if Operation = tstInc then
        AGenerator.Gen(ctInc, 'eax')
      else
        AGenerator.Gen(ctDec, 'eax');
      AGenerator.Gen(ctPush, 'eax');
    end;
  end
  else if (Operation in [tstPlus, tstMinus, tstAddition, tstNot]) then begin
    Argument.Generate(AGenerator);
    if Argument.ResultType = etIntegral then begin
      AGenerator.Gen(ctPop, 'eax');
      case Operation of
        tstPlus:;
        tstMinus:
          AGenerator.Gen(ctNeg, 'eax');
        tstAddition: AGenerator.Gen(ctNot, 'eax');
        tstNot:
          begin
            AGenerator.Gen(ctCmp, 'eax', '0');
            AGenerator.Gen(ctSetE, 'eax');
          end;
      end;
      AGenerator.Gen(ctPush, 'eax');
    end
    else if Argument.ResultType = etFloat then begin
      if Operation = tstMinus then
        with AGenerator do begin
          Gen(ctFld, 'dword ptr [esp]');
          Gen(ctFchs);
          Gen(ctFstp, 'dword ptr [esp]');
        end;
    end
  end
  else
    Argument.GenerateLValue(AGenerator);
end;


function TCcUnaryOperation.ResultType: TCcExpressionType;
begin
  Result := Argument.ResultType;
end;


{ TCcBinaryOperation }

constructor TCcBinaryOperation.Create(
  APosition: TCcPosition; AOperator: TCcTokenOperators;
  ALeft, ARight: TCcExpression);
begin
  inherited Create(APosition, ALeft, ARight);
  FOperator := AOperator;

  if
    (
      (ALeft.ResultType = etFloat) or (ARight.ResultType = etFloat)
    ) and (Operation in [tstAnd..tstBitOr, tstShl, tstShr, tstRemAssign])
  then
    SymanticError(APosition, SCcSymanticUnsupportedOpForType);
end;


function TCcBinaryOperation.Evaluate: TCcExpression;
var
  lv, rv: integer;
  lvf, rvf: single;
  res: integer;
begin
  Result := Self;
  if
    (Left is TCcSyntaxConstInteger) and (Right is TCcSyntaxConstInteger)
  then begin
    lv := TCcSyntaxConstInteger(Left).Value;
    rv := TCcSyntaxConstInteger(Right).Value;
    res := 0;

    if (Operation in CMP_OPERATORS) or (Operation in BIN_OPERATORS) then begin
      case Operation of
        tstLess:
          res := Ord(lv < rv);
        tstGreater:
          res := Ord(lv > rv);
        tstEqual:
          res := Ord(lv = rv);
        tstLessEqual:
          res := Ord(lv <= rv);
        tstGreatEqual:
          res := Ord(lv >= rv);
        tstNotEqual:
          res := Ord(lv <> rv);
        tstAnd, tstBitAnd:
          res := lv and rv;
        tstOr, tstBitOr:
          res := lv or rv;
        tstShl:
          res := lv shl rv;
        tstShr:
          res := lv shr rv;
        tstPlus:
          res := lv + rv;
        tstMinus:
          res := lv - rv;
        tstMul:
          res := lv * rv;
        tstRemainder:
          res := lv mod rv;
      end;
      Result := TCcSyntaxConstInteger.Create(Position, res);
    end;
  end
  else if
    (
      (Left is TCcSyntaxConstInteger) and (Right is TCcSyntaxConstFloat)
    ) or (
      (Left is TCcSyntaxConstFloat) and (Right is TCcSyntaxConstInteger)
    ) or (
      (Left is TCcSyntaxConstFloat) and (Right is TCcSyntaxConstFloat)
    )
  then begin
    if Left is TCcSyntaxConstInteger then
      lvf := TCcSyntaxConstInteger(Left).Value
    else
      lvf := TCcSyntaxConstFloat(Left).Value;

    if Right is TCcSyntaxConstInteger then
      rvf := TCcSyntaxConstInteger(Right).Value
    else
      rvf := TCcSyntaxConstFloat(Right).Value;

    res := 0;
    case Operation of
      tstLess:
        res := Ord(lvf < rvf);
      tstGreater:
        res := Ord(lvf > rvf);
      tstEqual:
        res := Ord(lvf = rvf);
      tstLessEqual:
        res := Ord(lvf <= rvf);
      tstGreatEqual:
        res := Ord(lvf >= rvf);
      tstNotEqual:
        res := Ord(lvf <> rvf);
    end;
    Result := TCcSyntaxConstInteger.Create(Position, res);
  end;
end;


procedure TCcBinaryOperation.Generate(AGenerator: TCcCodeGenerator);
begin
  inherited;
  TemplateManager.Generate(AGenerator, Position, Left, Right, Operation);
end;


function TCcBinaryOperation.OperationStr: string;
begin
  Result := OPER_VALUES[FOperator];
end;


function TCcBinaryOperation.ResultType: TCcExpressionType;
begin
  if
    (
      (Left.ResultType = etFloat) or (Right.ResultType = etFloat)
    ) and not (Operation in CMP_OPERATORS)
  then
    Result := etFloat
  else
    Result := etIntegral;
end;


{ TCcSyntaxVar }

constructor TCcSyntaxVar.Create(
  APosition: TCcPosition; const AName: string; AVariable: TObject);
begin
  inherited Create(APosition);
  FName := AName;
  FVariable := AVariable as TCcSymVariable;
end;


procedure TCcSyntaxVar.Generate(AGenerator: TCcCodeGenerator);
const
  SHIFT_OP: array[boolean] of char = ('-', '+');

var
  offset: integer;
  v: TCcSymVariable;
begin
  if (FVariable = nil) or (TCcSymVariable(FVariable).Table.Parent = nil) then begin
    AGenerator.Gen(ctPush, FormatVarName(Name));
  end
  else begin
    v := TCcSymVariable(FVariable);
    offset := CalcOffset(v.Table, v);
    if v.ValType.IsType(TCcSymTypePointer) then begin
      AGenerator.Gen(ctMov, 'eax', Format('dword ptr [ebp %s %d]', [SHIFT_OP[v.Table.IsParams], Offset]));
      AGenerator.Gen(ctPush, 'dword ptr [eax]');
    end
    else
      AGenerator.Gen(ctPush, Format('dword ptr [ebp %s %d]', [SHIFT_OP[v.Table.IsParams], Offset]));
  end;
end;


procedure TCcSyntaxVar.GenerateLValue(AGenerator: TCcCodeGenerator);
const
  SHIFT_OP: array[boolean] of char = ('-', '+');
  SHIFT_OP_EX: array[boolean] of TCcCommandType = (ctSub, ctAdd);

var
  offset: integer;
  v: TCcSymVariable;
begin
  if (FVariable = nil) or (TCcSymVariable(FVariable).Table.Parent = nil) then begin
    AGenerator.Gen(ctPush, 'OFFSET ' + FormatVarName(Name));
  end
  else begin
    v := TCcSymVariable(FVariable);
    offset := CalcOffset(v.Table, v);
    if v.ValType.IsType(TCcSymTypePointer) then
      AGenerator.Gen(ctPush, Format('dword ptr [ebp %s %d]', [SHIFT_OP[v.Table.IsParams], Offset]))
    else begin
      AGenerator.Gen(ctMov, 'eax', 'ebp');
      AGenerator.Gen(SHIFT_OP_EX[v.Table.IsParams], 'eax', IntToStr(Offset));
      AGenerator.Gen(ctPush, 'eax');
    end;
  end;
end;


function TCcSyntaxVar.ResultType: TCcExpressionType;
begin
  Result := CheckType(TCcSymVariable(Variable).ValType);
end;


function TCcSyntaxVar.Size: integer;
begin
  Result := TCcSymVariable(Variable).Size;
end;


{ TCcSyntaxConstInteger }

constructor TCcSyntaxConstInteger.Create(
  APosition: TCcPosition; const AValue: integer);
begin
  inherited Create(APosition);
  FValue := AValue;
end;


procedure TCcSyntaxConstInteger.Generate(AGenerator: TCcCodeGenerator);
begin
  AGenerator.Gen(
    ctPush, 'dword ptr ' + IntToStr(Value)).Comment := 'Integer constant';
end;


function TCcSyntaxConstInteger.ResultType: TCcExpressionType;
begin
  Result := etIntegral;
end;


{ TCcSyntaxConstFloat }

constructor TCcSyntaxConstFloat.Create(
  APosition: TCcPosition; const AValue: single);
begin
  inherited Create(APosition);
  FValue := AValue;
end;


procedure TCcSyntaxConstFloat.Generate(AGenerator: TCcCodeGenerator);
var
  i: ^LongWord;
begin
  i := @FValue;
  AGenerator.Gen(
    ctPush,
    Format(
      'dword ptr 0%sh', [IntToHex(i^, 8)]
    )
  ).Comment := Format('Floating-point constant %f', [FValue]);
end;


function TCcSyntaxConstFloat.ResultType: TCcExpressionType;
begin
  Result := etFloat;
end;


{ TCcSyntaxConstString }

constructor TCcSyntaxConstString.Create(
  APosition: TCcPosition; const AValue: string; AGenerator: TCcCodeGenerator);

  function correctStr(const a: string): string;
  const
    LAST_SPEC_CHAR: array[boolean] of string = (', ', '');

  var
    state: (csNone, csWasNormal, csWasSpecial);
    i: integer;
    len: integer;
  begin
    Result := '';
    state := csNone;
    len := Length(a);
    for i := 1 to len do
      if a[i] < #32 then begin
        case state of
          csNone:
            Result := IntToStr(Ord(a[i])) + LAST_SPEC_CHAR[i = len];
          csWasNormal:
            Result := Result + ''', ' + IntToStr(Ord(a[i])) + LAST_SPEC_CHAR[i = len];
          csWasSpecial:
            Result := Result + IntToStr(Ord(a[i])) + LAST_SPEC_CHAR[i = len];
        end;
        state := csWasSpecial;
      end
      else begin
        case state of
          csNone:
            Result := '''' + a[i];
          csWasNormal:
            Result := Result + a[i];
          csWasSpecial:
            Result := Result + '''' + a[i];
        end;
        state := csWasNormal;
      end;
    case state of
      csNone:
        Result := '0';
      csWasNormal:
        Result := Result + ''', 0';
      csWasSpecial:
        Result := Result + ', 0';
    end;
  end;

begin
  inherited Create(APosition);
  FValue := correctStr(AValue);
  FName := AGenerator.GenerateStrConst;
  AGenerator.Gen(Format('  %s db %s', [FName, Value]), true);
end;


procedure TCcSyntaxConstString.Generate(AGenerator: TCcCodeGenerator);
begin
  AGenerator.Gen(ctPush, Format('OFFSET [%s]', [Name])).Comment := 'String constant';
end;


{ TCcSyntaxObject }

constructor TCcSyntaxObject.Create(APosition: TCcPosition);
begin
  FPosition := APosition;
end;


procedure TCcSyntaxObject.Generate(AGenerator: TCcCodeGenerator);
begin
end;


{ TCcConditionOperation }

constructor TCcConditionOperation.Create(
  APosition: TCcPosition; ACondition, ATrue, AFalse: TCcExpression);
begin
  inherited Create(APosition);
  FCondition := ACondition;
  FTrue := ATrue;
  FFalse := AFalse;

  if (FTrue.ResultType <> FFalse.ResultType) then
    SymanticError(APosition, SCcSymanticConditionArgsType);

  CheckExpression(FCondition, APosition);
  CheckExpression(FTrue, APosition);
  CheckExpression(FFalse, APosition);
end;


destructor TCcConditionOperation.Destroy;
begin
  FreeAndNil(FCondition);
  FreeAndNil(FTrue);
  FreeAndNil(FFalse);
  inherited;
end;


function TCcConditionOperation.Evaluate: TCcExpression;
var
  v: integer;
begin
  Result := Self;
  if not (Condition is TCcSyntaxConstInteger) then
    Exit;
  v := TCcSyntaxConstInteger(Condition).Value;
  if (v > 0) then
    Result := DoEval(TrueExpr)
  else
    Result := DoEval(FalseExpr);
end;


function TCcConditionOperation.ResultType: TCcExpressionType;
begin
  Result := FTrue.ResultType;
end;


{ TCcAbstractBinaryOperation }

constructor TCcAbstractBinaryOperation.Create(
  APosition: TCcPosition; ALeft, ARight: TCcExpression);
begin
  inherited Create(APosition);
  FLeft := ALeft;
  FRight := ARight;

  CheckExpression(FLeft, APosition);
  CheckExpression(FRight, APosition);
end;


destructor TCcAbstractBinaryOperation.Destroy;
begin
  FreeAndNil(FLeft);
  FreeAndNil(FRight);
  inherited;
end;


{ TCcBinaryDelimOperation }

constructor TCcBinaryDelimOperation.Create(
  APosition: TCcPosition; AOperator: TCcTokenDelimiters;
  ALeft, ARight: TCcExpression; ATableStack: TObject);
begin
  inherited Create(APosition, ALeft, ARight);
  FOperator := AOperator;
  FTableStack := ATableStack;
end;


procedure TCcBinaryDelimOperation.Generate(AGenerator: TCcCodeGenerator);
begin
  GenerateLValue(AGenerator);
  AGenerator.Gen(ctPop, 'eax').Comment := 'Right operand address';
  AGenerator.Gen(ctPush, 'dword ptr [eax]').Comment := 'Left operand value';
end;


procedure TCcBinaryDelimOperation.GenerateLValue(AGenerator: TCcCodeGenerator);
begin
  case FOperator of
    tstDot:
      begin
        Left.GenerateLValue(AGenerator);
        Right.GenerateLValue(AGenerator);
      end;
  end;
end;


function TCcBinaryDelimOperation.OperationStr: string;
begin
  Result := DELIM_VALUES[FOperator];
end;


function TCcBinaryDelimOperation.ResultType: TCcExpressionType;
begin
  Result := Right.ResultType;
end;


{ TCcFuncCall }

procedure TCcFuncCall.AddArgument(A: TCcExpression);
begin
  FArguments.Add(A);
end;


function TCcFuncCall.CleansStack: Boolean;
begin
  Result := (Name = 'putn') or ((Symbol as TCcSymFunc).Return = SymVoid);
end;


constructor TCcFuncCall.Create(
  APosition: TCcPosition; const AName: string; ASymbol: TObject);
begin
  inherited Create(APosition);
  FName := AName;
  FArguments := TList.Create;
  FSymbol := ASymbol;
end;


destructor TCcFuncCall.Destroy;
var
  i: integer;
  ex: TCcExpression;
begin
  for i := 0 to FArguments.Count - 1 do begin
    ex := TCcExpression(FArguments[i]);
    FreeAndNil(ex);
  end;
  FreeAndNil(FArguments);
  inherited;
end;


procedure TCcFuncCall.DoIntToFloatTranform(AGenerator: TCcCodeGenerator);
begin
  AGenerator.Gen(ctFild, 'dword ptr [esp]');
  AGenerator.Gen(ctFstp, 'dword ptr [esp]');
end;


procedure TCcFuncCall.Generate(AGenerator: TCcCodeGenerator);
var
  i: integer;
  resSize: integer;
  s: TCcSymFunc;

  procedure prepareArgument(AIndex: integer);
  var
    expr: TCcExpression;
    r: boolean;
  begin
    if
      (Name = 'printf') and
      (TCcExpression(FArguments[i]) is TCcSyntaxConstString)
    then
      Exit
    else if
      (Name <> 'printf') and
      ((s.Params[i] as TCcSymVariable).ValType.IsType(TCcSymTypePointer))
    then begin
      expr := TCcExpression(FArguments[i]);
      r := CheckExpressionEx(expr);
      if
        not (
          r or
          (
            (expr is TCcSyntaxVar) and
            (
              TCcSymVariable(TCcSyntaxVar(expr).Variable).ValType.IsType(TCcSymTypePointer)
            )
          )
        )
      then
        SymanticError(Position, SCcSymanticAddressExpr);

      if
        (expr is TCcUnaryOperation) and
        (TCcUnaryOperation(expr).Operation = tstAnd) and
        (TCcUnaryOperation(expr).Argument is TCcSyntaxVar) and
        (
          TCcSymVariable(
            TCcSyntaxVar(
              TCcUnaryOperation(expr).Argument
            ).Variable
          ).ValType.IsType(TCcSymTypePointer)
        )
      then
        SymanticWarning(expr.Position, SCcSymanticUnwantedResult);

      if r then
        TCcExpression(FArguments[i]).Generate(AGenerator)
      else
        TCcExpression(FArguments[i]).GenerateLValue(AGenerator);
    end
    else
      TCcExpression(FArguments[i]).Generate(AGenerator);

    if
      (Name <> 'printf') and
      (TCcExpression(FArguments[i]).ResultType = etIntegral) and
      (s.Params[i] as TCcSymVariable).ValType.IsType(TCcSymTypeFloat)
    then
      DoIntToFloatTranform(AGenerator);
  end;

begin
  s := Symbol as TCcSymFunc;
  resSize := s.Return.Size;
  if (Name = 'main') and not (s.Return is TCcSymTypeInt) then
    SymanticError(Position, SCcSymanticMainReturnType);

  if (resSize > 0) and (Name <> 'random') then
    AGenerator.Gen(ctSub, 'esp', IntToStr(resSize));

  if (Name <> 'printf') and (FArguments.Count <> s.Params.RealCount) then
    SymanticError(Position, SCcSymanticWrongArgumentsCount);

  if Name = 'printf' then
    for i := FArguments.Count - 1 downto 0 do
      prepareArgument(i)
  else
    for i := 0 to FArguments.Count - 1 do
      prepareArgument(i);

  if (Name = 'putn') then begin
    if (Arguments.Count <> 1) then
      SymanticError(Position, SCcSymanticWrongArgumentsCount);

    AGenerator.Gen(ctPop, 'eax');
    AGenerator.Gen(ctInvoke, 'ltoa, eax, ADDR textbuf2');
    AGenerator.Gen('  Print_Text textbuf2');
  end
  else if (Name = 'putfl') then begin
    if (Arguments.Count <> 1) then
      SymanticError(Position, SCcSymanticWrongArgumentsCount);
    AGenerator.Gen(ctInvoke, 'PrintFloat');
    AGenerator.Gen(ctPop, 'eax');
  end
  else if (Name = 'sqrt') then begin
    AGenerator.Gen(ctFld, 'DWORD PTR [esp]');
    AGenerator.Gen(ctFsqrt);
    AGenerator.Gen(ctFstp, 'DWORD PTR [esp]');
  end
  else if (Name = 'trunc') then begin
    AGenerator.Gen(ctFld, 'DWORD PTR [esp]');
    AGenerator.Gen(ctFistp, 'DWORD PTR [esp]');
  end
  else if (Name = '_float') then begin
    AGenerator.Gen(ctFild, 'DWORD PTR [esp]');
    AGenerator.Gen(ctFstp, 'DWORD PTR [esp]');
  end
  else if (Name = 'printf') then begin
    if not (TCcExpression(Arguments[0]) is TCcSyntaxConstString) then
      SymanticError(Position, SCcStringConstantExpected);

    AGenerator.Gen(ctPush, 'OFFSET ' + TCcSyntaxConstString(FArguments[0]).Name);
    AGenerator.Gen(ctPush, 'OFFSET textbuf2');
    AGenerator.Gen(ctCall, 'wsprintf');
    AGenerator.Gen('  Print_Text textbuf2');
    AGenerator.Gen(ctAdd, 'esp', IntToStr(s.Params.RealSize + 8));
  end
  else if (Name = 'puttext') then begin
    if (Arguments.Count <> 1) then
      SymanticError(Position, SCcSymanticWrongArgumentsCount);

    AGenerator.Gen(ctPop, 'edx');
    AGenerator.Gen(ctInvoke, 'StdOut, edx');
  end
  else if (Name = 'randomize') then begin
    AGenerator.Gen(ctInvoke, 'GetTickCount');
    AGenerator.Gen(ctInvoke, 'nseed, eax');
  end
  else if (Name = 'random') then begin
    if (Arguments.Count <> 1) then
      SymanticError(Position, SCcSymanticWrongArgumentsCount);

    if TCcExpression(FArguments[0]).ResultType <> etIntegral then
      SymanticError(Position, SCcSymanticIncompatibleTypes);

    AGenerator.Gen(ctPop, 'eax');
    AGenerator.Gen(ctInvoke, 'nrandom, eax');
    AGenerator.Gen(ctPush, 'eax');
  end
  else begin
    AGenerator.Gen(ctCall, FormatProcName(Name));
    AGenerator.Gen(ctAdd, 'esp', IntToStr(s.Params.RealSize - resSize));
  end;
end;


function TCcFuncCall.ResultType: TCcExpressionType;
begin
  Result := CheckType(TCcSymFunc(Symbol).Return);
end;


{ TCcItemSelectionOperation }

constructor TCcItemSelectionOperation.Create(
  APosition: TCcPosition; AName, AIndex: TCcExpression; AType: TObject);
begin
  inherited Create(APosition);
  FName := AName;
  FIndex := AIndex;
  FType := AType;

  CheckExpression(FName, APosition);
  CheckExpression(FIndex, APosition);

  if (FName is TCcItemSelectionOperation) then
    FDimension := TCcItemSelectionOperation(FName).Dimension + 1
  else
    FDimension := 0;
end;


destructor TCcItemSelectionOperation.Destroy;
begin
  FreeAndNil(FName);
  FreeAndNil(FIndex);
  inherited;
end;


procedure TCcItemSelectionOperation.Generate(AGenerator: TCcCodeGenerator);
begin
  GenerateLValue(AGenerator);
  AGenerator.Gen(ctPop, 'eax').Comment := 'Item selection address';
  AGenerator.Gen(ctMov, 'eax', '[eax]');
  AGenerator.Gen(ctPush, 'eax').Comment := 'Item-selection value';
end;


procedure TCcItemSelectionOperation.GenerateLValue(
  AGenerator: TCcCodeGenerator);
begin
  Index.Generate(AGenerator);
  Name.GenerateLValue(AGenerator);
  AGenerator.Gen(ctPop, 'eax').Comment := 'Name address';
  AGenerator.Gen(ctPop, 'ebx').Comment := 'Index';
  AGenerator.Gen(ctImul, 'ebx', IntToStr(Size));
  AGenerator.Gen(ctAdd, 'eax', 'ebx');
  AGenerator.Gen(ctPush, 'eax').Comment := 'Item address';
end;


function TCcItemSelectionOperation.LValueType: TObject;
begin
  Result := FType;
end;


function TCcItemSelectionOperation.ResultType: TCcExpressionType;
begin
  Result := CheckType(LValueType as TCcSymType);
end;


function TCcItemSelectionOperation.Size: integer;
begin
  Result := (LValueType as TCcSymType).Size;
end;


{ TCcExprStatement }

constructor TCcExprStatement.Create(
  APosition: TCcPosition; AExpr: TCcExpression);
begin
  FExpression := AExpr;
end;


destructor TCcExprStatement.Destroy;
begin
  FreeAndNil(FExpression);
  inherited;
end;


procedure TCcExprStatement.Generate(AGenerator: TCcCodeGenerator);
begin
  inherited;
  Expression.Generate(AGenerator);
  if not Expression.CleansStack then
    AGenerator.Gen(ctPop, 'eax').Comment := 'Cleaning stack after expression';
end;


{ TCcWhileStatement }

constructor TCcWhileStatement.Create(
  APosition: TCcPosition; AExpr: TCcExpression; AStatement: TCcStatement);
begin
  inherited Create(APosition);
  FExpression := AExpr;
  FStatement := AStatement;

  CheckExpression(FExpression, APosition);
end;


destructor TCcWhileStatement.Destroy;
begin
  FreeAndNil(FExpression);
  FreeAndNil(FStatement);
  inherited;
end;


procedure TCcWhileStatement.Generate(AGenerator: TCcCodeGenerator);
var
  lStart: string;
  lEnd: string;
begin
  lStart := AGenerator.GenerateLabel(ltWhile, true, '"While" start');
  lEnd := AGenerator.GenerateLabel(ltWhile, false);
  AGenerator.InitControlBlock(lEnd, lStart);
  Expression.Generate(AGenerator);
  AGenerator.Gen(ctPop, 'eax');
  AGenerator.Gen(ctTest, 'eax', 'eax');
  AGenerator.Gen(ctJz, lEnd);
  Statement.Generate(AGenerator);
  AGenerator.Gen(ctJmp, lStart);
  AGenerator.OutputLabel(lEnd, '"While" end');
end;


{ TCcBlockStatement }

procedure TCcBlockStatement.AddStatement(AStmt: TCcStatement);
begin
  FStatements.Add(AStmt);
end;


constructor TCcBlockStatement.Create(APosition: TCcPosition);
begin
  inherited Create(APosition);
  FStatements := TList.Create;
end;


destructor TCcBlockStatement.Destroy;
var
  i: integer;
  st: TCcStatement;
begin
  for i := 0 to FStatements.Count - 1 do begin
    st := TCcStatement(FStatements[i]);
    FreeAndNil(st);
  end;
  FreeAndNil(FStatements);
  inherited;
end;


procedure TCcBlockStatement.Generate(AGenerator: TCcCodeGenerator);
var
  i: integer;
begin
  inherited;
  for i := 0 to FStatements.Count - 1 do
    TCcStatement(FStatements[i]).Generate(AGenerator);
end;


{ TCcEmptyStatement }

procedure TCcEmptyStatement.Generate(AGenerator: TCcCodeGenerator);
begin
end;


{ TCcDoWhileStatement }

procedure TCcDoWhileStatement.Generate(AGenerator: TCcCodeGenerator);
var
  lStart: string;
  lEnd: string;
begin
  lStart := AGenerator.GenerateLabel(ltDoWhile, true, '"Do While" start');
  lEnd := AGenerator.GenerateLabel(ltDoWhile, false);
  AGenerator.InitControlBlock(lEnd, lStart);
  Statement.Generate(AGenerator);
  Expression.Generate(AGenerator);
  AGenerator.Gen(ctPop, 'eax');
  AGenerator.Gen(ctTest, 'eax', 'eax');
  AGenerator.Gen(ctJz, lEnd);
  AGenerator.Gen(ctJmp, lStart);
  AGenerator.OutputLabel(lEnd, '"Do While" end');
end;


{ TCcForStatement }

constructor TCcForStatement.Create(
  APosition: TCcPosition; AExpr1, AExpr2, AExpr3: TCcExpression;
  AStmt: TCcStatement);
begin
  FExpr1 := AExpr1;
  FExpr2 := AExpr2;
  FExpr3 := AExpr3;
  FStatement := AStmt;

  CheckExpression(FExpr1, APosition);
  CheckExpression(FExpr2, APosition);
  CheckExpression(FExpr3, APosition);
end;


destructor TCcForStatement.Destroy;
begin
  FreeAndNil(FExpr1);
  FreeAndNil(FExpr2);
  FreeAndNil(FExpr3);
  FreeAndNil(FStatement);
  inherited;
end;


procedure TCcForStatement.Generate(AGenerator: TCcCodeGenerator);
var
  l1, l2, l3: string;
begin
  Expr1.Generate(AGenerator);
  if not Expr1.CleansStack then
    AGenerator.Gen(ctPop, 'eax');
  with AGenerator do begin
    l1 := GenerateLabel(ltFor, true, '"For" start');
    l2 := GenerateLabel(ltFor, false);
    l3 := GenerateLabel(ltFor, false);
    InitControlBlock(l3, l2);
    Expr2.Generate(AGenerator);
    Gen(ctPop, 'eax').Comment := '"For" condition';
    Gen(ctTest, 'eax', 'eax');
    Gen(ctJz, l3).Comment := 'If condition is false, exit from "For"';
    Statement.Generate(AGenerator);
    OutputLabel(l2, 'For continue');
    Expr3.Generate(AGenerator);
    if not Expr3.CleansStack then
      AGenerator.Gen(ctPop, 'eax');
    Gen(ctJmp, l1).Comment := 'Jump to "For" start';
    OutputLabel(l3, 'For break');
    FinishControlBlock;
  end;
end;


{ TCcIfStatement }

constructor TCcIfStatement.Create(
  APosition: TCcPosition; AExpr: TCcExpression; AThen, AElse: TCcStatement);
begin
  inherited Create(APosition);
  FExpression := AExpr;
  FThenStmt := AThen;
  FElseStmt := AElse;

  CheckExpression(FExpression, APosition);
end;


destructor TCcIfStatement.Destroy;
begin
  FreeAndNil(FExpression);
  FreeAndNil(FThenStmt);
  FreeAndNil(FElseStmt);
  inherited;
end;


procedure TCcIfStatement.Generate(AGenerator: TCcCodeGenerator);
var
  lExit, lElse: string;
begin
  with AGenerator do begin
    lElse := GenerateLabel(ltIf, false);
    lExit := GenerateLabel(ltIf, false);
    Expression.Generate(AGenerator);
    Gen(ctPop, 'eax');
    Gen(ctTest, 'eax', 'eax');
    Gen(ctJz, lElse).Comment := 'If condition is not true, jump to "else"';
    ThenStmt.Generate(AGenerator);
    Gen(ctJmp, lExit).Comment := 'Exit from "If"';
    OutputLabel(lElse, '"Else"');
    ElseStmt.Generate(AGenerator);
    OutputLabel(lExit, 'exit from "If"');
  end;
end;


{ TCcVarDeclStatement }

constructor TCcVarDeclStatement.Create(APosition: TCcPosition; ATable: TObject);
begin
  FTable := ATable;
  FGenerated := false;
end;


procedure TCcVarDeclStatement.Generate(AGenerator: TCcCodeGenerator);
begin
  if not FGenerated and not (Table as TCcSymTable).IsParams then begin
    (Table as TCcSymTable).Generate(AGenerator);
    FGenerated := true;
  end;
end;


{ TCcExpression }

function TCcExpression.CleansStack: boolean;
begin
  Result := false;
end;


function TCcExpression.Evaluate: TCcExpression;
begin
  Result := Self;
end;


procedure TCcExpression.GenerateLValue(AGenerator: TCcCodeGenerator);
begin
end;


function TCcExpression.ResultType: TCcExpressionType;
begin
  Result := etOther;
end;


function TCcExpression.Size: integer;
begin
  Result := 0;
end;


{ TCcFuncDeclStatement }

constructor TCcFuncDeclStatement.Create(APosition: TCcPosition; AFunc: TObject);
begin
  FFunc := AFunc;
end;


procedure TCcFuncDeclStatement.Generate(AGenerator: TCcCodeGenerator);
begin
  (FFunc as TCcSymFunc).Generate(AGenerator);
end;


{ TCcReturnStatement }

constructor TCcReturnStatement.Create(
  APosition: TCcPosition; AExpr: TCcExpression; AFunc: TObject);
begin
  inherited Create(APosition);
  FExpression := AExpr;
  FFunc := AFunc;

  CheckExpression(FExpression, APosition);
end;


destructor TCcReturnStatement.Destroy;
begin
  FreeAndNil(FExpression);
  inherited;
end;


procedure TCcReturnStatement.Generate(AGenerator: TCcCodeGenerator);
var
  func: TCcSymFunc;
  res: TCcSymVariable;
begin
  func := FFunc as TCcSymFunc;
  if (func.Return <> SymVoid) then begin
    Expression.Generate(AGenerator);
    AGenerator.Gen(ctPop, 'eax');
    res := TCcSymVariable(
      func.Params.Find(Position, '%%result', TCcSymVariable, false));
    AGenerator.Gen(ctMov, 'ebx', 'ebp').Comment := 'Setting return value';
    AGenerator.Gen(ctAdd, 'ebx', IntToStr(CalcOffset(func.Params, res)));
    AGenerator.Gen(ctMov, '[ebx]', 'eax')
  end;
  AGenerator.Gen(ctJmp, AGenerator.CurrentReturnLabel);
end;


{ TCcControlStatement }

constructor TCcControlStatement.Create(
  APosition: TCcPosition; AType: TCcControlStatementType);
begin
  FControlType := AType;
end;


destructor TCcControlStatement.Destroy;
begin
  if not finaliz then
    Exit;
    
  inherited;
end;


procedure TCcControlStatement.Generate(AGenerator: TCcCodeGenerator);
begin
  case FControlType of
    cstBreak:
      AGenerator.GenBreak;
    cstContinue:
      AGenerator.GenContinue;
  end;
end;


{ TCcSyntaxStructField }

procedure TCcSyntaxStructField.Generate(AGenerator: TCcCodeGenerator);
begin
  GenerateValInEax(AGenerator);
  AGenerator.Gen(ctPush, 'dword ptr [eax]').Comment := 'Struct field value';
end;


procedure TCcSyntaxStructField.GenerateLValue(AGenerator: TCcCodeGenerator);
begin
  GenerateValInEax(AGenerator);
  AGenerator.Gen(ctPush, 'eax').Comment := Format('Address of field %s', [Name]);
end;


procedure TCcSyntaxStructField.GenerateValInEax(
  AGenerator: TCcCodeGenerator);
var
  v: TCcSymVariable;
  offset: integer;
begin
  v := TCcSymVariable(Variable);
  offset := v.Offset;
  AGenerator.Gen(ctPop, 'eax').Comment := 'Getting address of structure start';
  AGenerator.Gen(
    ctAdd, 'eax', IntToStr(offset)).Comment := Format(
      'Calculating offset of field "%s"', [Name]
    );
end;


initialization
  BreakStatement :=
    TCcControlStatement.Create(CcPosition(0, 0), cstBreak);
  ContinueStatement :=
    TCcControlStatement.Create(CcPosition(0, 0), cstContinue);

finalization
  finaliz := true;
  ContinueStatement.Free;
  BreakStatement.Free;

end.
Соседние файлы в папке Parser