unit Zc;




{==============================================================================
Zc
1.0.0.116
Date of Generation: 2006-05-09 16:41
Comment: Zc
Author: Ville Krumlinde
Copyright: 

This unit was generated by Coco/R for Delphi (www.tetzel.com)  Any code in
this file that you edit manually will be over-written when the file is
regenerated.
==============================================================================}

interface
uses  SysUtils,Classes,CocoBase,contnrs,mwStringHashList;



const
maxT = 71;
type
TZcAssignType = (atAssign,atMulAssign,atDivAssign,atPlusAssign,atMinusAssign);
  TZcOpKind = (zcNop,zcMul,zcDiv,zcPlus,zcMinus,zcConst,zcIdentifier,zcAssign,zcIf,
          zcCompLT,zcCompGT,zcCompLE,zcCompGE,zcCompNE,zcCompEQ,
          zcBlock,zcNegate,zcOr,zcAnd,zcFuncCall,zcReturn);

  TZcOp = class
  public
    Kind : TZcOpKind;
    Value : single;
    Id : string;
    Children : TObjectList;
    constructor Create;
    destructor Destroy; override;
    function ToString : string;
    function Child(I : integer) : TZcOp;
    procedure Optimize;
  end;


  SymbolSet = array[0..maxT div setsize] of TBitSet;

  EZc = class(Exception);
  TZc = class;

  TZcScanner = class(TCocoRScanner)
  private
    FOwner : TZc;
fHashList: TmwStringHashList;
function CharInIgnoreSet(const Ch : char) : boolean;
procedure CheckLiteral(var Sym : integer);
function GetNextSymbolString: string;
    function Comment : boolean;
  protected
    procedure NextCh; override;
  public
    constructor Create;
