{*******************************************************}
{                                                       }
{       WHY not a compiler? by Y [05-04-00]             }
{       Why language syntax analysis engine             }
{                                                       }
{       Copyright (c) 1999-2000 CROWELL, Inc.           }
{       All Rights Reserved.                            }
{                                                       }
{*******************************************************}

unit CSyntax; {$V-} {.$DEFINE DEBUG}

interface

uses CConstants, CTokenStream, CLists, CCodeGenerator, Dos;

var
  Tokens: PTokenStream;
  CodeGen: PCodeGenerator;
  Publics: PHeaderGenerator;
  GlobalVariables, GlobalConstants,
    LocalVariables, LocalConstants: PUnsortedStringList;
  FConsts: PUnsortedFloatList;

procedure CompileProgram(SourceName: String);
procedure Error(CompilerError: TCompilerError);

implementation

uses Objects, Strings;

var
  Token: TToken;
  CurrentIdentifier: String;
  CurrentType: (ctInteger, ctString);
  LocalSpace: Integer; {local space, in bytes}
  CurrentProcedure: String;
  CurrentFile: String;

function StrToLongInt(S: String): LongInt;
var
  Temp: LongInt;
  Str: String[4];
  i: Integer;
begin
  Str := '1234';
  for i := 1 to Length(S) do
    Str[i] := S[i];

  {padd with zeros}
  for i := Length(S) + 1 to 4 do
    Str[i] := #0;

  {move to longint}
  Temp := 0;
  for i := 4 downto 1 do
    Temp := Temp shl 8 + Ord(Str[i]);

  {return}
  StrToLongInt := Temp;
end; {StrToLongInt}

{ See documentation for Why language grammar. }

function CompileImports: Boolean; forward; {Imports}
procedure CompileDefinition; forward; {Definition}
function CompileGlobalVariableDefinition: Boolean; forward; {GlobalVariableDefinition}
function CompileTypeName: Boolean; forward; {TypeName}
function CompileVariableDefinition: Boolean; forward; {VariableDefinition}
procedure CompileIdentifier; forward; {Identifier}
function TryToCompileIdentifier: Boolean; forward; {Identifier}
procedure CompileSequence; forward; {Sequence}
function CompileElement: Boolean; forward; {Element}
function CompileConstant: Boolean; forward; {Constant}
function CompileOperation: Boolean; forward; {Operation}
function CompileDoubleCharOperation: Boolean; forward; {Operation too}
function CompileAsmStatement: Boolean; forward; {AsmStatement}
function CompileBeginStatement: Boolean; forward; {BeginStatement}
function CompileDoLoopStatement: Boolean; forward; {DoLoopStatement}
function CompileDowntoLoopStatement: Boolean; forward; {DowntoLoopStatement}
function CompileIfStatement: Boolean; forward; {IfStatement}
function CompileInlineStatement: Boolean; forward; {InlineStatement}
{function CompileRepeatStatement: Boolean; forward; {RepeatStatement}
function CompileToLoopStatement: Boolean; forward; {ToLoopStatement}
function CompileProcedureCall: Boolean; forward; {ProcedureCall}
function CompileSimpleStatement: Boolean; forward; {SimpleStatement}
function CompilePragma: Boolean; forward; {Pragma}
function CompileSetting: Boolean; forward; {Setting}
procedure CompileEndOfFile; forward; {EndOfFile}

procedure Error(CompilerError: TCompilerError);
begin
  Writeln(
    Tokens^.InputFileName, '(',
    Token.Line, ',',
    Token.Position,
    '): Fatal: ', ErrorMessages[CompilerError]);
  Halt(256-2);
end; {Error}

procedure CompileProgram(SourceName: String); {Program}
var
  ExitFlag: Boolean;
begin
  ExitFlag := False;
  CurrentFile := SourceName;
  CurrentProcedure := '(global scope)';
  CodeGen^.EmitDebugSourceFile(SourceName);

  CompileImports;

  with Tokens^ do
    while not ExitFlag do
      if ReadDelimiter(Token) then
        if (Delimiters[Token.I] = ':') then
          CompileDefinition
        else
        begin
          PutBack(Token);
          ExitFlag := not CompileGlobalVariableDefinition;
        end
      else
        ExitFlag := not CompileGlobalVariableDefinition;

  CompileEndOfFile;
end; {CompileProgram}

function CompileImports: Boolean; {Imports}
var
  Temp: Boolean;
begin
  Temp := False;
  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwImports) then
      begin
        while TryToCompileIdentifier do
          CodeGen^.EmitIncludeDirective(CurrentIdentifier + '.inc');
        if ReadDelimiter(Token) then
          if (Delimiters[Token.I] = ';') then
            Temp := True
         else
            Error(ceSemicolonExpected)
        else
          Error(ceSemicolonExpected);
      end
      else
        PutBack(Token);

  CompileImports := Temp;
