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

{
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.