destructor Destroy; override;

    procedure Get(var sym : integer); override; // Gets next symbol from source file

    property CurrentSymbol;
    property NextSymbol;
    property OnStatusUpdate;
    property Owner : TZc read fOwner write fOwner;
    property ScannerError;
    property SrcStream;
  end;  { TZcScanner }

  TZc = class(TCocoRGrammar)
  private
    { strictly internal variables }
    symSet : array[0..4] of SymbolSet; // symSet[0] = allSyncSyms

    function GetBuildDate : TDateTime;
    function GetVersion : string;
    function GetVersionStr : string;
    procedure SetVersion(const Value : string);
    function GetVersionInfo : string;
    function _In(var s : SymbolSet; x : integer) : boolean;
    procedure InitSymSet;

    {Production methods}
    procedure _Literal;
    procedure _Primary (var OutOp : TZcOp);
    procedure _MulExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _AddExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _ShiftExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _RelExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _EqlExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _BitAndExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _BitXorExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _BitOrExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _AndExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _OrExpr (InOp : TZcOp; var OutOp : TZcOp);
    procedure _AssignOp (var Kind : TZcAssignType);
    procedure _Unary (var OutOp : TZcOp);
    procedure _StatementExpr (var OutOp : TZcOp);
    procedure _Block (var OutOp : TZcOp);
    procedure _Statement (var OutOp : TZcOp);
    procedure _Expr (var OutOp : TZcOp);
    procedure _Argument (var OutOp : TZcOp);
    procedure _EmbeddedStatement (var OutOp : TZcOp);
    procedure _Zc;

  private
    procedure WriteStr(S : string);
    procedure WriteOp(Op : TZcOp);
    procedure AddGlobalStatement(Op : TZcOp);
    procedure CleanUp;

  protected
    { Protected Declarations }
    procedure Get; override;
  public
    { Public Declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    function ErrorStr(const ErrorCode : integer; const Data : string) : string; override;
    procedure Execute;
    function GetScanner : TZcScanner;
    procedure Parse;

    property ErrorList;
    property ListStream;
    property SourceStream;
    property Successful;
    property BuildDate : TDateTime read GetBuildDate;
    property VersionStr : string read GetVersionStr;
    property VersionInfo : string read GetVersionInfo;

  public
    ZStatements : TObjectList;

  published
    { Published Declarations }
    property AfterGet;
    property AfterParse;
    property AfterGenList;
    property BeforeGenList;
    property BeforeParse;
    property ClearSourceStream;
    property GenListWhen;
    property SourceFileName;
property Version : string read GetVersion write SetVersion;

    property OnCustomError;
    property OnError;
    property OnFailure;
    property OnStatusUpdate;
    property OnSuccess;
  end; { TZc }

implementation



const

  EOFSYMB = 0;  intConSym = 1;  realConSym = 2;  stringConSym = 3;
  identSym = 4;  andSym = 5;  assgnSym = 6;  colonSym = 7;  commaSym = 8;
  decSym = 9;  divSym = 10;  dotSym = 11;  eqSym = 12;  gtSym = 13;
  gteSym = 14;  incSym = 15;  lbraceSym = 16;  lbrackSym = 17;  lparSym = 18;
  lshiftSym = 19;  ltSym = 20;  lteSym = 21;  minusSym = 22;  modSym = 23;
  neqSym = 24;  notSym = 25;  orSym = 26;  plusSym = 27;  rbraceSym = 28;
  rbrackSym = 29;  rparSym = 30;  rshiftSym = 31;  scolonSym = 32;
  tildeSym = 33;  timesSym = 34;  xorSym = 35;  _semicolonSym = 36;  ifSym = 37;
  _lparenSym = 38;  _rparenSym = 39;  elseSym = 40;  returnSym = 41;
  _lbraceSym = 42;  _rbraceSym = 43;  _equalSym = 44;  _plus_equalSym = 45;
  _minus_equalSym = 46;  _star_equalSym = 47;  _slash_equalSym = 48;
  _bar_barSym = 49;  _and_andSym = 50;  _barSym = 51;  _uparrowSym = 52;
  _andSym = 53;  _bang_equalSym = 54;  _equal_equalSym = 55;  _lessSym = 56;
  _greaterSym = 57;  _less_equalSym = 58;  _greater_equalSym = 59;
  _less_lessSym = 60;  _greater_greaterSym = 61;  _plusSym = 62;
  _minusSym = 63;  _starSym = 64;  _slashSym = 65;  _pointSym = 66;
  _commaSym = 67;  trueSym = 68;  falseSym = 69;  nullSym = 70;  NOSYMB = 71;  _noSym = NOSYMB;   {error token code}

{ --------------------------------------------------------------------------- }
{ Arbitrary Code from ATG file }
var
  GlobalCleanUps : TObjectList;

function MakeOp(Kind : TZcOpKind) : TZcOp; overload;
begin
  Result := TZcOp.Create;
  Result.Kind := Kind;
end;
function MakeOp(Kind : TZcOpKind; Value : single) : TZcOp; overload;
begin
  Result := MakeOp(Kind);
  Result.Value := Value;
end;
function MakeOp(Kind : TZcOpKind; Id :string) : TZcOp; overload;
begin
  Result := MakeOp(Kind);
  Result.Id := Id;
end;
function MakeOp(Kind : TZcOpKind; const Children : array of TZcOp) : TZcOp; overload;
var
  I : integer;
begin
  Result := MakeOp(Kind);
  for I := 0 to High(Children) do
    Result.Children.Add(Children[I]);
end;

function MakeAssign(Kind : TZcAssignType; Op1,Op2 : TZcOp) : TZcOp;
const
  AssignMap : array[TZcAssignType] of TZcOpKind = (zcNop,zcMul,zcDiv,zcPlus,zcMinus);
var
  Tmp : TZcOp;
begin
  case Kind of
    atMulAssign,atDivAssign,atPlusAssign,atMinusAssign :  //Convert x*=2 to x=x*2
      begin
        Tmp := MakeOp(zcIdentifier,Op1.Id);
        Op2 := MakeOp(AssignMap[Kind],[Tmp,Op2]);
      end;
  end;
  Result := MakeOp(zcAssign,[Op1,Op2]);
end;

constructor TZcOp.Create;
begin
  Children := TObjectList.Create(False);
  GlobalCleanUps.Add(Self);
end;

destructor TZcOp.Destroy;
//var
//  I : integer;
begin
//  for I := 0 to Children.Count-1 do
//    if Assigned(Children[I]) then Child(I).Free;
  FreeAndNil(Children);
end;

function TZcOp.Child(I : integer) : TZcOp;
begin
  Result := TZcOp(Children[I]);
end;

function TZcOp.ToString : string;
var
  I : integer;
begin
  case Kind of
    zcMul : Result := Child(0).ToString + '*' + Child(1).ToString;
    zcDiv : Result := Child(0).ToString + '/' + Child(1).ToString;
    zcPlus : Result := Child(0).ToString + '+' + Child(1).ToString;
    zcMinus : Result := Child(0).ToString + '-' + Child(1).ToString;
    zcConst : Result := FloatToStr(Value);
    zcIdentifier : Result := Id;
    zcAssign : Result := Child(0).ToString + '=' + Child(1).ToString;
    zcIf :
      begin
        Result := 'if(' + Child(0).ToString + ') ' + Child(1).ToString;
        if Assigned(Child(2)) then
          Result := Result + ' else ' + Child(2).ToString;
      end;
    zcCompLT : Result := Child(0).ToString + '<' + Child(1).ToString;
    zcCompGT : Result := Child(0).ToString + '>' + Child(1).ToString;
    zcCompLE : Result := Child(0).ToString + '<=' + Child(1).ToString;
    zcCompGE : Result := Child(0).ToString + '>=' + Child(1).ToString;
    zcCompNE : Result := Child(0).ToString + '!=' + Child(1).ToString;
    zcCompEQ : Result := Child(0).ToString + '==' + Child(1).ToString;
    zcBlock :
      begin
        Result := '{'#13#10;
        for I := 0 to Children.Count-1 do
          Result := Result + Child(I).ToString + '; ';
        Result := Result + '}'#13#10;
      end;
    zcNegate : Result := '-' + Child(0).ToString;
    zcOr : Result := Child(0).ToString + ' || ' + Child(1).ToString;
    zcAnd : Result := Child(0).ToString + ' && ' + Child(1).ToString;
    zcFuncCall :
      begin
        Result := Id + '(';
        for I := 0 to Children.Count-1 do
        begin
          if I>0 then
            Result := Result + ',';
          Result := Result + Child(I).ToString;
        end;
        Result := Result + ')';
      end;
    zcNop : Result := ';';       //Empty statement
    zcReturn : Result := 'return ' + Child(0).ToString + ';';
  end;
end;

procedure TZcOp.Optimize;
var
  I : integer;

  procedure DoConstant(NewValue : single);
  begin
    if (Child(0).Kind=zcConst) and (Child(1).Kind=zcConst) then
    begin
      Kind := zcConst;
      Value := NewValue;
    end;
  end;

begin
  for I := 0 to Children.Count-1 do
    if Assigned(Child(I)) then Child(I).Optimize;
  case Kind of
    //todo: more optimizations
    zcMul : DoConstant(Child(0).Value * Child(1).Value);
    zcDiv : DoConstant(Child(0).Value / Child(1).Value);
    zcPlus : DoConstant(Child(0).Value + Child(1).Value);
    zcMinus : DoConstant(Child(0).Value - Child(1).Value);
    zcNegate :
      if Child(0).Kind=zcConst then
      begin
        Kind := zcConst;
        Value := Child(0).Value * -1;
      end;
  end;
end;

procedure TZc.WriteStr(S : string);
begin
  StreamToListFile(S, TRUE);
end;

procedure TZc.WriteOp(Op : TZcOp);
begin
  WriteStr(Op.ToString);
end;

procedure TZc.AddGlobalStatement(Op : TZcOp);
begin
  ZStatements.Add(Op);
end;

procedure TZc.CleanUp;
//var
//  I : integer;
begin
//  for I := 0 to ZSTatements.Count-1 do TObject(ZStatements[I]).Free;
  ZStatements.Free;
  GlobalCleanUps.Free;
end;



{ --------------------------------------------------------------------------- }
{ ---- implementation for TZcScanner ---- }

procedure TZcScanner.NextCh;
{ Return global variable ch }
begin
  LastInputCh := CurrInputCh;
  BufferPosition := BufferPosition + 1;
  SrcStream.Seek(BufferPosition,soFromBeginning);
  CurrInputCh := CurrentCh(BufferPosition);
  if (CurrInputCh = _EL) OR ((CurrInputCh = _LF) AND (LastInputCh <> _EL)) then
  begin
    CurrLine := CurrLine + 1;
    if Assigned(OnStatusUpdate) then
      OnStatusUpdate(Owner, cstLineNum, '', CurrLine);
    StartOfLine := BufferPosition;
  end
end;  {NextCh}

function TZcScanner.Comment : boolean;
var
  level : integer;
  startLine : integer;
  oldLineStart : longint;
  CommentStr : string;
begin
  level := 1;
  startLine := CurrLine;
  oldLineStart := StartOfLine;
  CommentStr := CharAt(BufferPosition);
Result := false;
if (CurrInputCh = '/') then
  begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if (CurrInputCh = '/') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
while true do
begin
if (CurrInputCh = CHR(10)) then
begin
level := level - 1;
NumEOLInComment := CurrLine - startLine;
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if level = 0 then
begin
  Result := true;
  Exit;
end;
end
else if CurrInputCh = _EF then
begin
  Result := false;
  Exit;
end
else
begin
  NextCh;
  CommentStr := CommentStr + CharAt(BufferPosition);
end;
end; { WHILE TRUE }
end
else
begin
if (CurrInputCh = _CR) OR (CurrInputCh = _LF) then
begin
CurrLine := CurrLine - 1;
StartOfLine := oldLineStart
end;
BufferPosition := BufferPosition - 1;
CurrInputCh := LastInputCh;
Result := false;
end;
end;
Result := false;
if (CurrInputCh = '/') then
  begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if (CurrInputCh = '*') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
while true do
begin
if (CurrInputCh = '*') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if (CurrInputCh = '/') then
begin
level := level - 1;
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if level = 0 then
begin
  Result := true;
  Exit;
end
end
end
else if CurrInputCh = _EF then
begin
  Result := false;
  Exit;
end
else
begin
  NextCh;
  CommentStr := CommentStr + CharAt(BufferPosition);
end;
end; { WHILE TRUE }
end
else
begin
if (CurrInputCh = _CR) OR (CurrInputCh = _LF) then
begin
CurrLine := CurrLine - 1;
StartOfLine := oldLineStart
end;
BufferPosition := BufferPosition - 1;
CurrInputCh := LastInputCh;
Result := false;
end;
end;
end;  { Comment }

function TZcScanner.CharInIgnoreSet(const Ch : char) : boolean;
begin
Result := (Ch = ' ')    OR
((CurrInputCh >= CHR(9)) AND (CurrInputCh <= CHR(10)) OR
(CurrInputCh = CHR(13)));
end; {CharInIgnoreSet}

function TZcScanner.GetNextSymbolString: string;
var
  i: integer;
  q: integer;
begin
  Result := '';
  i := 1;
  q := bpCurrToken;
  while i <= NextSymbol.Len do
  begin
    Result := Result + CurrentCh(q);
    inc(q);
    inc(i);
  end;
end; {GetNextSymbolString}

procedure TZcScanner.CheckLiteral(var Sym : integer);
var
  SymId : integer;
  DefaultSymId : integer;
  aToken : string;
begin
  aToken := GetNextSymbolString;
  if fHashList.Hash(aToken, SymId, DefaultSymId) then
  begin
      sym := SymId;
  end;
end; {CheckLiteral}


procedure TZcScanner.Get(var sym : integer);
var
  state : integer;
begin   {Get}
while CharInIgnoreSet(CurrInputCh) do
  NextCh;
if ((CurrInputCh = '/') OR (CurrInputCh = '/')) AND Comment then
begin
  Get(sym);
  exit;
  end;

  LastSymbol.Assign(CurrentSymbol);
  CurrentSymbol.Assign(NextSymbol);

  NextSymbol.Pos := BufferPosition;
  NextSymbol.Col := BufferPosition - StartOfLine;
  NextSymbol.Line := CurrLine;
  NextSymbol.Len := 0;

  ContextLen := 0;
  state := StartState[ORD(CurrInputCh)];
  bpCurrToken := BufferPosition;
  while true do
  begin
    NextCh;
    NextSymbol.Len := NextSymbol.Len + 1;
    if BufferPosition > SrcStream.Size then
    begin
      sym := EOFSYMB;
      CurrInputCh := _EF;
      BufferPosition := BufferPosition - 1;
      exit
    end;
    case state of
   1: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9') OR
(CurrInputCh >= 'A') AND (CurrInputCh <= 'F') OR
(CurrInputCh >= 'a') AND (CurrInputCh <= 'f')) then
begin
state := 2; 
end
else
begin
  sym := _noSym;