end; {CompileImports}

procedure CompileDefinition; {Definition}
begin
  LocalSpace := 0;
  LocalVariables^.Clear;

  {note: ":" is already compiled}
  CodeGen^.EmitDebugLineNumber(Token.Line);
  CompileIdentifier;
  CurrentProcedure := CurrentIdentifier;

  {generate some code}
  CodeGen^.StartProcedureDefinition(CurrentIdentifier);
  CodeGen^.InitLocals(CurrentIdentifier);
  Publics^.EmitExternalSymbol(CurrentIdentifier, 'NEAR');
  CompileSequence;

  with Tokens^ do
    if ReadDelimiter(Token) then
      if (Delimiters[Token.I] = ';') then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CodeGen^.EmitIntegerEquate(CurrentProcedure + '_LOCALS', LocalSpace);
        {generate code for the end of procedure}
        CodeGen^.DoneLocals;
        CodeGen^.FinishProcedureDefinition
      end
      else
        Error(ceSemicolonExpected)
    else
      Error(ceSemicolonExpected)
end; {CompileDefinition}

procedure CompileIdentifier; {Identifier}
begin
  with Tokens^ do
    if ReadReservedWord(Token) then
      Error(ceIdentifierExpected)
    else
      if ReadIdentifier(Token) then
        if (IsPreDefinedIdentifier(Token.S) = idUnknown) then
          CurrentIdentifier := Token.S
        else
          Error(ceIdentifierExpected)
      else
        Error(ceIdentifierExpected);
end; {CompileIdentifier}

function TryToCompileIdentifier: Boolean; {Identifier}
var
  Temp: Boolean;
begin
  Temp := False;
  with Tokens^ do
    if ReadReservedWord(Token) then
      PutBack(Token)
    else
      if ReadIdentifier(Token) then
      begin
        CurrentIdentifier := Token.S;
        Temp := True;
      end;
  TryToCompileIdentifier := Temp;
end; {TryToCompileIdentifier}

procedure CompileSequence; {Sequence}
begin
  while CompileElement do;
end; {CompileSequence}

function CompileElement; {Element}
var
  Temp: Boolean;
begin
  with Tokens^ do
  begin
    Temp := True;

    if not CompileVariableDefinition then
    {if not CompileConstantDefinition then}
    if not CompileDoubleCharOperation then {err...}
    if not CompileConstant then
    if not CompileOperation then

    if not CompileAsmStatement then
    if not CompileBeginStatement then
    if not CompileDoLoopStatement then
    if not CompileDowntoLoopStatement then
    if not CompileIfStatement then
    if not CompileInlineStatement then
    {if not CompileRepeatStatement then}
    if not CompileSimpleStatement then
    if not CompileToLoopStatement then

    if not CompileProcedureCall then
      Temp := False;
  end;

  CompileElement := Temp;
end;

function CompileDoubleCharOperation: Boolean; {Operation}
var
  Temp: Boolean;

  procedure PerformSimpleOperation(Operation: SmallString); {"++", ">=", etc}
  begin
    CodeGen^.EmitDebugLineNumber(Token.Line);
    CodeGen^.PerformOperation(Operation);
  end; {PerformSimpleOperation}

  procedure PerformComplexOperation(Operation: SmallString); {"<+>" and so on}
  begin
    {  1 a <+>
       1 a -> + a <-
       1 a dup -> rot rot + swap <-
    }
    CodeGen^.EmitDebugLineNumber(Token.Line);
    CodeGen^.EmitDupCode;
    CodeGen^.PerformOperation('->');
    CodeGen^.EmitRotCode;
    CodeGen^.EmitRotCode;
    CodeGen^.PerformOperation(Operation);
    CodeGen^.EmitSwapCode;
    CodeGen^.PerformOperation('<-');
  end; {PerformComplexOperation}

  procedure PerformUnaryComplexOperation(Operation: SmallString); {"<++>"}
  begin
    {  a <++>
       a -> ++ a <-
       a dup -> ++ swap <-
    }
    CodeGen^.EmitDebugLineNumber(Token.Line);
    CodeGen^.EmitDupCode;
    CodeGen^.PerformOperation('->');
    CodeGen^.PerformOperation(Operation);
    CodeGen^.EmitSwapCode;
    CodeGen^.PerformOperation('<-');
  end; {PerformUnaryComplexOperation}

