ORCA-C/Parser.pas

{$optimize 1}
{---------------------------------------------------------------}
{                                                               }
{  Parser                                                       }
{                                                               }
{  External Subroutines:                                        }
{                                                               }
{  DoDeclaration - process a variable or function declaration   }
{  DoStatement - process a statement from a function            }
{  InitParser - initialize the parser                           }
{  Match - insure that the next token is of the specified type  }
{  TermParser - shut down the parser                            }
{  TypeSpecifier - handle a type specifier                      }
{                                                               }
{---------------------------------------------------------------}

unit Parser;

{$LibPrefix '0/obj/'}

interface

uses CCommon, Table, MM, CGI, Scanner, Header, Symbol, Expression, Asm;

{$segment 'parser'}

{---------------------------------------------------------------}

procedure DoDeclaration (doingPrototypes: boolean);

{ process a variable or function declaration                    }
{                                                               }
{ parameters:                                                   }
{       doingPrototypes - are we processing a parameter list?   }


procedure DoStatement;

{ process a statement from a function                           }


procedure InitParser;

{ Initialize the parser                                         }


procedure Match (kind: tokenEnum; err: integer);

{ insure that the next token is of the specified type           }
{                                                               }
{  parameters:                                                  }
{       kind - expected token kind                              }
{       err - error number if the expected token is not found   }


procedure TermParser;

{ shut down the parser                                          }


procedure TypeSpecifier (doingFieldList,isConstant: boolean);

{ handle a type specifier                                       }
{                                                               }
{ parameters:                                                   }
{       doingFieldList - are we processing a field list?        }
{       isConstant - did we already find a constsy?             }

{---------------------------------------------------------------}

implementation