exit;
end;
   2: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9') OR
(CurrInputCh >= 'A') AND (CurrInputCh <= 'F') OR
(CurrInputCh >= 'a') AND (CurrInputCh <= 'f')) then
begin
 
end
else if (CurrInputCh = 'U') then
begin
state := 58; 
end
else if (CurrInputCh = 'u') then
begin
state := 59; 
end
else if (CurrInputCh = 'L') then
begin
state := 60; 
end
else if (CurrInputCh = 'l') then
begin
state := 61; 
end
else
begin
sym := intConSym;
exit;
end;
   3: begin
sym := intConSym;
exit;
end;
   4: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
 
end
else if ((CurrInputCh = 'D') OR
(CurrInputCh = 'F') OR
(CurrInputCh = 'M') OR
(CurrInputCh = 'd') OR
(CurrInputCh = 'f') OR
(CurrInputCh = 'm')) then
begin
state := 16; 
end
else if ((CurrInputCh = 'E') OR
(CurrInputCh = 'e')) then
begin
state := 5; 
end
else
begin
sym := realConSym;
exit;
end;
   5: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 7; 
end
else if ((CurrInputCh = '+') OR
(CurrInputCh = '-')) then
begin
state := 6; 
end
else
begin
  sym := _noSym;
exit;
end;
   6: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 7; 
end
else
begin
  sym := _noSym;
exit;
end;
   7: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
 
end
else if ((CurrInputCh = 'D') OR
(CurrInputCh = 'F') OR
(CurrInputCh = 'M') OR
(CurrInputCh = 'd') OR
(CurrInputCh = 'f') OR
(CurrInputCh = 'm')) then
begin
state := 16; 
end
else
begin
sym := realConSym;
exit;
end;
   8: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 9; 
end
else
begin
  sym := _noSym;
exit;
end;
   9: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
 
end
else if ((CurrInputCh = 'D') OR
(CurrInputCh = 'F') OR
(CurrInputCh = 'M') OR
(CurrInputCh = 'd') OR
(CurrInputCh = 'f') OR
(CurrInputCh = 'm')) then
begin
state := 16; 
end
else if ((CurrInputCh = 'E') OR
(CurrInputCh = 'e')) then
begin
state := 10; 
end
else
begin
sym := realConSym;
exit;
end;
  10: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 12; 
end
else if ((CurrInputCh = '+') OR
(CurrInputCh = '-')) then
begin
state := 11; 
end
else
begin
  sym := _noSym;
exit;
end;
  11: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 12; 
end
else
begin
  sym := _noSym;
exit;
end;
  12: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
 
end
else if ((CurrInputCh = 'D') OR
(CurrInputCh = 'F') OR
(CurrInputCh = 'M') OR
(CurrInputCh = 'd') OR
(CurrInputCh = 'f') OR
(CurrInputCh = 'm')) then
begin
state := 16; 
end
else
begin
sym := realConSym;
exit;
end;
  13: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 15; 
end
else if ((CurrInputCh = '+') OR
(CurrInputCh = '-')) then
begin
state := 14; 
end
else
begin
  sym := _noSym;
exit;
end;
  14: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 15; 
end
else
begin
  sym := _noSym;
exit;
end;
  15: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
 
end
else if ((CurrInputCh = 'D') OR
(CurrInputCh = 'F') OR
(CurrInputCh = 'M') OR
(CurrInputCh = 'd') OR
(CurrInputCh = 'f') OR
(CurrInputCh = 'm')) then
begin
state := 16; 
end
else
begin
sym := realConSym;
exit;
end;
  16: begin
sym := realConSym;
exit;
end;
  17: if ((CurrInputCh <= CHR(9)) OR
(CurrInputCh >= CHR(11)) AND (CurrInputCh <= CHR(12)) OR
(CurrInputCh >= CHR(14)) AND (CurrInputCh <= '!') OR
(CurrInputCh >= '#') AND (CurrInputCh <= '[') OR
(CurrInputCh >= ']')) then
begin
 
end
else if (CurrInputCh = '"') then
begin
state := 18; 
end
else
begin
  sym := _noSym;
exit;
end;
  18: begin
sym := stringConSym;
exit;
end;
  19: if ((CurrInputCh >= 'A') AND (CurrInputCh <= 'Z') OR
(CurrInputCh = '_') OR
(CurrInputCh >= 'a') AND (CurrInputCh <= 'z')) then
begin
state := 20; 
end
else
begin
  sym := _noSym;
exit;
end;
  20: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9') OR
(CurrInputCh >= 'A') AND (CurrInputCh <= 'Z') OR
(CurrInputCh = '_') OR
(CurrInputCh >= 'a') AND (CurrInputCh <= 'z')) then
begin
 
end
else
begin
sym := identSym;
CheckLiteral(sym);
exit;
end;
  21: if (CurrInputCh = '&') then
begin
state := 67; 
end
else
begin
sym := andSym;
CheckLiteral(sym);
exit;
end;
  22: begin
sym := colonSym;
exit;
end;
  23: begin
sym := commaSym;
CheckLiteral(sym);
exit;
end;
  24: begin
sym := decSym;
exit;
end;
  25: if (CurrInputCh = '=') then
begin
state := 65; 
end
else
begin
sym := divSym;
CheckLiteral(sym);
exit;
end;
  26: begin