begin
  Temp := True;

  with Tokens^ do
    {check for unary complex operations}
    if ReadBigDelimiter(Token, '<++>') then
      PerformUnaryComplexOperation('++')
    else if ReadBigDelimiter(Token, '<-->') then
      PerformUnaryComplexOperation('--')
    else if ReadBigDelimiter(Token, '<!>') then
      PerformUnaryComplexOperation('!')
    else if ReadBigDelimiter(Token, '<~>') then
      PerformUnaryComplexOperation('~')
    {check for binary complex operations}
    else if ReadBigDelimiter(Token, '<+>') then
      PerformComplexOperation('+')
    else if ReadBigDelimiter(Token, '<->') then
      PerformComplexOperation('-')
    else if ReadBigDelimiter(Token, '<*>') then
      PerformComplexOperation('*')
    else if ReadBigDelimiter(Token, '</>') then
      PerformComplexOperation('/')
    else if ReadBigDelimiter(Token, '<%>') then
      PerformComplexOperation('%')
    {check for simple operations}
    else if ReadBigDelimiter(Token, '>=') then
      PerformSimpleOperation('>=')
    else if ReadBigDelimiter(Token, '<=') then
      PerformSimpleOperation('<=')
    else if ReadBigDelimiter(Token, '<>') then
      PerformSimpleOperation('<>')
    else if ReadBigDelimiter(Token, '==') then
      PerformSimpleOperation('==')
    else if ReadBigDelimiter(Token, '||') then
      PerformSimpleOperation('||')
    else if ReadBigDelimiter(Token, '&&') then
      PerformSimpleOperation('&&')
    else if ReadBigDelimiter(Token, '<-') then
      PerformSimpleOperation('<-')
    else if ReadBigDelimiter(Token, '->') then
      PerformSimpleOperation('->')
    else if ReadBigDelimiter(Token, '<.') then
      PerformSimpleOperation('<.')
    else if ReadBigDelimiter(Token, '.>') then
      PerformSimpleOperation('.>')
    else if ReadBigDelimiter(Token, '[]') then
      PerformSimpleOperation('[]')
    else if ReadBigDelimiter(Token, '++') then
      PerformSimpleOperation('++')
    else if ReadBigDelimiter(Token, '--') then
      PerformSimpleOperation('--')
    else if ReadBigDelimiter(Token, '<<') then
      PerformSimpleOperation('<<')
    else if ReadBigDelimiter(Token, '>>') then
      PerformSimpleOperation('>>')
    else if ReadBigDelimiter(Token, '!=') then
      PerformSimpleOperation('!=')
    else
      Temp := False;

  CompileDoubleCharOperation := Temp;
end; {CompileDoubleCharOperation}

function CompileOperation: Boolean; {Operation}
var
  Temp: Boolean;
begin
  Temp := True;

  with Tokens^ do
    if ReadDelimiter(Token) then
      if (Delimiters[Token.I] in ['+', '-', '/', '*', '%', '|', '&', '~', '!', '<', '>']) then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CodeGen^.PerformOperation(Delimiters[Token.I])
      end
      else
      begin
        Temp := False;
        PutBack(Token);
      end
    else
      Temp := False;

  CompileOperation := Temp;
end; {CompileOperation}

function CompileAsmStatement: Boolean; {AsmStatement}
var
  Temp, Ok: Boolean;
  C: Char;
  Index: Integer;
begin
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwAsm) then
      begin
        {emit accurate line debug info}
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CodeGen^.SetCacheState('');

        {just copy to output assembly source}
        CodeGen^.EmitComment('asm statement: copying from input file');
        CodeGen^.EmitDebugLineNumber(Token.Line);

        repeat
          Ok := ReadChar(C);

          {warning! this will slow things down a bit ;)}
          if not (C in [CR, LF]) then {TODO: remove "not" ;}
            CodeGen^.EmitDebugLineNumber(Tokens^.InStream.CurrentLine);

          if Ok then
          begin
            if (C = sAsmEscape) then
              if ReadChar(C) then
              begin
                Index := Pos(C, sAsmEscapeSequences);
                if (Index <> 0) then
                  C := sAsmEscapeSequences[Index + 1];
                CodeGen^.Emit(C);
                C := sAsmEscape; {not a ";"}
              end
              else
                Error(ceErrorInAsmStatement)
            else
              if (C <> ';') then
                CodeGen^.Emit(C);
          end;
        until (C = ';') or (not Ok);
        if not Ok then
          Error(ceErrorInAsmStatement)
        else
        begin
          CodeGen^.EmitLine('');
          CodeGen^.EmitComment('asm statement finished');
          Temp := True;
        end;
      end
      else
        PutBack(Token);

  CompileAsmStatement := Temp;