const
   maxBitField = 32;                    {max # of bits in a bit field}
 
type

   identList = ^identNode;              {list of ids; used for initializers}
   identNode = record
      next: identList;
      id: identPtr;
      end;

   { The switch record is used to record the values for the     }
   { switch jump table.  The linked list of entries is in order }
   { of increasing switch value (val).                          }

   switchPtr = ^switchRecord;           {switch label table entry}
   switchRecord = record
      next,last: switchPtr;             {doubly linked list (for inserts)}
      lab: integer;                     {label to branch to}
      val: longint;                     {switch value}
      end;

                                        {token stack}
                                        {-----------}
   tokenStackPtr = ^tokenStackRecord;
   tokenStackRecord = record
      next: tokenStackPtr;
      token: tokenType;
      end;
                                        {statement stack}
                                        {---------------}
   statementPtr = ^statementRecord;
                                        {kinds of nestable statements}
   statementKind = (compoundSt,ifSt,elseSt,doSt,whileSt,forSt,switchSt);
   statementRecord = record             {element of the statement stack}
      next: statementPtr;               {next element on the stack}
      breakLab, continueLab: integer;   {branch points for break, continue}
      case kind: statementKind of
         compoundSt: (
            doingDeclaration: boolean;  {doing declarations? (or statements)}
            );
         ifSt: (
            ifLab: integer;             {branch point}
            );
         elseSt: (
            elseLab: integer;           {branch point}
            );
         doSt: (
            doLab: integer;             {branch point}
            );
         whileSt: (
            whileTop: integer;          {label at top of while loop}
            whileEnd: integer;          {label at bottom of while loop}
            );
         forSt: (
            forLoop: integer;           {branch here to loop}
            e3List: tokenStackPtr;      {tokens for last expression}
            );
         switchSt: (
            maxVal: longint;            {max switch value}
            isLong: boolean;            {do long switch?}
            ln: integer;                {temp var number}
            size: integer;              {temp var size}
            labelCount: integer;        {# of switch labels}
            switchExit: integer;        {branch point}
            switchLab: integer;         {branch point}
            switchList: switchPtr;      {list of labels and values}
            switchDefault: integer;     {default branch point}
            );
      end;

var
   doingMain: boolean;                  {are we processing the main function?}
   firstCompoundStatement: boolean;     {are we doing a function level compound statement?}
   fType: typePtr;                      {return type of the current function}
   initializerList: identList;          {list of initialized identifiers}
   isForwardDeclared: boolean;          {is the field list component           }
                                        { referenceing a forward struct/union? }
   isFunction: boolean;                 {is the declaration a function?}
   isPascal: boolean;                   {has the pascal modifier been used?}
                                        { (set by DoDeclaration)}
   returnLabel: integer;                {label for exit point}
   skipDeclarator: boolean;             {for enum,struct,union with no declarator}
   statementList: statementPtr;         {list of open statements}

                                        {parameter processing variables}
                                        {------------------------------}
   lastParameter: identPtr;             {next parameter to process}
   numberOfParameters: integer;         {number of indeclared parameters}
   pfunc: identPtr;                     {func. for which parms are being defined}
   protoType: typePtr;                  {type from a parameter list}
   protoVariable: identPtr;             {variable from a parameter list}

                                        {type info for the current declaration}
                                        {-------------------------------------}
   storageClass: tokenEnum;             {storage class of the declaration}
{  typeSpec: typePtr;    (in CCommon)   {type specifier}

{-- Parser Utility Procedures ----------------------------------}

procedure Match {kind: tokenEnum; err: integer};

{ insure that the next token is of the specified type           }
{                                                               }
{  parameters:                                                  }
{       kind - expected token kind                              }
{       err - error number if the expected token is not found   }

begin {Match}
if token.kind = kind then
   NextToken
else
   Error(err);
end; {Match}


procedure SkipStatement;

{ Skip the remainder of the current statement                   }

var
   bracketCount: integer;               {for error skip}

begin {SkipStatement}
bracketCount := 0;
while (token.kind <> eofsy) and
   ((token.kind <> semicolonch) or (bracketCount <> 0)) do begin
   if token.kind = lbrackch then
      bracketCount := bracketCount+1;
   if token.kind = rbrackch then
      if bracketCount <> 0 then
         bracketCount := bracketCount-1;
   NextToken;
   end; {while}
if token.kind = semicolonch then
   NextToken;
end; {SkipStatement}


procedure GotoLabel (op: pcodes);

{ Find a label in the goto label list, creating one if one      }
{ does not already exist.  Generate the label or a jump to it   }
{ based on op.                                                  }
{                                                               }
{ paremeters:                                                   }
{       op - operation code to create                           }

label 1;

var
   gt: gotoPtr;                         {work pointer}

begin {GotoLabel}
gt := gotoList;                         {try to find an existing label}
while gt <> nil do begin
   if gt^.name^ = token.name^ then
      goto 1;
   gt := gt^.next;
   end; {while}
gt := pointer(Malloc(sizeof(gotoRecord))); {no label record exists: create one}
gt^.next := gotoList;
gotoList := gt;
gt^.name := token.name;
gt^.lab := GenLabel;
gt^.defined := false;
1:
if op = dc_lab then begin
   if gt^.defined then
      Error(77)
   else begin
      gt^.defined := true;
      Gen1(dc_lab, gt^.lab);
      end; {else}
   end {if}
else
   Gen1(pc_ujp, gt^.lab);
end; {GotoLabel}


{-- Statements -------------------------------------------------}

procedure CompoundStatement (makeSymbols: boolean);

{ handle a compound statement                                   }
{								}
{ Parameters:							}
{    makeSymbols - create a symbol table? (False for a		}
{       function's outer wrapper, true for imbeded statements)	}

var
   stPtr: statementPtr;                 {for creating a compound statement record}

begin {CompoundStatement}
Match(lbracech,27);                     {make sure there is an opening '{'}
new(stPtr);                             {create a statement record}
stPtr^.next := statementList;
statementList := stPtr;
stPtr^.kind := compoundSt;
if makeSymbols then			{create a symbol table}
   PushTable;
stPtr^.doingDeclaration := true;        {allow declarations}
initializerList := nil;                 {no initializers, yet}
end; {CompoundStatement}


procedure EndCompoundStatement;

{ finish off a compound statement                               }

var
   dumpLocal: boolean;                  {dump the local memory pool?}
   tl: tempPtr;                         {work pointer}
   stPtr: statementPtr;                 {work pointer}

begin {EndCompoundStatement}
dumpLocal := false;
stPtr := statementList;                 {pop the statement record}
statementList := stPtr^.next;
doingFunction := statementList <> nil;  {see if we're done with the function}
if not doingFunction then begin         {if so, finish it off}
   Gen1(dc_lab, returnLabel);
   with fType^ do                       {generate the pc_ret instruction}
      case kind of
         scalarType  : Gen0t(pc_ret, baseType);
         arrayType   : ;
         structType  ,
         unionType   ,
         pointerType : Gen0t(pc_ret, cgULong);
         functionType: ;
         enumConst   : ;
         enumType    : Gen0t(pc_ret, cgWord);
         definedType : ;
         otherwise: Error(57);
         end; {case}
   Gen0 (dc_enp);                       {finish the segment}
   CheckGotoList;                       {make sure all labels are declared}
   while tempList <> nil do begin       {dump the local labels}
      tl := tempList;
      tempList := tl^.next;
      dispose(tl);
      end; {while}
   dumpLocal := true;                   {dump the local pool}
   nameFound := false;                  {no pc_nam for the next function (yet)}
   end; {if}
PopTable;				{remove this symbol table}
dispose(stPtr);                         {dump the record}
if dumpLocal then begin
   useGlobalPool := true;               {start using the global memory pool}
   LInit;                               {dispose of the local memory pool}
   end; {if}
NextToken;                              {remove the rbracech token}
end; {EndCompoundStatement}


procedure Statement;

{ handle a statement                                            }

label 1;

var
   lToken,tToken: tokenType;            {for look-ahead}
   lPrintMacroExpansions: boolean;      {local copy of printMacroExpansions}


   function GetSwitchRecord: statementPtr;

   { Find the enclosing switch statement                        }
   {                                                            }
   { Returns a pointer to the closest switch statement record,  }
   { or nil if there are none.                                  }

   label 1;

   var
      stPtr: statementPtr;              {work pointer}

   begin {GetSwitchRecord}
   stPtr := statementList;
   while stPtr <> nil do begin
      if stPtr^.kind = switchSt then
         goto 1;
      stPtr := stPtr^.next;
      end; {while}
1: GetSwitchRecord := stPtr;
   end; {GetSwitchRecord}


   procedure AssignmentStatement;
 
   { handle an asignment statement                               }
 
   begin {AssignmentStatement}
   if token.kind in startExpression then begin
      Expression(normalExpression, [semicolonch]);
      if expressionType^.baseType <> cgVoid then
         Gen0t(pc_pop, UsualUnaryConversions);
      if token.kind = semicolonch then
         NextToken
      else begin
         Error(22);
         SkipStatement;
         end; {else}
      end {if}
   else begin
      NextToken;
      Error(92);
      end; {else}
   end; {AssignmentStatement}


   procedure BreakStatement;
 
   { handle a break statement                                    }
 
   label 1,2;

   var
      stPtr: statementPtr;              {work pointer}

   begin {BreakStatement}
   stPtr := statementList;              {find the proper statement}
   while stPtr <> nil do begin
      if stPtr^.kind in [whileSt,doSt,forSt,switchSt] then
         goto 1;
      stPtr := stPtr^.next;
      end; {while}
   Error(76);
   goto 2;

1: if stPtr^.breakLab = 0 then          {if there is no break label, create one}
      stPtr^.breakLab := GenLabel;
   Gen1(pc_ujp, stPtr^.breakLab);       {branch to the break label}
2:
   NextToken;                           {skip the 'break' token}
   Match(semicolonch,22);               {insist on a closing ';'}
   end; {BreakStatement}


   procedure CaseStatement;
 
   { handle a case statement                                     }

   var
      stPtr: statementPtr;              {switch record for this case label}
      swPtr,swPtr2: switchPtr;          {work pointers for inserting new entry}
      val: integer;                     {case label value}

   begin {CaseStatement}
   while token.kind = casesy do begin
      NextToken;                        {skip the 'case' token}
      stPtr := GetSwitchRecord;         {get the proper switch record}
      Expression(arrayExpression, [colonch]); {evaluate the branch condition}
      val := long(expressionValue).lsw;
      if val <> expressionValue then
         if not stPtr^.isLong then
            Error(71);
      if stPtr = nil then
         Error(72)
      else begin
         new(swPtr2);                   {create the new label table entry}
         swPtr2^.lab := GenLabel;
         Gen1(dc_lab, swPtr2^.lab);
         swPtr2^.val := expressionValue;
         swPtr := stPtr^.switchList;
         if swPtr = nil then begin      {enter it in the table}
            swPtr2^.last := nil;
            swPtr2^.next := nil;
            stPtr^.switchList := swPtr2;
            stPtr^.maxVal := expressionValue;
            stPtr^.labelCount := 1;
            end {if}
         else begin
            while (swPtr^.next <> nil) and (swPtr^.val < expressionValue) do
               swPtr := swPtr^.next;
            if swPtr^.val = expressionValue then
               Error(73)
            else if swPtr^.val > expressionValue then begin
               swPtr2^.next := swPtr;
               if swPtr^.last = nil then
                  stPtr^.switchList := swPtr2
               else
                  swPtr^.last^.next := swPtr2;
               swPtr2^.last := swPtr^.last;
               swPtr^.last := swPtr2;
               end {else if}
            else begin {at end of list}
               swPtr2^.next := nil;
               swPtr2^.last := swPtr;
               swPtr^.next := swPtr2;
               stPtr^.maxVal := expressionValue;
               end; {else}
            stPtr^.labelCount := stPtr^.labelCount + 1;
            end; {else}
         end; {else}

      Match(colonch,29);                {get the colon}
      end; {while}
   Statement;                           {process the labeled statement}
   end; {CaseStatement}


   procedure ContinueStatement;
 
   { handle a continue statement                                 }
 
   label 1,2;

   var
      stPtr: statementPtr;              {work pointer}

   begin {ContinueStatement}
   stPtr := statementList;              {find the proper statement}
   while stPtr <> nil do begin
      if stPtr^.kind in [whileSt,doSt,forSt] then
         goto 1;
      stPtr := stPtr^.next;
      end; {while}
   Error(75);
   goto 2;

1: if stPtr^.continueLab = 0 then       {if there is no continue label, create one}
      stPtr^.continueLab := GenLabel;
   Gen1(pc_ujp, stPtr^.continueLab);    {branch to the continue label}
2:
   NextToken;                           {skip the 'continue' token}
   Match(semicolonch,22);               {insist on a closing ';'}
   end; {ContinueStatement}


   procedure DefaultStatement;
 
   { handle a default statement                                  }
 
   var
      stPtr: statementPtr;              {work pointer}

   begin {DefaultStatement}
   NextToken;                           {skip the 'default' token}
   Match(colonch,29);                   {get the colon}
   stPtr := GetSwitchRecord;            {record the presense of a default label}
   if stPtr = nil then
      Error(72)
   else if stPtr^.switchDefault <> 0 then
      Error(74)
   else begin
      stPtr^.switchDefault := GenLabel;
      Gen1(dc_lab, stPtr^.switchDefault);
      end; {else}
   Statement;                           {process the labeled statement}
   end; {DefaultStatement}


   procedure DoStatement;
 
   { handle a do statement                                       }
 
   var
      lab: integer;                     {branch label}
      stPtr: statementPtr;              {work pointer}
 
   begin {DoStatement}
   NextToken;                           {skip the 'do' token}
   new(stPtr);                          {create a statement record}
   stPtr^.next := statementList;
   statementList := stPtr;
   stPtr^.kind := doSt;
   lab := GenLabel;                     {create the branch label}
   Gen1(dc_lab, lab);
   stPtr^.doLab := lab;
   stPtr^.breakLab := 0;
   stPtr^.continueLab := 0;
   Statement;                           {process the first loop body statement}
   end; {DoStatement}


   procedure ForStatement;
 
   { handle a for statement                                      }
 
   var
      errorFound: boolean;              {did we find an error?}
      forLoop, continueLab, breakLab: integer; {branch points}
      lType: typePtr;                   {type of "left" expression}
      parencount: integer;              {number of unmatched '(' chars}
      stPtr: statementPtr;              {work pointer}
      tl,tk: tokenStackPtr;             {for forming expression list}

   begin {ForStatement}
   NextToken;                           {skip the 'for' token}
   new(stPtr);                          {create a statement record}
   stPtr^.next := statementList;
   statementList := stPtr;
   stPtr^.kind := forSt;
   forLoop := GenLabel;                 {create the branch labels}
   continueLab := GenLabel;
   breakLab := GenLabel;
   stPtr^.forLoop := forLoop;
   stPtr^.continueLab := continueLab;
   stPtr^.breakLab := breakLab;

   Match(lparench,13);                  {evaluate the start condition}
   if token.kind <> semicolonch then begin
      Expression(normalExpression, [semicolonch]);
      Gen0t(pc_pop, UsualUnaryConversions);
      end; {if}
   Match(semicolonch,22);

   Gen1(dc_lab, forLoop);               {this label points to the condition}
   if token.kind <> semicolonch then    {handle the loop test}
      begin                             {evaluate the expression}
      Expression(normalExpression, [semicolonch]);
      CompareToZero(pc_neq);            {Evaluate the condition}
      Gen1(pc_fjp, breakLab);
      end; {if}
   Match(semicolonch,22);

   tl := nil;                           {collect the tokens for the last expression}
   parencount := 0;
   errorFound := false;
   while (token.kind <> eofsy)
      and ((token.kind <> rparench) or (parencount <> 0))
      and (token.kind <> semicolonch) do begin
      new(tk);                          {place the token in the list}
      tk^.next := tl;
      tl := tk;
      tk^.token := token;
      if token.kind = lparench then     {allow parens in the expression}
         parencount := parencount+1
      else if token.kind = rparench then
         parencount := parencount-1;
      NextToken;                        {next token}
      end; {while}
   if errorFound then                   {if an error was found, dump the list}
      while tl <> nil do begin
         tk := tl;
         tl := tl^.next;
         dispose(tk);
         end; {while}
   stPtr^.e3List := tl;                 {save the list}
   Match(rparench,12);                  {get the closing for loop paren}

   Statement;                           {process the first loop body statement}
   end; {ForStatement}


   procedure IfStatement;
 
   { handle an if statement                                      }
 
   var
      lab: integer;                     {branch label}
      lType: typePtr;                   {type of "left" expression}
      stPtr: statementPtr;              {work pointer}
 
   begin {IfStatement}
   NextToken;                           {skip the 'if' token}
   Match(lparench, 13);                 {evaluate the condition}
   Expression(normalExpression, [rparench]);
   Match(rparench, 12);

   lab := GenLabel;                     {create the branch label}
   CompareToZero(pc_neq);               {evaluate the condition}
   Gen1(pc_fjp, lab);

   new(stPtr);                          {create a statement record}
   stPtr^.next := statementList;
   statementList := stPtr;
   stPtr^.kind := ifSt;
   stPtr^.ifLab := lab;
   Statement;                           {process the 'true' statement}
   end; {IfStatement}


   procedure GotoStatement;
 
   { handle a goto statement                                     }
 
   begin {GotoStatement}
   NextToken;                           {skip the 'goto' token}
   if token.kind in [ident,typedef] then begin
      GotoLabel(pc_ujp);                {jump to the label}
      NextToken;                        {skip the token}
      end {if}
   else
      Error(9);                         {flag the error}
   Match(semicolonch, 22);              {insist on a closing ';'}
   end; {GotoStatement}


   procedure LabelStatement;
 
   { handle a labeled statement                                  }
 
   begin {LabelStatement}
   GotoLabel(dc_lab);                   {define the label}
   NextToken;                           {skip the label}
   if token.kind = colonch then         {if present, skip the colon}
      NextToken
   else begin                           {bad statement - flag error and skip it}
      Error(31);
      SkipStatement;
      end; {else}
   end; {LabelStatement}


   procedure ReturnStatement;
 
   { handle a return statement                                   }

   var
      id: identPtr;                     {structure id}
      size: longint;                    {size of the struct/union}
      tk: tokenType;                    {structure name token}

   begin {ReturnStatement}
   NextToken;                           {skip the 'return' token}
   if token.kind <> semicolonch then    {if present, evaluate the return value}
      begin
      if fType^.kind in [structType,unionType] then begin
         tk.kind := ident;
         tk.class := identifier;
         tk.name := @'@struct';
         tk.symbolPtr := nil;
         id := FindSymbol(tk, variableSpace, false, true);
         Gen1Name(pc_lao, 0, id^.name);
         size := fType^.size;
         end; {if}
      Expression(normalExpression, [semicolonch]);
      AssignmentConversion(fType, expressionType, lastWasConst, lastConst,
         true, true);
      case fType^.kind of
         scalarType:    Gen2t(pc_str, 0, 0, fType^.baseType);
         enumType:      Gen2t(pc_str, 0, 0, cgWord);
         pointerType:   Gen2t(pc_str, 0, 0, cgULong);
         structType,
         unionType:     begin
                        Gen2(pc_mov, long(size).msw, long(size).lsw);
                        Gen0t(pc_pop, cgULong);
                        end;
         otherwise:     ;
         end; {case}
      end; {if}
   Gen1(pc_ujp, returnLabel);           {branch to the exit point}
   Match(semicolonch, 22);              {insist on a closing ';'}
   end; {ReturnStatement}


   procedure SwitchStatement;
 
   { handle a switch statement                                   }
 
   var
      stPtr: statementPtr;              {work pointer}
      tp: typePtr;                      {for checking type}
 
   begin {SwitchStatement}
   NextToken;                           {skip the 'switch' token}
   new(stPtr);                          {create a statement record}
   stPtr^.next := statementList;
   statementList := stPtr;
   stPtr^.kind := switchSt;
   stPtr^.maxVal := -maxint4;
   stPtr^.isLong := false;
   stPtr^.labelCount := 0;
   stPtr^.switchLab := GenLabel;
   stPtr^.switchExit := GenLabel;
   stPtr^.breakLab := stPtr^.switchExit;
   stPtr^.switchList := nil;
   stPtr^.switchDefault := 0;
   Match(lparench, 13);                 {evaluate the condition}
   Expression(normalExpression,[rparench]);
   Match(rparench, 12);
   tp := expressionType;                {make sure the expression is integral}
   while tp^.kind = definedType do
      tp := tp^.dType;
   case tp^.kind of

      scalarType:
         if tp^.baseType in [cgLong,cgULong] then begin
            stPtr^.isLong := true;
            stPtr^.size := cgLongSize;
            stPtr^.ln := GetTemp(cgLongSize);
            Gen2t(pc_str, stPtr^.ln, 0, cgLong);
            end {if}
         else if tp^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then begin
            stPtr^.isLong := false;
            stPtr^.size := cgWordSize;
            stPtr^.ln := GetTemp(cgWordSize);
            Gen2t(pc_str, stPtr^.ln, 0, cgWord);
            end {else if}
         else
            Error(71);

      enumType: begin
         stPtr^.isLong := false;
         stPtr^.size := cgWordSize;
         stPtr^.ln := GetTemp(cgWordSize);
         Gen2t(pc_str, stPtr^.ln, 0, cgWord);
         end;

      otherwise:
         Error(71);
      end; {case}
   Gen1(pc_ujp, stPtr^.switchLab);      {branch to the xjp instruction}
   Statement;                           {process the loop body statement}
   end; {SwitchStatement}


   procedure WhileStatement;
 
   { handle a while statement                                    }

   var
      lType: typePtr;                   {type of "left" expression}
      stPtr: statementPtr;              {work pointer}
      top, endl: integer;               {branch points}

   begin {WhileStatement}
   NextToken;                           {skip the 'while' token}
   new(stPtr);                          {create a statement record}
   stPtr^.next := statementList;
   statementList := stPtr;
   stPtr^.kind := whileSt;
   top := GenLabel;                     {create the branch labels}
   endl := GenLabel;
   stPtr^.whileTop := top;
   stPtr^.whileEnd := endl;
   stPtr^.breakLab := endl;
   stPtr^.continueLab := top;
   Gen1(dc_lab, top);                   {define the top label}
   Match(lparench, 13);                 {evaluate the condition}
   Expression(normalExpression, [rparench]);
   Match(rparench, 12);
   CompareToZero(pc_neq);               {evaluate the condition}
   Gen1(pc_fjp, endl);
   Statement;                           {process the first loop body statement}
   end; {WhileStatement}

begin {Statement}
1:
{if trace names are enabled and a line # is due, generate it}
if traceBack or debugFlag then
   if nameFound or debugFlag then
      if lastLine <> lineNumber then begin
         lastLine := lineNumber;
         Gen2(pc_lnm, lineNumber, ord(debugType));
         end; {if}

{handle the statement}
case token.kind of
   asmsy:               begin
                        NextToken;
                        AsmStatement;
                        end;
   breaksy:             BreakStatement;
   casesy:              CaseStatement;
   continuesy:          ContinueStatement;
   defaultsy:           DefaultStatement;
   dosy:                DoStatement;
   elsesy:              begin Error(25); SkipStatement; end;
   forsy:               ForStatement;
   gotosy:              GotoStatement;
   typedef,
   ident:               begin
                        lPrintMacroExpansions := printMacroExpansions;
                        printMacroExpansions := false;
                        lToken := token;
                        NextToken;
                        tToken := token;
                        PutBackToken(token, true);
                        token := lToken;
                        printMacroExpansions := lPrintMacroExpansions;
                        if tToken.kind = colonch then begin
                           LabelStatement;
                           goto 1;
                           end {if}
                        else
                           AssignmentStatement;
                        end;
   ifsy:                IfStatement;
   lbracech:            CompoundStatement(true);
   returnsy:            ReturnStatement;
   semicolonch:         NextToken;
   switchsy:            SwitchStatement;
   whilesy:             WhileStatement;
   otherwise:           AssignmentStatement;
   end; {case}
end; {Statement}


procedure EndDoStatement;

{ finish off a do statement                                     }

var
   lType: typePtr;                      {type of "left" expression}
   stPtr: statementPtr;                 {work pointer}

begin {EndDoStatement}
stPtr := statementList;                 {get the statement record}
if token.kind = whilesy then begin      {if a while clause exists, process it}
   NextToken;                           {skip the 'while' token}
   if stPtr^.continueLab <> 0 then      {create the continue label}
      Gen1(dc_lab, stPtr^.continueLab);
   Match(lparench, 13);                 {evaluate the condition}
   Expression(normalExpression, [rparench]);
   Match(rparench, 12);
   CompareToZero(pc_equ);               {evaluate the condition}
   Gen1(pc_fjp, stPtr^.doLab);
   Match(semicolonch, 22);              {process the closing ';'}
   end {if}
else
   Error(30);                           {'while' expected}
if stPtr^.breakLab <> 0 then            {create the break label}
   Gen1(dc_lab, stPtr^.breakLab);
statementList := stPtr^.next;           {pop the statement record}
dispose(stPtr);
end; {EndDoStatement}


procedure EndIfStatement;

{ finish off an if statement                                    }

var
   lab1,lab2: integer;                  {branch labels}
   stPtr: statementPtr;                 {work pointer}

begin {EndIfStatement}
stPtr := statementList;                 {get the label to branch to}
lab1 := stPtr^.ifLab;
statementList := stPtr^.next;           {pop the statement record}
dispose(stPtr);

if token.kind = elsesy then begin       {if an else clause exists, process it}
   NextToken;                           {skip 'else'}
   lab2 := GenLabel;                    {create the branch label}
   Gen1(pc_ujp, lab2);                  {branch past the else clause}
   Gen1(dc_lab, lab1);                  {create label for if to branch to}
   new(stPtr);                          {create a statement record}
   stPtr^.next := statementList;
   statementList := stPtr;
   stPtr^.kind := elseSt;
   stPtr^.elseLab := lab2;
   Statement;                           {evaluate the else clause}
   end {if}
else
   Gen1(dc_lab, lab1);                  {create label for if to branch to}
end; {EndIfStatement}


procedure EndElseStatement;

{ finish off an else clause                                     }

var
   stPtr: statementPtr;                 {work pointer}

begin {EndElseStatement}
stPtr := statementList;                 {create the label to branch to}
Gen1(dc_lab, stPtr^.elseLab);
statementList := stPtr^.next;           {pop the statement record}
dispose(stPtr);
end; {EndElseStatement}


procedure EndForStatement;

{ finish off a for statement                                    }

var
   ltoken: tokenType;                   {for putting ; on stack}
   stPtr: statementPtr;                 {work pointer}
   tl,tk: tokenStackPtr;                {for forming expression list}
   lPrintMacroExpansions: boolean;      {local copy of printMacroExpansions}

begin {EndForStatement}
stPtr := statementList;
Gen1(dc_lab, stPtr^.continueLab);       {define the continue label}

tl := stPtr^.e3List;                    {place the expression back in the list}
if tl <> nil then begin
   PutBackToken(token, false);
   ltoken.kind := semicolonch;
   ltoken.class := reservedSymbol;
   PutBackToken(ltoken, false);
   while tl <> nil do begin
      PutBackToken(tl^.token, false);
      tk := tl;
      tl := tl^.next;
      dispose(tk);
      end; {while}
   lPrintMacroExpansions := printMacroExpansions; {inhibit token echo}
   printMacroExpansions := false;
   NextToken;                           {evaluate the expression}
   Expression(normalExpression, [semicolonch]);
   Gen0t(pc_pop, UsualUnaryConversions);
   NextToken;                           {skip the seminolon}
   printMacroExpansions := lPrintMacroExpansions;
   end; {if}

Gen1(pc_ujp, stPtr^.forLoop);           {loop to the test}
Gen1(dc_lab, stPtr^.breakLab);          {create the exit label}
statementList := stPtr^.next;           {pop the statement record}
dispose(stPtr);
end; {EndForStatement}


procedure EndSwitchStatement;

{ finish off a switch statement                                 }

const
   sparse = 5;                          {label to tableSize ratio for sparse table}

var
   default: integer;                    {default label}
   ltp: baseTypeEnum;                   {base type}
   minVal: integer;                     {min switch value}
   stPtr: statementPtr;                 {work pointer}

                                        {copies of vars (for efficiency)}
                                        {-------------------------------}
   exitLab: integer;                    {label at the end of the jump table}
   isLong: boolean;                     {is the case expression long?}
   swPtr,swPtr2: switchPtr;             {switch label table list}

begin {EndSwitchStatement}
stPtr := statementList;                 {get the statement record}
exitLab := stPtr^.switchExit;           {get the exit label}
isLong := stPtr^.isLong;                {get the long flag}
swPtr := stPtr^.switchList;             {Skip further generation if there were}
if swPtr <> nil then begin              { no labels.                          }
   default := stPtr^.switchDefault;     {get a default label}
   if default = 0 then
      default := exitLab;
   Gen1(pc_ujp, exitLab);               {branch past the indexed jump}
   Gen1(dc_lab, stPtr^.switchLab);      {create the label for the xjp table}
   if isLong then                       {decide on a base type}
      ltp := cgLong
   else
      ltp := cgWord;
   if stPtr^.isLong
      or (((stPtr^.maxVal-swPtr^.val) div stPtr^.labelCount) > sparse) then
      begin

      {Long expressions and sparse switch statements are handled as a   }
      {series of if-goto tests.                                         }
      while swPtr <> nil do begin       {generate the compares}
         if isLong then
            GenLdcLong(swPtr^.val)
         else
            Gen1t(pc_ldc, long(swPtr^.val).lsw, cgWord);
         Gen2t(pc_lod, stPtr^.ln, 0, ltp);
         Gen0t(pc_equ, ltp);
         Gen1(pc_tjp, swPtr^.lab);
         swPtr2 := swPtr;
         swPtr := swPtr^.next;
         dispose(swPtr2);
         end; {while}
      Gen1(pc_ujp, default);            {anything else goes to default}
      end {if}
   else begin

      {compact word switch statements are handled with xjp}
      minVal := long(swPtr^.val).lsw;   {record the min label value}
      Gen2t(pc_lod, stPtr^.ln, 0, ltp); {get the value}
      Gen1t(pc_dec, minVal, cgWord);    {adjust the range}
      Gen1(pc_xjp, ord(stPtr^.maxVal-minVal+1)); {do the indexed jump}
      while swPtr <> nil do begin       {generate the jump table}
         while minVal < swPtr^.val do begin
            Gen1(pc_add, default);
            minVal := minVal+1;
            end; {while}
         minVal := minVal+1;
         Gen1(pc_add, swPtr^.lab);
         swPtr2 := swPtr;
         swPtr := swPtr^.next;
         dispose(swPtr2);
         end; {while}
      Gen1(pc_add, default);
      end; {if}
   Gen1(dc_lab, exitLab);               {generate the default label}
   end {if}
else begin
   Gen1(pc_ujp, exitLab);               {branch past the indexed jump}
   Gen1(dc_lab, stPtr^.switchLab);      {create the label for the xjp table}

   default := stPtr^.switchDefault;     {if there is one, jump to the default label}
   if default <> 0 then
      Gen1(pc_ujp, default);

   Gen1(dc_lab, exitLab);               {generate the default label}
   end; {else}
FreeTemp(stPtr^.ln, stPtr^.size);       {release temp variable}
statementList := stPtr^.next;           {pop the statement record}
dispose(stPtr);
end; {EndSwitchStatement}


procedure EndWhileStatement;

{ finish off a while statement                                  }

var
   stPtr: statementPtr;                 {work pointer}

begin {EndWhileStatement}
stPtr := statementList;                 {loop to the test}
Gen1(pc_ujp, stPtr^.whileTop);
Gen1(dc_lab, stPtr^.whileEnd);          {create the exit label}
statementList := stPtr^.next;           {pop the statement record}
dispose(stPtr);
end; {EndWhileStatement}

{-- Type declarations ------------------------------------------}

procedure Declarator(tPtr: typePtr; var variable: identPtr; space: spaceType;
   doingPrototypes: boolean);

{ handle a declarator                                           }
{                                                               }
{ parameters:                                                   }
{       tPtr - pointer to the type to use                       }
{       variable - pointer to variable being defined            }
{       space - variable space to use                           }
{       doingPrototypes - are we compiling prototype parameter  }
{               declarations?                                   }

label 1;

type
   typeDefPtr = ^typeDefRecord;         {for stacking type records}
   typeDefRecord = record
      next: typeDefPtr;
      typeDef: typePtr;
      end;
   pointerListPtr = ^pointerList;       {for stacking pointer types}
   pointerList = record
      next: pointerListPtr;
      isConstant: boolean;
      end;

var
   i: integer;                          {loop variable}
   lastWasIdentifier: boolean;          {for deciding if the declarator is a fuction}
   lastWasPointer: boolean;             {was the last type a pointer?}
   newName: stringPtr;                  {new symbol name}
   parameterStorage: boolean;           {is the new symbol in a parm list?}
   state: stateKind;                    {declaration state of the variable}
   tPtr2: typePtr;                      {work pointer}
   tsPtr: typeDefPtr;                   {work pointer}
   typeStack: typeDefPtr;               {stack of type definitions}
   varParmList: boolean;                {did we prototype a variable?}

                                        {for checking function compatibility}
                                        {-----------------------------------}
   checkParms: boolean;                 {do we need to do type checking on the parm?}
   compatible: boolean;			{are the parameters compatible?}
   ftoken: tokenType;                   {for checking extern functions}
   p1,p2,p3: parameterPtr;              {used to trace parameter lists}<