sym := eqSym;
CheckLiteral(sym);
exit;
end;
  27: begin
sym := gteSym;
CheckLiteral(sym);
exit;
end;
  28: begin
sym := incSym;
exit;
end;
  29: begin
sym := lbraceSym;
CheckLiteral(sym);
exit;
end;
  30: begin
sym := lbrackSym;
exit;
end;
  31: begin
sym := lparSym;
CheckLiteral(sym);
exit;
end;
  32: begin
sym := lshiftSym;
CheckLiteral(sym);
exit;
end;
  33: begin
sym := lteSym;
CheckLiteral(sym);
exit;
end;
  34: begin
sym := modSym;
exit;
end;
  35: begin
sym := neqSym;
CheckLiteral(sym);
exit;
end;
  36: if (CurrInputCh = '|') then
begin
state := 66; 
end
else
begin
sym := orSym;
CheckLiteral(sym);
exit;
end;
  37: begin
sym := rbraceSym;
CheckLiteral(sym);
exit;
end;
  38: begin
sym := rbrackSym;
exit;
end;
  39: begin
sym := rparSym;
CheckLiteral(sym);
exit;
end;
  40: begin
sym := rshiftSym;
CheckLiteral(sym);
exit;
end;
  41: begin
sym := scolonSym;
CheckLiteral(sym);
exit;
end;
  42: begin
sym := tildeSym;
exit;
end;
  43: if (CurrInputCh = '=') then
begin
state := 64; 
end
else
begin
sym := timesSym;
CheckLiteral(sym);
exit;
end;
  44: begin
sym := xorSym;
CheckLiteral(sym);
exit;
end;
  45: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
 
end
else if (CurrInputCh = 'U') then
begin
state := 54; 
end
else if (CurrInputCh = 'u') then
begin
state := 55; 
end
else if (CurrInputCh = 'L') then
begin
state := 56; 
end
else if (CurrInputCh = 'l') then
begin
state := 57; 
end
else if (CurrInputCh = '.') then
begin
state := 8; 
end
else if ((CurrInputCh = 'E') OR
(CurrInputCh = 'e')) then
begin
state := 13; 
end
else if ((CurrInputCh = 'D') OR
(CurrInputCh = 'F') OR
(CurrInputCh = 'M') OR
(CurrInputCh = 'd') OR
(CurrInputCh = 'f') OR
(CurrInputCh = 'm')) then
begin
state := 16; 
end
else
begin
sym := intConSym;
exit;
end;
  46: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 45; 
end
else if (CurrInputCh = 'U') then
begin
state := 54; 
end
else if (CurrInputCh = 'u') then
begin
state := 55; 
end
else if (CurrInputCh = 'L') then
begin
state := 56; 
end
else if (CurrInputCh = 'l') then
begin
state := 57; 
end
else if ((CurrInputCh = 'X') OR
(CurrInputCh = 'x')) then
begin
state := 1; 
end
else if (CurrInputCh = '.') then
begin
state := 8; 
end
else if ((CurrInputCh = 'E') OR
(CurrInputCh = 'e')) then
begin
state := 13; 
end
else if ((CurrInputCh = 'D') OR
(CurrInputCh = 'F') OR
(CurrInputCh = 'M') OR
(CurrInputCh = 'd') OR
(CurrInputCh = 'f') OR
(CurrInputCh = 'm')) then
begin
state := 16; 
end
else
begin
sym := intConSym;
exit;
end;
  47: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 4; 
end
else
begin
sym := dotSym;
CheckLiteral(sym);
exit;
end;
  48: if (CurrInputCh = '=') then
begin
state := 26; 
end
else
begin
sym := assgnSym;
CheckLiteral(sym);
exit;
end;
  49: if (CurrInputCh = '-') then
begin
state := 24; 
end
else if (CurrInputCh = '=') then
begin
state := 63; 
end
else
begin
sym := minusSym;
CheckLiteral(sym);
exit;
end;
  50: if (CurrInputCh = '=') then
begin
state := 27; 
end
else if (CurrInputCh = '>') then
begin
state := 40; 
end
else
begin
sym := gtSym;
CheckLiteral(sym);
exit;
end;
  51: if (CurrInputCh = '+') then
begin
state := 28; 
end
else if (CurrInputCh = '=') then
begin
state := 62; 
end
else
begin
sym := plusSym;
CheckLiteral(sym);
exit;
end;
  52: if (CurrInputCh = '<') then
begin
state := 32; 
end
else if (CurrInputCh = '=') then
begin
state := 33; 
end
else
begin
sym := ltSym;
CheckLiteral(sym);
exit;
end;
  53: if (CurrInputCh = '=') then
begin
state := 35; 
end
else
begin
sym := notSym;
exit;
end;
  54: if ((CurrInputCh = 'L') OR
(CurrInputCh = 'l')) then
begin
state := 3; 
end
else
begin
sym := intConSym;
exit;
end;
  55: if ((CurrInputCh = 'L') OR
(CurrInputCh = 'l')) then
begin
state := 3; 
end
else
begin
sym := intConSym;
exit;
end;
  56: if ((CurrInputCh = 'U') OR
(CurrInputCh = 'u')) then
begin
state := 3; 
end
else
begin
sym := intConSym;
exit;
end;
  57: if ((CurrInputCh = 'U') OR
(CurrInputCh = 'u')) then
begin
state := 3; 
end
else
begin
sym := intConSym;
exit;
end;
  58: if ((CurrInputCh = 'L') OR
(CurrInputCh = 'l')) then
begin
state := 3; 
end
else
begin
sym := intConSym;
exit;
end;
  59: if ((CurrInputCh = 'L') OR
(CurrInputCh = 'l')) then
begin
state := 3; 
end
else
begin
sym := intConSym;
exit;
end;
  60: if ((CurrInputCh = 'U') OR
(CurrInputCh = 'u')) then
begin
state := 3; 
end
else
begin
sym := intConSym;
exit;
end;
  61: if ((CurrInputCh = 'U') OR
(CurrInputCh = 'u')) then
begin
state := 3; 
end
else
begin
sym := intConSym;
exit;
end;
  62: begin
sym := _plus_equalSym;
exit;
end;
  63: begin
sym := _minus_equalSym;
exit;
end;
  64: begin
sym := _star_equalSym;
exit;
end;
  65: begin
sym := _slash_equalSym;
exit;
end;
  66: begin
sym := _bar_barSym;
exit;
end;
  67: begin
sym := _and_andSym;
exit;
end;
  68: begin
sym := EOFSYMB;
CurrInputCh := chNull;
BufferPosition := BufferPosition - 1;
exit
end;
    else
      begin
        sym := _noSym;
        EXIT;          // NextCh already done
      end;
    end;
  end;
end;  {Get}

constructor TZcScanner.Create;
begin
  inherited;