end; {CompileAsmStatement}

function CompileBeginStatement: Boolean; {BeginStatement}
var
  Temp: Boolean;
  Label1, Label2: String;
  CacheState, LastCacheState: String;
begin
  {Assembly code is as follows:
  ; begin
  Label1:
    ... test condition ...
    if fails JMP Label2
    ... sequence 1 ...
    JMP Label1
  Label2:
  }
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwBegin) then
      begin
        {$IFDEF DEBUG}
        CodeGen^.EmitComment('begin statement');
        {$ENDIF DEBUG}
        Temp := True;

        {flush all cache values}
        CodeGen^.FlushTopCacheValues(cMaxCachedElements);

        {get two labels}
        Label1 := CodeGen^.GetNewLabel;
        Label2 := CodeGen^.GetNewLabel;

        {code just after 'begin'}
        CodeGen^.EmitLabel(Label1);
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CacheState := CodeGen^.GetCacheState;

        {calculate condition}
        CompileSequence;

        {check for 'while' or 'until' keyword}
        if ReadReservedWord(Token) then
        begin
          if (Token.N = rwWhile) then
          begin
            {$IFDEF DEBUG}
            CodeGen^.EmitComment('while (begin-while-repeat)');
            {$ENDIF DEBUG}

            {start the loop body by checking the condition}
            LastCacheState := CodeGen^.EmitIfCode(Label2);

            CompileSequence;

            {restore the cache state as if after 'begin'}
            CodeGen^.SetCacheState(CacheState);

            {check for 'repeat' keyword, perform JMP to 'begin'}
            if ReadReservedWord(Token) then
              if (Token.N = rwRepeat) then
              begin
                {generate debug info}
                CodeGen^.EmitDebugLineNumber(Token.Line);
                CodeGen^.EmitJmp(Label1);
              end
              else
                Error(ceRepeatExpected)
            else
              Error(ceRepeatExpected);

            {set cache state to the one after 'if' code}
            CodeGen^.SetCacheTo(LastCacheState);
            CodeGen^.EmitLabel(Label2);
          end
          else if (Token.N = rwUntil) then
          begin
            {$IFDEF DEBUG}
            CodeGen^.EmitComment('until (begin-until)');
            {$ENDIF DEBUG}

            {generate accurate debug info}
            CodeGen^.EmitDebugLineNumber(Token.Line);

            CodeGen^.EmitUntilCode(Label1, CacheState);
            Temp := True;
          end
          else
            Error(ceWhileExpected);
        end
        else
          Error(ceWhileExpected);

      end
      else
        PutBack(Token);

  CompileBeginStatement := Temp;
end; {CompileBeginStatement}

{New: do-loop statement is added for Forth compatibility}

function CompileDoLoopStatement: Boolean; {DoLoopStatement}
var
  Temp: Boolean;
  Label1, Label2: String;
  CacheState, LastCacheState: String;
begin
  {Asm code is as follows:
  ; do code
  Label1: IF <condition fails> JMP Label2
  ; body
          ... Sequence ...
  ; loop code
          JMP Label1
  Label2: DROP DROP
  ; end of do-loop}

  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwDo) then
      begin
        Temp := True;

        {get two labels for start and end of loop}
        Label1 := CodeGen^.GetNewLabel;
        Label2 := CodeGen^.GetNewLabel;

        {start 'do' loop}
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CacheState := CodeGen^.EmitDoCode(Label1, Label2);
        LastCacheState := CodeGen^.GetCacheState;

        CompileSequence;

        {check for 'loop' keyword}
        if ReadReservedWord(Token) then
          if (Token.N = rwLoop) then
          begin
            {generate accurate debug info}
            CodeGen^.EmitDebugLineNumber(Token.Line);
            CodeGen^.FlushTopCacheValues(cMaxCachedElements); {undocumented feature ;}
            CodeGen^.PerformOperation('++');
            CodeGen^.EmitLoopCode(Label1, Label2, CacheState);
            CodeGen^.SetCacheTo(LastCacheState);
            CodeGen^.EmitDropCode(2);
          end
          else
            Error(ceLoopExpected)
        else
          Error(ceLoopExpected);
      end
      else
        PutBack(Token);

  CompileDoLoopStatement := Temp;
end; {CompileDoLoopStatement}

function CompileDowntoLoopStatement: Boolean; {DowntoLoopStatement}
var
  Temp: Boolean;
  Label1, Label2: String;
  CacheState, LastCacheState: String;
begin
  {Asm code is as follows:
  ; downto code
  Label1: IF <condition fails> JMP Label2
  ; body
          ... Sequence ...
  ; loop code
          JMP Label1
  Label2: DROP DROP
  ; end of downto-loop}
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwDownto) then
      begin
        Temp := True;
        {get two labels for start and end of loop}
        Label1 := CodeGen^.GetNewLabel;
        Label2 := CodeGen^.GetNewLabel;
        {start 'downto' loop}
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CacheState := CodeGen^.EmitDowntoCode(Label1, Label2);
        LastCacheState := CodeGen^.GetCacheState;

        CompileSequence;

        {check for 'loop' keyword}
        if ReadReservedWord(Token) then
          if (Token.N = rwLoop) then
          begin
            {generate accurate debug info}
            CodeGen^.EmitDebugLineNumber(Token.Line);
            CodeGen^.EmitLoopCode(Label1, Label2, CacheState);
            CodeGen^.SetCacheTo(LastCacheState);
            CodeGen^.EmitDropCode(2);
          end
          else
            Error(ceLoopExpected)
        else
          Error(ceLoopExpected);
      end
      else
        PutBack(Token);

  CompileDowntoLoopStatement := Temp;
end; {CompileDowntoLoopStatement}

function CompileIfStatement: Boolean; {IfStatement}
var
  Temp: Boolean;
  Label1, Label2: String;
  CacheState, LastCacheState: String;
begin
  {ASM code is as follows:
       ... condition ...
       IF fails JMP Label1
       ... sequence 1 ...
       JMP Label2
  Label1:
  ; else /* optional part */
       ... sequence 2 ...
  ; then
  Label2:
  }
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwIf) then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);
        Temp := True;
        {get two labels}
        Label1 := CodeGen^.GetNewLabel;
        Label2 := CodeGen^.GetNewLabel;
        {start the first block}
        CacheState := CodeGen^.EmitIfCode(Label1);

        CompileSequence;

        {get cache state after 'if' block}
        CodeGen^.FlushTopCacheValues(cMaxCachedElements);
        LastCacheState := CodeGen^.GetCacheState;
        CodeGen^.EmitJmp(Label2);
        CodeGen^.EmitLabel(Label1);

        {check for 'then' or 'else' keyword}
        if ReadReservedWord(Token) then
        begin
          CodeGen^.SetCacheTo(CacheState);

          {else - optional part}
          if (Token.N) = rwElse then
          begin
            {$IFDEF DEBUG}
            CodeGen^.EmitComment('else part (optional)');
            {$ENDIF DEBUG}

            {generate accurate debug info}
            CodeGen^.EmitDebugLineNumber(Token.Line);

            CodeGen^.SetCacheTo(CacheState);
            CompileSequence;
            CodeGen^.FlushTopCacheValues(cMaxCachedElements);
            CodeGen^.FlushTopCacheValues(cMaxCachedElements);
          end
          else
            PutBack(Token);

          {$IFDEF DEBUG}
          CodeGen^.EmitComment('else part cache setting');
          {$ENDIF DEBUG}

          {set cache state to LastCacheState even if 'else' missed}
          CodeGen^.SetCacheState(LastCacheState);

          {then}
          if ReadReservedWord(Token) then
            if (Token.N) = rwThen then
            begin
              {$IFDEF DEBUG}
              CodeGen^.EmitComment('then label');
              {$ENDIF DEBUG}

              {generate accurate debug info}
              CodeGen^.EmitDebugLineNumber(Token.Line);
              CodeGen^.EmitLabel(Label2);

              CodeGen^.SetCacheTo(LastCacheState);

              { HERE goes the brief explanation of cache stuff
              ...
              if   // if-then-else
                <CacheState> ... <LastCacheState>
              else
                <CacheState> ... <Unknown cache state>
                set cache state <LastCacheState>
              then
              <LastCacheState> ...
              ...
              if  // if-then, no else part
                <CacheState> ... <LastCacheState>
              // insert here dummy else part and
              // set cache state to <LastCacheState>
              then
              <LastCacheState> ...
              }

              {$IFDEF DEBUG}
              CodeGen^.GetCacheState;
              {$ENDIF DEBUG}
            end
            else
              Error(ceThenExpected)
          else
            Error(ceThenExpected);
        end
        else
          Error(ceThenExpected);
      end
      else
        PutBack(Token);

  CompileIfStatement := Temp;