fHashList := TmwStringHashList.Create(TinyHash, HashSecondaryOne, HashCompare);
fHashList.AddString('!=', _bang_equalSym, _bang_equalSym);
fHashList.AddString('&', _andSym, _andSym);
fHashList.AddString('(', _lparenSym, _lparenSym);
fHashList.AddString(')', _rparenSym, _rparenSym);
fHashList.AddString('*', _starSym, _starSym);
fHashList.AddString('+', _plusSym, _plusSym);
fHashList.AddString(',', _commaSym, _commaSym);
fHashList.AddString('-', _minusSym, _minusSym);
fHashList.AddString('.', _pointSym, _pointSym);
fHashList.AddString('/', _slashSym, _slashSym);
fHashList.AddString(';', _semicolonSym, _semicolonSym);
fHashList.AddString('<', _lessSym, _lessSym);
fHashList.AddString('<<', _less_lessSym, _less_lessSym);
fHashList.AddString('<=', _less_equalSym, _less_equalSym);
fHashList.AddString('=', _equalSym, _equalSym);
fHashList.AddString('==', _equal_equalSym, _equal_equalSym);
fHashList.AddString('>', _greaterSym, _greaterSym);
fHashList.AddString('>=', _greater_equalSym, _greater_equalSym);
fHashList.AddString('>>', _greater_greaterSym, _greater_greaterSym);
fHashList.AddString('^', _uparrowSym, _uparrowSym);
fHashList.AddString('else', elseSym, elseSym);
fHashList.AddString('false', falseSym, falseSym);
fHashList.AddString('if', ifSym, ifSym);
fHashList.AddString('null', nullSym, nullSym);
fHashList.AddString('return', returnSym, returnSym);
fHashList.AddString('true', trueSym, trueSym);
fHashList.AddString('{', _lbraceSym, _lbraceSym);
fHashList.AddString('|', _barSym, _barSym);
fHashList.AddString('}', _rbraceSym, _rbraceSym);
CurrentCh := CharAt;
fStartState[  0] := 68; fStartState[  1] := 69; fStartState[  2] := 69; fStartState[  3] := 69; 
fStartState[  4] := 69; fStartState[  5] := 69; fStartState[  6] := 69; fStartState[  7] := 69; 
fStartState[  8] := 69; fStartState[  9] := 69; fStartState[ 10] := 69; fStartState[ 11] := 69; 
fStartState[ 12] := 69; fStartState[ 13] := 69; fStartState[ 14] := 69; fStartState[ 15] := 69; 
fStartState[ 16] := 69; fStartState[ 17] := 69; fStartState[ 18] := 69; fStartState[ 19] := 69; 
fStartState[ 20] := 69; fStartState[ 21] := 69; fStartState[ 22] := 69; fStartState[ 23] := 69; 
fStartState[ 24] := 69; fStartState[ 25] := 69; fStartState[ 26] := 69; fStartState[ 27] := 69; 
fStartState[ 28] := 69; fStartState[ 29] := 69; fStartState[ 30] := 69; fStartState[ 31] := 69; 
fStartState[ 32] := 69; fStartState[ 33] := 53; fStartState[ 34] := 17; fStartState[ 35] := 69; 
fStartState[ 36] := 69; fStartState[ 37] := 34; fStartState[ 38] := 21; fStartState[ 39] := 69; 
fStartState[ 40] := 31; fStartState[ 41] := 39; fStartState[ 42] := 43; fStartState[ 43] := 51; 
fStartState[ 44] := 23; fStartState[ 45] := 49; fStartState[ 46] := 47; fStartState[ 47] := 25; 
fStartState[ 48] := 46; fStartState[ 49] := 45; fStartState[ 50] := 45; fStartState[ 51] := 45; 
fStartState[ 52] := 45; fStartState[ 53] := 45; fStartState[ 54] := 45; fStartState[ 55] := 45; 
fStartState[ 56] := 45; fStartState[ 57] := 45; fStartState[ 58] := 22; fStartState[ 59] := 41; 
fStartState[ 60] := 52; fStartState[ 61] := 48; fStartState[ 62] := 50; fStartState[ 63] := 69; 
fStartState[ 64] := 19; fStartState[ 65] := 20; fStartState[ 66] := 20; fStartState[ 67] := 20; 
fStartState[ 68] := 20; fStartState[ 69] := 20; fStartState[ 70] := 20; fStartState[ 71] := 20; 
fStartState[ 72] := 20; fStartState[ 73] := 20; fStartState[ 74] := 20; fStartState[ 75] := 20; 
fStartState[ 76] := 20; fStartState[ 77] := 20; fStartState[ 78] := 20; fStartState[ 79] := 20; 
fStartState[ 80] := 20; fStartState[ 81] := 20; fStartState[ 82] := 20; fStartState[ 83] := 20; 
fStartState[ 84] := 20; fStartState[ 85] := 20; fStartState[ 86] := 20; fStartState[ 87] := 20; 
fStartState[ 88] := 20; fStartState[ 89] := 20; fStartState[ 90] := 20; fStartState[ 91] := 30; 
fStartState[ 92] := 69; fStartState[ 93] := 38; fStartState[ 94] := 44; fStartState[ 95] := 20; 
fStartState[ 96] := 69; fStartState[ 97] := 20; fStartState[ 98] := 20; fStartState[ 99] := 20; 
fStartState[100] := 20; fStartState[101] := 20; fStartState[102] := 20; fStartState[103] := 20; 
fStartState[104] := 20; fStartState[105] := 20; fStartState[106] := 20; fStartState[107] := 20; 
fStartState[108] := 20; fStartState[109] := 20; fStartState[110] := 20; fStartState[111] := 20; 
fStartState[112] := 20; fStartState[113] := 20; fStartState[114] := 20; fStartState[115] := 20; 
fStartState[116] := 20; fStartState[117] := 20; fStartState[118] := 20; fStartState[119] := 20; 
fStartState[120] := 20; fStartState[121] := 20; fStartState[122] := 20; fStartState[123] := 29; 
fStartState[124] := 36; fStartState[125] := 37; fStartState[126] := 42; fStartState[127] := 69; 
fStartState[128] := 69; fStartState[129] := 69; fStartState[130] := 69; fStartState[131] := 69; 
fStartState[132] := 69; fStartState[133] := 69; fStartState[134] := 69; fStartState[135] := 69; 
fStartState[136] := 69; fStartState[137] := 69; fStartState[138] := 69; fStartState[139] := 69; 
fStartState[140] := 69; fStartState[141] := 69; fStartState[142] := 69; fStartState[143] := 69; 
fStartState[144] := 69; fStartState[145] := 69; fStartState[146] := 69; fStartState[147] := 69; 
fStartState[148] := 69; fStartState[149] := 69; fStartState[150] := 69; fStartState[151] := 69; 
fStartState[152] := 69; fStartState[153] := 69; fStartState[154] := 69; fStartState[155] := 69; 
fStartState[156] := 69; fStartState[157] := 69; fStartState[158] := 69; fStartState[159] := 69; 
fStartState[160] := 69; fStartState[161] := 69; fStartState[162] := 69; fStartState[163] := 69; 
fStartState[164] := 69; fStartState[165] := 69; fStartState[166] := 69; fStartState[167] := 69; 
fStartState[168] := 69; fStartState[169] := 69; fStartState[170] := 69; fStartState[171] := 69; 
fStartState[172] := 69; fStartState[173] := 69; fStartState[174] := 69; fStartState[175] := 69; 
fStartState[176] := 69; fStartState[177] := 69; fStartState[178] := 69; fStartState[179] := 69; 
fStartState[180] := 69; fStartState[181] := 69; fStartState[182] := 69; fStartState[183] := 69; 
fStartState[184] := 69; fStartState[185] := 69; fStartState[186] := 69; fStartState[187] := 69; 
fStartState[188] := 69; fStartState[189] := 69; fStartState[190] := 69; fStartState[191] := 69; 
fStartState[192] := 69; fStartState[193] := 69; fStartState[194] := 69; fStartState[195] := 69; 
fStartState[196] := 69; fStartState[197] := 69; fStartState[198] := 69; fStartState[199] := 69; 
fStartState[200] := 69; fStartState[201] := 69; fStartState[202] := 69; fStartState[203] := 69; 
fStartState[204] := 69; fStartState[205] := 69; fStartState[206] := 69; fStartState[207] := 69; 
fStartState[208] := 69; fStartState[209] := 69; fStartState[210] := 69; fStartState[211] := 69; 
fStartState[212] := 69; fStartState[213] := 69; fStartState[214] := 69; fStartState[215] := 69; 
fStartState[216] := 69; fStartState[217] := 69; fStartState[218] := 69; fStartState[219] := 69; 
fStartState[220] := 69; fStartState[221] := 69; fStartState[222] := 69; fStartState[223] := 69; 
fStartState[224] := 69; fStartState[225] := 69; fStartState[226] := 69; fStartState[227] := 69; 
fStartState[228] := 69; fStartState[229] := 69; fStartState[230] := 69; fStartState[231] := 69; 
fStartState[232] := 69; fStartState[233] := 69; fStartState[234] := 69; fStartState[235] := 69; 
fStartState[236] := 69; fStartState[237] := 69; fStartState[238] := 69; fStartState[239] := 69; 
fStartState[240] := 69; fStartState[241] := 69; fStartState[242] := 69; fStartState[243] := 69; 
fStartState[244] := 69; fStartState[245] := 69; fStartState[246] := 69; fStartState[247] := 69; 
fStartState[248] := 69; fStartState[249] := 69; fStartState[250] := 69; fStartState[251] := 69; 
fStartState[252] := 69; fStartState[253] := 69; fStartState[254] := 69; fStartState[255] := 69; 
end; {Create}