end; {CompileIfStatement}

function CompileInlineStatement: Boolean; {InlineStatement}
var
  Temp: Boolean;
begin
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwInline) then
      begin
        {TODO: place things here}
        CodeGen^.EmitDebugLineNumber(Token.Line);

        while ReadInteger(Token) do
        begin
          CodeGen^.EmitDebugLineNumber(Token.Line);
          CodeGen^.EmitDataByte(Token.I);
        end;

        if ReadDelimiter(Token) then
          if (Delimiters[Token.I] = ';') then
            Temp := True
         else
            Error(ceSemicolonExpected)
        else
          Error(ceSemicolonExpected);
      end
      else
        PutBack(Token);

  CompileInlineStatement := Temp;
end; {CompileInlineStatement}

(*function CompileRepeatStatement: Boolean; {RepeatStatement}
var
  Temp: Boolean;
  Label1: String;
  CacheState: String;
begin
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwRepeat) then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);

        {optimization control}
        CodeGen^.FlushTopCacheValues(cMaxCachedElements);
        CacheState := CodeGen^.GetCacheState;
        Label1 := CodeGen^.GetNewLabel;
        CodeGen^.EmitLabel(Label1);

        CompileSequence;

        {check for 'until' keyword}
        if ReadReservedWord(Token) then
          if (Token.N = rwUntil) then
          begin
            {generate accurate debug info}
            CodeGen^.EmitDebugLineNumber(Token.Line);

            CodeGen^.EmitUntilCode(Label1, CacheState);
            Temp := True;
          end
          else
            Error(ceUntilExpected)
        else
          Error(ceUntilExpected);
      end
      else
        PutBack(Token);

  CompileRepeatStatement := Temp;
end; {CompileRepeatStatement}*)

function CompileToLoopStatement: Boolean; {ToLoopStatement}
var
  Temp: Boolean;
  Label1, Label2: String;
  CacheState, LastCacheState: String;
begin
  {Asm code is as follows:
  ; to code
  Label1: IF <condition fails> JMP Label2
  ; body
          ... Sequence ...
  ; loop code
          JMP Label1
  Label2: DROP DROP
  ; end of to-loop}
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwTo) then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);
        Temp := True;
        {get two labels for start and end of loop}
        Label1 := CodeGen^.GetNewLabel;
        Label2 := CodeGen^.GetNewLabel;
        {start 'to' loop}
        CacheState := CodeGen^.EmitToCode(Label1, Label2);
        LastCacheState := CodeGen^.GetCacheState;

        CompileSequence;

        {check for 'loop' keyword}
        if ReadReservedWord(Token) then
          if (Token.N = rwLoop) then
          begin
            {generate accurate debug info}
            CodeGen^.EmitDebugLineNumber(Token.Line);
            CodeGen^.EmitLoopCode(Label1, Label2, CacheState);
            CodeGen^.SetCacheTo(LastCacheState);
            CodeGen^.EmitDropCode(2);
          end
          else
            Error(ceLoopExpected)
        else
          Error(ceLoopExpected);
      end
      else
        PutBack(Token);

  CompileToLoopStatement := Temp;
end; {CompileToLoopStatement}

function CompileGlobalVariableDefinition: Boolean; {GlobalVariableDefinition}
var
  Temp: Boolean;
  VariableName: String;
  ArraySize: LongInt;
begin
  Temp := False;
  ArraySize := 0;

  if CompileTypeName then
  begin
    while TryToCompileIdentifier do
    begin
      {is it array?}
      with Tokens^ do
        if ReadDelimiter(Token) then
          if (Delimiters[Token.I] = '[') then
            if ReadInteger(Token) then
            begin
              {get array size}
              ArraySize := Token.I;
              if (ArraySize <= 0) then
                Error(ceArraySizeMustBeGreaterThanZero);
              {match right bracket}
              if ReadDelimiter(Token) then
                if Delimiters[Token.I] = ']' then
                  {Ok}
                else
                  Error(ceRightBracketExpected)
              else
                Error(ceRightBracketExpected)
            end
            else
              Error(ceIntegerConstantExpected)
          else
            PutBack(Token);

      CodeGen^.StartProcedureDefinition(CurrentIdentifier);
      Publics^.EmitExternalSymbol(CurrentIdentifier, 'NEAR');

      VariableName := CodeGen^.GetNewVariable;
      CodeGen^.PushVariablePointerUncached(VariableName);

      CodeGen^.DataSegment;
      if (CurrentType = ctInteger) then
        if (ArraySize < 2) then
          CodeGen^.EmitDWordVariable(VariableName, 0)
        else
          CodeGen^.EmitDWordArray(VariableName, ArraySize)
      else if (CurrentType = ctString) then
        if (ArraySize < 2) then
          CodeGen^.EmitStringVariable(VariableName, '')
        else
          CodeGen^.EmitStringArray(VariableName, ArraySize);

      CodeGen^.CodeSegment;

      CodeGen^.FinishProcedureDefinition;
    end;
    with Tokens^ do
      if ReadDelimiter(Token) then
        if (Delimiters[Token.I] = ';') then
          Temp := True {Ok}
        else
          Error(ceSemicolonExpected)
      else
        Error(ceSemicolonExpected)
  end;

  CompileGlobalVariableDefinition := Temp;
end; {CompileGlobalVariableDefinition}

function CompileTypeName: Boolean; {TypeName}
var
  Temp: Boolean;
begin
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwInt) then
      begin
        Temp := True;
        CurrentType := ctInteger;
      end
      else if (Token.N = rwString) then
      begin
        Temp := True;
        CurrentType := ctString;
      end
      else
        PutBack(Token);

  CompileTypeName := Temp;
end; {CompileTypeName}

function CompileVariableDefinition: Boolean; {VariableDefinition}
var
  Temp: Boolean;
  VariableName: String;
  ArraySize: Integer;
begin
  Temp := False;
  ArraySize := 1;

  if CompileTypeName then
  begin
    while TryToCompileIdentifier do
    begin
      {is it array?}
      with Tokens^ do
        if ReadDelimiter(Token) then
          if (Delimiters[Token.I] = '[') then
            if ReadInteger(Token) then
            begin
              {get array size}
              ArraySize := Token.I;
              if (ArraySize <= 0) then
                Error(ceArraySizeMustBeGreaterThanZero);
              {match right bracket}
              if ReadDelimiter(Token) then
                if Delimiters[Token.I] = ']' then
                  {Ok}
                else
                  Error(ceRightBracketExpected)
              else
                Error(ceRightBracketExpected)
            end
            else
              Error(ceIntegerConstantExpected)
          else
            PutBack(Token);

      if (CurrentType = ctInteger) or (CurrentType = ctString) then
      begin
        LocalVariables^.Add(CurrentIdentifier);
        LocalSpace := LocalSpace + 4 * ArraySize;
        CodeGen^.EmitIntegerEquate(CurrentProcedure + '_' + CurrentIdentifier, LocalSpace);
        {variable or array element is either 32-bit integer value or pointer to ds:string}
      end;
    end;

    with Tokens^ do
      if ReadDelimiter(Token) then
        if (Delimiters[Token.I] = ';') then
          Temp := True {Ok}
        else
          Error(ceSemicolonExpected)
      else
        Error(ceSemicolonExpected)
  end;

  CompileVariableDefinition := Temp;
end; {CompileVariableDefinition}

function CompileConstant: Boolean; {Constant}
var
  Temp: Boolean;
  Variable1: String;
begin
  Temp := True;

  with Tokens^ do
    {string constant}
    if ReadString(Token, sStringChars) then
    begin
      CodeGen^.EmitDebugLineNumber(Token.Line);
      CodeGen^.PushStringConstant(Token.S);
    end
    {character constant}
    else if ReadString(Token, sCharacterChars) then
    begin
      if (Length(Token.S) > 4) then
        Error(ceCharacterConstantTooLong);

      CodeGen^.EmitDebugLineNumber(Token.Line);
      CodeGen^.PushIntegerConstant(StrToLongInt(Token.S));
    end
    {integer constant}
    else if ReadInteger(Token) then
    begin
      CodeGen^.EmitDebugLineNumber(Token.Line);
      CodeGen^.PushIntegerConstant(Token.I);
    end
    else Temp := False;

  CompileConstant := Temp;
end; {CompileConstant}