destructor TZcScanner.Destroy;
begin
  fHashList.Free;
  fHashList := NIL;
  inherited;
end;

{ --------------------------------------------------------------------------- }
{ ---- implementation for TZc ---- }

constructor TZc.Create(AOwner : TComponent);
begin
  inherited;
  Scanner := TZcScanner.Create;
  GetScanner.Owner := self;
ZStatements := TObjectList.Create(False);
    //Alla nodes ägs av globalcleanups
    GlobalCleanUps := TObjectList.Create;

  InitSymSet;
end; {Create}

destructor TZc.Destroy;
begin
  Scanner.Free;
CleanUp;

  inherited;
end; {Destroy}

function TZc.ErrorStr(const ErrorCode : integer; const Data : string) : string;
begin
  case ErrorCode of
       0 : Result := 'EOF expected';
   1 : Result := 'intCon expected';
   2 : Result := 'realCon expected';
   3 : Result := 'stringCon expected';
   4 : Result := 'ident expected';
   5 : Result := 'and expected';
   6 : Result := 'assgn expected';
   7 : Result := 'colon expected';
   8 : Result := 'comma expected';
   9 : Result := 'dec expected';
  10 : Result := 'div expected';
  11 : Result := 'dot expected';
  12 : Result := 'eq expected';
  13 : Result := 'gt expected';
  14 : Result := 'gte expected';
  15 : Result := 'inc expected';
  16 : Result := 'lbrace expected';
  17 : Result := 'lbrack expected';
  18 : Result := 'lpar expected';
  19 : Result := 'lshift expected';
  20 : Result := 'lt expected';
  21 : Result := 'lte expected';
  22 : Result := 'minus expected';
  23 : Result := 'mod expected';
  24 : Result := 'neq expected';
  25 : Result := 'not expected';
  26 : Result := 'or expected';
  27 : Result := 'plus expected';
  28 : Result := 'rbrace expected';
  29 : Result := 'rbrack expected';
  30 : Result := 'rpar expected';
  31 : Result := 'rshift expected';
  32 : Result := 'scolon expected';
  33 : Result := 'tilde expected';
  34 : Result := 'times expected';
  35 : Result := 'xor expected';
  36 : Result := '";" expected';
  37 : Result := '"if" expected';
  38 : Result := '"(" expected';
  39 : Result := '")" expected';
  40 : Result := '"else" expected';
  41 : Result := '"return" expected';
  42 : Result := '"{" expected';
  43 : Result := '"}" expected';
  44 : Result := '"=" expected';
  45 : Result := '"+=" expected';
  46 : Result := '"-=" expected';
  47 : Result := '"*=" expected';
  48 : Result := '"/=" expected';
  49 : Result := '"||" expected';
  50 : Result := '"&&" expected';
  51 : Result := '"|" expected';
  52 : Result := '"^" expected';
  53 : Result := '"&" expected';
  54 : Result := '"!=" expected';
  55 : Result := '"==" expected';
  56 : Result := '"<" expected';
  57 : Result := '">" expected';
  58 : Result := '"<=" expected';
  59 : Result := '">=" expected';
  60 : Result := '"<<" expected';
  61 : Result := '">>" expected';
  62 : Result := '"+" expected';
  63 : Result := '"-" expected';
  64 : Result := '"*" expected';
  65 : Result := '"/" expected';
  66 : Result := '"." expected';
  67 : Result := '"," expected';
  68 : Result := '"true" expected';
  69 : Result := '"false" expected';
  70 : Result := '"null" expected';
  71 : Result := 'not expected';
  72 : Result := 'invalid Literal';
  73 : Result := 'invalid Primary';
  74 : Result := 'invalid AssignOp';
  75 : Result := 'invalid StatementExpr';
  76 : Result := 'invalid Expr';
  77 : Result := 'invalid EmbeddedStatement';

200 : Result := 'Not a floating point value';
  else
    if Assigned(OnCustomError) then
      Result := OnCustomError(Self, ErrorCode, Data)
    else
    begin
      Result := 'Error: ' + IntToStr(ErrorCode);
      if Trim(Data) > '' then
        Result := Result + ' (' + Data + ')';
    end;
  end;  {case nr}
end; {ErrorStr}

procedure TZc.Execute;
begin
  ClearErrors;
  ListStream.Clear;
  Extra := 1;

  { if there is a file name then load the file }
  if Trim(SourceFileName) <> '' then
  begin
    GetScanner.SrcStream.Clear;
    GetScanner.SrcStream.LoadFromFile(SourceFileName);
  end;

  { install error reporting procedure }
  GetScanner.ScannerError := StoreError;

  { instigate the compilation }
  DoBeforeParse;
  Parse;
  DoAfterParse;

  { generate the source listing to the ListStream }
  if (GenListWhen = glAlways) OR ((GenListWhen = glOnError) AND (ErrorList.Count > 0)) then
    GenerateListing;
  if ClearSourceStream then
    GetScanner.SrcStream.Clear;
  ListStream.Position := 0;  // goto the beginning of the stream
  if Successful AND Assigned(OnSuccess) then
    OnSuccess(Self);
  if (NOT Successful) AND Assigned(OnFailure) then
    OnFailure(Self, ErrorList.Count);
end;  {Execute}

procedure TZc.Get;
begin
  repeat


    GetScanner.Get(fCurrentInputSymbol);
    if fCurrentInputSymbol <= maxT then
      errDist := errDist + 1
    else
    begin
    end;
  until fCurrentInputSymbol <= maxT;
  if Assigned(AfterGet) then
    AfterGet(Self, fCurrentInputSymbol);
end;  {Get}

function TZc.GetScanner : TZcScanner;
begin
  Result := Scanner AS TZcScanner;
end; {GetScanner}

function TZc._In(var s : SymbolSet; x : integer) : boolean;
begin
  _In := x mod setsize in s[x div setsize];
end;  {_In}

procedure TZc._Literal;begin
case fCurrentInputSymbol of
  intConSym : begin
Get;
    end;
  realConSym : begin
Get;
    end;
  stringConSym : begin
Get;
    end;
  trueSym : begin
Get;
    end;
  falseSym : begin
Get;
    end;
  nullSym : begin
Get;
    end;
else begin SynError(72);
    end;
end;
end;

procedure TZc._Primary (var  OutOp  :  TZcOp);var  Op  :  TZcOp;
begin
OutOp  :=  nil;
if (fCurrentInputSymbol = identSym) then begin
Get;
OutOp  :=  MakeOp(zcIdentifier,LexString);
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_Literal;

try
OutOp  :=  MakeOp(zcConst,StrToFloat(LexString));
except  on  EConvertError  do
SynError(200);
end;

end else if (fCurrentInputSymbol = _lparenSym) then begin
Get;
_Expr(OutOp);
Expect(_rparenSym);
end else begin SynError(73);
end;
while (fCurrentInputSymbol = _lparenSym) OR
 (fCurrentInputSymbol = _pointSym) do begin
if (fCurrentInputSymbol = _pointSym) then begin
Get;
Expect(identSym);

Assert(OutOp.Kind=zcIdentifier);
OutOp.Id  :=  OutOp.Id  +  '.'  +  LexString;

end else begin
Get;
Assert(OutOp.Kind=zcIdentifier);
OutOp.Kind:=zcFuncCall;

if _In(symSet[2], fCurrentInputSymbol) then begin
_Argument(Op);
OutOp.Children.Add(Op);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_Argument(Op);
OutOp.Children.Add(Op);
end;
end;
Expect(_rparenSym);
end;
end;
end;

procedure TZc._MulExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Tmp  :  TZcOp;  Kind  :  TZcOpKind;
begin
OutOp  :=  InOp;
while (fCurrentInputSymbol = _starSym) OR
 (fCurrentInputSymbol = _slashSym) do begin
if (fCurrentInputSymbol = _starSym) then begin
Get;
Kind  :=  zcMul;
end else begin
Get;
Kind  :=  zcDiv;
end;
_Unary(Tmp);
OutOp  :=  MakeOp(Kind,[InOp,Tmp]);
InOp  :=  OutOp;

end;
end;

procedure TZc._AddExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op,L,R  :  TZcOp;   Kind  :  TZcOpKind;
begin
_MulExpr(InOp,OutOp);
L  :=  OutOp;
while (fCurrentInputSymbol = _plusSym) OR
 (fCurrentInputSymbol = _minusSym) do begin
if (fCurrentInputSymbol = _plusSym) then begin
Get;
Kind  :=  zcPlus;
end else begin
Get;
Kind  :=  zcMinus;
end;
_Unary(Op);
_MulExpr(Op,R);
OutOp  :=  MakeOp(Kind,[L,R]);
L  :=  OutOp;

end;
end;

procedure TZc._ShiftExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op  :  TZcOp;
begin
_AddExpr(InOp,OutOp);
while (fCurrentInputSymbol = _less_lessSym) OR
 (fCurrentInputSymbol = _greater_greaterSym) do begin
if (fCurrentInputSymbol = _less_lessSym) then begin
Get;
end else begin
Get;
end;
_Unary(Op);
_AddExpr(InOp,OutOp);
end;
end;

procedure TZc._RelExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op,L,R  :  TZcOp;   Kind  :  TZcOpKind;
begin
_ShiftExpr(InOp,OutOp);
L  :=  OutOp;
while (fCurrentInputSymbol = _lessSym) OR
 (fCurrentInputSymbol = _greaterSym) OR
 (fCurrentInputSymbol = _less_equalSym) OR
 (fCurrentInputSymbol = _greater_equalSym) do begin
if (fCurrentInputSymbol = _lessSym) then begin
Get;
Kind  :=  zcCompLT;
end else if (fCurrentInputSymbol = _greaterSym) then begin
Get;
Kind  :=  zcCompGT;
end else if (fCurrentInputSymbol = _less_equalSym) then begin
Get;
Kind  :=  zcCompLE;
end else begin
Get;
Kind  :=  zcCompGE;
end;
_Unary(Op);
_ShiftExpr(Op,R);
OutOp  :=  MakeOp(Kind,[L,R]);
L  :=  OutOp;

end;
end;

procedure TZc._EqlExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op,L,R  :  TZcOp;  Kind  :  TZcOpKind;
begin
_RelExpr(InOp,OutOp);
L  :=  OutOp;
while (fCurrentInputSymbol = _bang_equalSym) OR
 (fCurrentInputSymbol = _equal_equalSym) do begin
if (fCurrentInputSymbol = _bang_equalSym) then begin
Get;
Kind  :=  zcCompNE;
end else begin
Get;
Kind  :=  zcCompEQ;
end;
_Unary(Op);
_RelExpr(Op,R);
OutOp  :=  MakeOp(Kind,[L,R]);
L  :=  OutOp;

end;
end;

procedure TZc._BitAndExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op  :  TZcOp;
begin
_EqlExpr(InOp,OutOp);
while (fCurrentInputSymbol = _andSym) do begin
Get;
_Unary(Op);
_EqlExpr(InOp,OutOp);
end;
end;

procedure TZc._BitXorExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op  :  TZcOp;
begin
_BitAndExpr(InOp,OutOp);
while (fCurrentInputSymbol = _uparrowSym) do begin
Get;
_Unary(Op);
_BitAndExpr(InOp,OutOp);
end;
end;

procedure TZc._BitOrExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op  :  TZcOp;
begin
_BitXorExpr(InOp,OutOp);
while (fCurrentInputSymbol = _barSym) do begin
Get;
_Unary(Op);
_BitXorExpr(InOp,OutOp);
end;
end;

procedure TZc._AndExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op,L,R  :  TZcOp;
begin
_BitOrExpr(InOp,OutOp);
L  :=  OutOp;
while (fCurrentInputSymbol = _and_andSym) do begin
Get;
_Unary(Op);
_BitOrExpr(Op,R);
OutOp  :=  MakeOp(zcAnd,[L,R]);
L  :=  OutOp;
end;
end;

procedure TZc._OrExpr (InOp  :  TZcOp;  var  OutOp  :  TZcOp);var  Op,L,R  :  TZcOp;
begin
_AndExpr(InOp,OutOp);
L  :=  OutOp;
while (fCurrentInputSymbol = _bar_barSym) do begin
Get;
_Unary(Op);
_AndExpr(Op,R);
OutOp  :=  MakeOp(zcOr,[L,R]);
L  :=  OutOp;
end;
end;

procedure TZc._AssignOp (var  Kind  :  TZcAssignType);begin
if (fCurrentInputSymbol = _equalSym) then begin
Get;
Kind  :=  atAssign;
end else if (fCurrentInputSymbol = _plus_equalSym) then begin
Get;
Kind  :=  atPlusAssign;
end else if (fCurrentInputSymbol = _minus_equalSym) then begin
Get;
Kind  :=  atMinusAssign;
end else if (fCurrentInputSymbol = _star_equalSym) then begin
Get;
Kind  :=  atMulAssign;
end else if (fCurrentInputSymbol = _slash_equalSym) then begin
Get;
Kind  :=  atDivAssign;
end else begin SynError(74);
end;
end;