function CompileProcedureCall: Boolean; {ProcedureCall}
var
  Temp: Boolean;
  VariableName: String;
  Index, LineNumber: Integer;

  function CompilePreDefinedIdentifier: Boolean; {no such rule ;}
  var
    Temp: Boolean;
    Identifier: TPredefinedIdentifier;
  begin
    Temp := True;
    Identifier := IsPreDefinedIdentifier(CurrentIdentifier);

    case Identifier of
      idNull: CodeGen^.PushIntegerConstant(0);
      idFalse: CodeGen^.PushIntegerConstant(0);
      idTrue: CodeGen^.PushIntegerConstant(1);
      idsFile: CodeGen^.PushStringConstant(LowerCase(CurrentFile));
      idsLine: CodeGen^.PushStringConstant(IntToStr(Token.Line));
      idnLine: CodeGen^.PushIntegerConstant(Token.Line);
      idsName: CodeGen^.PushStringConstant(CurrentProcedure);
      idsDay, idsMonth, idsYear, idsDate, idsUsDate, idsShortDate,
        idsShortUsDate, idsWhyDate, idsWhyUsDate, idsTime:
          CodeGen^.PushStringConstant(DateTimeString(Identifier));
      else Temp := False;
    end;

    CompilePreDefinedIdentifier := Temp;
  end; {CompilePreDefinedIdentifier}

begin
  Temp := True;

  if TryToCompileIdentifier then
  begin
    VariableName := CurrentIdentifier;
    CodeGen^.EmitDebugLineNumber(Token.Line);

    {is it a local variable?}
    if (LocalVariables^.Search(@VariableName, Index)) then
      CodeGen^.PushLocalVariable(CurrentProcedure, VariableName)
    else {is it pre-defined identifier?}
      if not CompilePreDefinedIdentifier then
        {it's either procedure or external variable wrapped with procedure}
        CodeGen^.Call(CurrentIdentifier);
  end
  else
    Temp := False;

  CompileProcedureCall := Temp;
end; {CompileProcedureCall}

function CompileSimpleStatement: Boolean; {SimpleStatement}
var
  Temp: Boolean;
begin
  Temp := True;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwDrop) then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CodeGen^.EmitDropCode(1);
      end
      else if (Token.N = rwDup) then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CodeGen^.EmitDupCode;
      end
      else if (Token.N = rwRot) then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CodeGen^.EmitRotCode;
      end
      else if (Token.N = rwSwap) then
      begin
        CodeGen^.EmitDebugLineNumber(Token.Line);
        CodeGen^.EmitSwapCode;
      end
      else
      begin
        PutBack(Token);
        Temp := False;
      end
    else
      Temp := False;

  CompileSimpleStatement := Temp;
end; {CompileSimpleStatement}

function CompilePragma: Boolean; {Pragma}
var
  Temp: Boolean;
begin
  Temp := False;

  with Tokens^ do
    if ReadReservedWord(Token) then
      if (Token.N = rwPragma) then
      begin
        while CompileSetting do;
        if ReadDelimiter(Token) then
          if (Delimiters[Token.I] = ';') then
            Temp := True {ok}
          else
            Error(ceSemicolonExpected)
        else
          Error(ceSemicolonExpected);
      end
      else
        PutBack(Token);

  CompilePragma := Temp;
end; {CompilePragma}

function CompileSetting: Boolean; {Setting}
var
  Temp: Boolean;
  i: Integer;
  Identifier: String;
begin
  Temp := True;

  with Tokens^ do
    if ReadIdentifier(Token) then
    begin
      Identifier := LowerCase(Token.S);
      if (Identifier = 'setcachestate') then
      begin
        if ReadString(Token, sStringChars) then
          CodeGen^.SetCacheState(ValidCacheString(Token.S))
        else
          Error(ceStringConstantExpected);
      end
      else if (Identifier = 'setcacheto') then
      begin
        if ReadString(Token, sStringChars) then
          CodeGen^.SetCacheTo(ValidCacheString(Token.S))
        else
          Error(ceStringConstantExpected);
      end
      else
      begin
        PutBack(Token);
        Temp := False;
      end;
    end
    else
      Temp := False;

  CompileSetting := Temp;
end; {CompileSetting}

procedure CompileEndOfFile; {EndOfFile}
begin
  with Tokens^ do
    if Read(Token) then
      Error(ceEndOfFileExpected)
    else
      if (InStream.Status = 0) then
        Error(ceEndOfFileExpected);
end; {CompileEndOfFile}

end {CSyntax}.