procedure TZc._Unary (var  OutOp  :  TZcOp);var  LastOp,Tmp  :  TZcOp;  Kind  :  TZcOpKind;
begin
LastOp  :=  nil;
while (fCurrentInputSymbol = _minusSym) do begin
Get;
Kind  :=  zcNegate;
Tmp  :=  MakeOp(Kind);
if  LastOp<>nil  then
   LastOp.Children.Add(Tmp);
LastOp  :=  Tmp;

end;
_Primary(Tmp);
if  LastOp<>nil  then
begin
   LastOp.Children.Add(Tmp);
   OutOp  :=  LastOp;
end  else
   OutOp  :=  Tmp;

end;

procedure TZc._StatementExpr (var  OutOp  :  TZcOp);var  Op1,Op2  :  TZcOp;  Kind  :  TZcAssignType;
begin
_Unary(Op1);
if (fCurrentInputSymbol = _equalSym) OR
 (fCurrentInputSymbol = _plus_equalSym) OR
 (fCurrentInputSymbol = _minus_equalSym) OR
 (fCurrentInputSymbol = _star_equalSym) OR
 (fCurrentInputSymbol = _slash_equalSym) then begin
_AssignOp(Kind);
_Expr(Op2);

OutOp  :=  MakeAssign(Kind,Op1,Op2);

end else if (fCurrentInputSymbol = _semicolonSym) then begin
OutOp  :=  Op1;
end else begin SynError(75);
end;
end;

procedure TZc._Block (var  OutOp  :  TZcOp);var
   Op  :  TZcOp;

begin
OutOp  :=  MakeOp(zcBlock);
Expect(_lbraceSym);
while _In(symSet[3], fCurrentInputSymbol) do begin
_Statement(Op);
OutOp.Children.Add(Op);
end;
Expect(_rbraceSym);
end;

procedure TZc._Statement (var  OutOp  :  TZcOp);begin
_EmbeddedStatement(OutOp);
end;

procedure TZc._Expr (var  OutOp  :  TZcOp);var  Op1,Op2  :  TZcOp;  Kind  :  TZcAssignType;
begin
_Unary(Op1);
if _In(symSet[4], fCurrentInputSymbol) then begin
_OrExpr(Op1,OutOp);
end else if (fCurrentInputSymbol = _equalSym) OR
 (fCurrentInputSymbol = _plus_equalSym) OR
 (fCurrentInputSymbol = _minus_equalSym) OR
 (fCurrentInputSymbol = _star_equalSym) OR
 (fCurrentInputSymbol = _slash_equalSym) then begin
_AssignOp(Kind);
_Expr(Op2);
OutOp  :=  MakeAssign(Kind,Op1,Op2);
end else begin SynError(76);
end;
end;

procedure TZc._Argument (var  OutOp  :  TZcOp);begin
_Expr(OutOp);
end;

procedure TZc._EmbeddedStatement (var  OutOp  :  TZcOp);var
   Op,IfOp,IfBody,ElseOp  :  TZcOp;

begin
if (fCurrentInputSymbol = _lbraceSym) then begin
_Block(OutOp);
end else if (fCurrentInputSymbol = _semicolonSym) then begin
Get;
OutOp  :=  MakeOp(zcNop);
end else if _In(symSet[2], fCurrentInputSymbol) then begin
_StatementExpr(OutOp);
Expect(_semicolonSym);
end else if (fCurrentInputSymbol = ifSym) then begin
Get;
ElseOp  :=  nil;
Expect(_lparenSym);
_Expr(IfOp);
Expect(_rparenSym);
_EmbeddedStatement(IfBody);
if (fCurrentInputSymbol = elseSym) then begin
Get;
_EmbeddedStatement(ElseOp);
end;
OutOp  :=  MakeOp(zcIf,[IfOp,IfBody,ElseOp]);
end else if (fCurrentInputSymbol = returnSym) then begin
Get;
_Expr(Op);
Expect(_semicolonSym);
OutOp  :=  MakeOp(zcReturn,[Op]);  {return  måste  har  ett  expr}
end else begin SynError(77);
end;
end;

procedure TZc._Zc;var  Op  :  TZcOp;  I  :  integer;
begin
Op  :=  nil;
while _In(symSet[3], fCurrentInputSymbol) do begin
_EmbeddedStatement(Op);
if  Op<>nil  then
   AddGlobalStatement(Op);
Op  :=  nil;

end;
if  Successful  then
begin
   for  I:=0  to  ZStatements.Count-1  do
   begin
     TZcOp(ZStatements[I]).Optimize;
     WriteOp(TZcOp(ZStatements[I]));
   end;
end;

end;

function TZc.GetBuildDate : TDateTime;
const
  BDate = 38846;
  Hour = 16;
  Min = 41;
begin
  Result := BDate + EncodeTime(Hour, Min, 0 ,0);
end;

function TZc.GetVersion : string;
begin
  Result := '1.0.0.116';
end;

function TZc.GetVersionStr : string;
begin
  Result := '1.0.0.116';
end;

function TZc.GetVersionInfo : string;
begin
  Result := 'Comment: Zc' + #13#10 +
'Author: Ville Krumlinde' + #13#10 +
'Copyright: ';
end;

procedure TZc.SetVersion(const Value : string);
begin
  // This is a read only property. However, we want the value
  // to appear in the Object Inspector during design time.
end;

procedure TZc.Parse;
begin
  errDist := minErrDist;
GetScanner._Reset;
Get;
_Zc;
end;  {Parse}

procedure TZc.InitSymSet;
begin
symSet[ 0, 0] := [EOFSYMB];
symSet[ 0, 1] := [];
symSet[ 0, 2] := [];
symSet[ 0, 3] := [];
symSet[ 0, 4] := [];
symSet[ 1, 0] := [intConSym, realConSym, stringConSym];
symSet[ 1, 1] := [];
symSet[ 1, 2] := [];
symSet[ 1, 3] := [];
symSet[ 1, 4] := [trueSym-64, falseSym-64, nullSym-64];
symSet[ 2, 0] := [intConSym, realConSym, stringConSym, identSym];
symSet[ 2, 1] := [];
symSet[ 2, 2] := [_lparenSym-32];
symSet[ 2, 3] := [_minusSym-48];
symSet[ 2, 4] := [trueSym-64, falseSym-64, nullSym-64];
symSet[ 3, 0] := [intConSym, realConSym, stringConSym, identSym];
symSet[ 3, 1] := [];
symSet[ 3, 2] := [_semicolonSym-32, ifSym-32, _lparenSym-32, returnSym-32, 
                    _lbraceSym-32];
symSet[ 3, 3] := [_minusSym-48];
symSet[ 3, 4] := [trueSym-64, falseSym-64, nullSym-64];
symSet[ 4, 0] := [];
symSet[ 4, 1] := [];
symSet[ 4, 2] := [_semicolonSym-32, _rparenSym-32];
symSet[ 4, 3] := [_bar_barSym-48, _and_andSym-48, _barSym-48, _uparrowSym-48, 
                    _andSym-48, _bang_equalSym-48, _equal_equalSym-48, 
                    _lessSym-48, _greaterSym-48, _less_equalSym-48, 
                    _greater_equalSym-48, _less_lessSym-48, 
                    _greater_greaterSym-48, _plusSym-48, _minusSym-48];
symSet[ 4, 4] := [_starSym-64, _slashSym-64, _commaSym-64];
end; {InitSymSet}

end { Zc }.    
