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}
   pt1,pt2: typePtr;			{parameter types}
   t1: typePtr;                         {function type}
   tk1,tk2: typeKind;			{parameter type kinds}
   unnamedParm: boolean;                {is this an unnamed prototype?}


   procedure StackDeclarations (var varParmList: boolean);
 
   { stack the declaration operators                            }
   {                                                            }
   { Parameters:                                                }
   {    varParmList - did we create one?                        }
 
   var
      cp,cpList: pointerListPtr;        {pointer list}
      done,done2: boolean;              {for loop termination}
      isPtr: boolean;                   {is the parenthesized expr a ptr?}
      wp: parameterPtr;                 {used to build prototype var list}
      pvar: identPtr;                   {work pointer}
      tPtr2: typePtr;                   {work pointer}
      ttPtr: typeDefPtr;                {work pointer}
      parencount: integer;              {for skipping in parm list}
      lvarParmList: boolean;            {did we prototype a variable?}
 
                                        {variables used to preserve states}
                                        { across recursive calls          }
                                        {---------------------------------}
      lisFunction: boolean;             {local copy of isFunction}
      lisPascal: boolean;               {local copy of isPascal}
      lLastParameter: identPtr;         {next parameter to process}
      lstorageClass: tokenEnum;         {storage class of the declaration}
      ltypeSpec: typePtr;               {type specifier}
      luseGlobalPool: boolean;          {local copy of useGlobalPool}
      lPrintMacroExpansions: boolean;   {local copy of printMacroExpansions}

   begin {StackDeclarations}
   varParmList := false;                {no var parm list, yet}
   lastWasIdentifier := false;          {used to see if the declaration is a fn}
   cpList := nil;
   if token.kind = typedef then
      token.kind := ident;
   case token.kind of

      ident: begin                      {handle 'ident'}
         if space = fieldListSpace then
            variable := nil
         else
            variable := FindSymbol(token, space, true, true);
         newName := token.name;
         if variable = nil then begin
            if storageClass = typedefsy then begin
               tPtr2 := pointer(Calloc(sizeof(typeRecord)));
               {tPtr2^.size := 0;}
               {tPtr2^.saveDisp := 0;}
               tPtr2^.kind := definedType;
               {tPtr^.isConstant := false;}
               tPtr2^.dType := tPtr;
               end {if}
            else
               tPtr2 := tPtr;
            if doingParameters then begin
               if not doingPrototypes then 
                  if not (tPtr2^.kind in
                     [enumConst,structType,unionType,definedType,pointerType])
                     then Error(50);
               parameterStorage := true;
               end; {if}
            end {if}
         else
            checkParms := true;
         NextToken;
         if token.kind = eqch then
            state := initialized;
         lastWasIdentifier := true;
         end;

      asteriskch: begin                 {handle '*' 'declarator'}
         while token.kind = asteriskch do begin
            NextToken;
            new(cp);
            cp^.next := cpList;
            cpList := cp;
            cp^.isConstant := false;
            while token.kind in
               [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy,
                doublesy,compsy,extendedsy,voidsy,enumsy,structsy,unionsy,
                volatilesy,constsy] do begin
               if token.kind = constsy then
                  cpList^.isConstant := true
               else if token.kind = volatilesy then
                  volatile := true
               else
                  Error(9);
               NextToken;
               end; {while}
            end; {while}
         StackDeclarations(lvarParmList);
         end;

      lparench: begin                   {handle '(' 'declarator' ')'}
         NextToken;
         isPtr := token.kind = asteriskch;
         StackDeclarations(lvarParmList);
         Match(rparench,12);
         if isPtr then
            lastWasIdentifier := false;
         end;

      otherwise:
         if doingPrototypes then begin  {allow for unnamed parameters}
            pvar := pointer(Calloc(sizeof(identRecord)));
            {pvar^.next := nil;}
            {pvar^.saved := 0;}
            pvar^.name := @'?';
            pvar^.itype := tPtr;
            {pvar^.disp := 0;}
            {pvar^.bitDisp := 0;}
            {pvar^.bitsize := 0;}
            {pvar^.initialized := false;}
            {pvar^.iPtr := nil;}
            {pvar^.isForwardDeclared := false;}
            pvar^.class := autosy;
            pvar^.storage := parameter;
            variable := pvar;
            lastWasIdentifier := true;
            newName := nil;
            unnamedParm := true;
            end; {if}

      end; {case}

   while token.kind in [lparench,lbrackch] do begin

      {handle function declarations}
      if token.kind = lparench then begin
         lisPascal := isPascal;         {preserve this flag}
	 PushTable;			{create a symbol table}
                                        {determine if it's a function}
         isFunction := lastWasIdentifier or isFunction;
         varParmList := not isFunction;
         tPtr2 := pointer(GCalloc(sizeof(typeRecord))); {create the function type}
         {tPtr2^.size := 0;}
         {tPtr2^.saveDisp := 0;}
         tPtr2^.kind := functionType;
         {tPtr2^.isConstant := false;}
         {tPtr2^.varargs := false;}
         {tPtr2^.prototyped := false;}
         {tPtr2^.overrideKR := false;}
         {tPtr2^.parameterList := nil;}
         {tPtr2^.isPascal := false;}
         {tPtr2^.toolNum := 0;}
         {tPtr2^.dispatcher := 0;}
         new(ttPtr);
         ttPtr^.next := typeStack;
         typeStack := ttPtr;
         ttPtr^.typeDef := tPtr2;
         NextToken;                        {skip the '(' token}
         if token.kind = voidsy then begin {check for a void prototype}
            lPrintMacroExpansions := printMacroExpansions;
            printMacroExpansions := false;
            NextToken;
            printMacroExpansions := lPrintMacroExpansions;
            if token.kind = rparench then begin
               PutBackToken(token, false);
               NextToken;
               tPtr2^.prototyped := true;
               end
            else begin
               PutBackToken(token, false);
               token.kind := voidsy;
               token.class := reservedSymbol;
               end; {else}
            end; {if}
         if token.kind in               {see if we are doing a prototyped list}
            [autosy,externsy,registersy,staticsy,typedefsy,unsignedsy,intsy,
             longsy,charsy,shortsy,floatsy,doublesy,compsy,extendedsy,voidsy,
             enumsy,structsy,unionsy,typedef,signedsy,constsy] then begin

            {handle a prototype variable list}
            numberOfParameters := 0;    {don't allow K&R parm declarations}
            luseGlobalPool := useGlobalPool; {use global memory}
            useGlobalPool := true;
            done2 := false;
            lisFunction := isFunction;  {preserve global variables}
            ltypeSpec := typeSpec;
            lstorageClass := storageClass;
            with tPtr2^ do begin
               prototyped := true;      {it is prototyped}
               repeat                   {collect the declarations}
                  if (token.kind in [autosy,externsy,registersy,staticsy,
                                     typedefsy,unsignedsy,signedsy,intsy,longsy,
                                     charsy,shortsy,floatsy,doublesy,compsy,
                                     extendedsy,enumsy,structsy,unionsy,
                                     typedef,voidsy,volatilesy,constsy])
                                     then begin
                     lLastParameter := lastParameter;
                     DoDeclaration(true);
                     lastParameter := lLastParameter;
                     if protoType <> nil then begin
                        wp := pointer(Malloc(sizeof(parameterRecord)));
                        wp^.next := parameterList;
                        parameterList := wp;
                        wp^.parameter := protoVariable;
                        wp^.parameterType := protoType;
                        if protoVariable <> nil then begin
                           protoVariable^.pnext := lastParameter;
                           lastParameter := protoVariable;
                           end; {if}
                        end; {if}
                     if token.kind = commach then begin
                        NextToken;
                        if token.kind = dotch then begin
                           NextToken;
                           Match(dotch,89);
                           Match(dotch,89);
                           varargs := true;
                           done2 := true;
                           end; {if}
                        end {if}
                     else
                        done2 := true;
                     end {if}
                  else begin
                     Error(26);
                     parencount := 0;
                     while (token.kind <> eofsy)
                        and ((parencount > 0) or (token.kind <> rparench)) do
                        begin
                        if token.kind = rparench then
                           parencount := parencount-1
                        else if token.kind = lparench then
                           parencount := parencount+1;
                        NextToken;
                        end; {while}
                     done2 := true;
                     end; {else}
               until done2;
               end; {with}
            isFunction := lisFunction;  {restore global variables}
            storageClass := lstorageClass;
            typeSpec := ltypeSpec;
            useGlobalPool := luseGlobalPool;
            end {if prototype}
         else if token.kind = ident then begin

            {handle a K&R variable list}
            if (lint & lintNotPrototyped) <> 0 then
               Error(105);
            if doingFunction or doingPrototypes then
               Error(12)
            else begin
               numberOfParameters := 0; {no function parms yet}
               end; {else}
            repeat                      {make a list of parameters}
               if not doingFunction then begin
                  if token.kind <> ident then begin
                     Error(9);
                     while not (token.kind in [rparench,commach,ident]) do
                        NextToken;
                     end; {if}
                  if token.kind = ident then begin
                     pvar := NewSymbol(token.name, nil, ident, variableSpace,
                        declared);
                     pvar^.storage := parameter;
                     pvar^.pnext := lastParameter;
                     lastParameter := pvar;
                     numberOfParameters := numberOfParameters+1;
                     pvar^.bitdisp := numberOfParameters;
                     NextToken;
                     end; {if}
                  end; {if}
               if token.kind = commach then begin
                  NextToken;
                  done := false;
                  end {if}
               else
                  done := true;
            until done or (token.kind = eofsy);
            end {else if}
         else if (lint & lintNotPrototyped) <> 0 then
            if not tPtr2^.prototyped then
               Error(105);
         Match(rparench,12);            {insist on a closing ')' token}
         isPascal := lisPascal;         {restore this flag}
         end {if}

      {handle array declarations}
      else {if token.kind = lbrackch then} begin
         lastWasIdentifier := false;
         tPtr2 := pointer(Calloc(sizeof(typeRecord)));
         {tPtr2^.size := 0;}
         {tPtr2^.saveDisp := 0;}
         {tPtr2^.isConstant := false;}
         tPtr2^.kind := arrayType;
         {tPtr2^.elements := 0;}
         new(ttPtr);
         ttPtr^.next := typeStack;
         typeStack := ttPtr;
         ttPtr^.typeDef := tPtr2;
         NextToken;
         if token.kind <> rbrackch then begin
            Expression(arrayExpression, [rbrackch,semicolonch]);
            if expressionValue <= 0 then begin
               Error(45);
               expressionValue := 1;
               end; {if}
            tPtr2^.elements := expressionValue;
            end; {if}
         Match(rbrackch,24);
         end; {else if}
      end; {while}

   {stack pointer type records}
   while cpList <> nil do begin
      tPtr2 := pointer(Malloc(sizeof(typeRecord)));
      tPtr2^.size := cgPointerSize;
      tPtr2^.saveDisp := 0;
      tPtr2^.isConstant := cpList^.isConstant;
      tPtr2^.kind := pointerType;
      new(ttPtr);
      ttPtr^.next := typeStack;
      typeStack := ttPtr;
      ttPtr^.typeDef := tPtr2;
      cp := cpList;
      cpList := cp^.next;
      dispose(cp);
      end; {for}
   end; {StackDeclarations}

begin {Declarator}
newName := nil;                         {no identifier, yet}
unnamedParm := false;                   {not an unnamed parameter}
if storageClass = externsy then         {decide on a storage state}
   state := declared
else
   state := defined;
typeStack := nil;                       {no types so far}
parameterStorage := false;              {symbol is not in a parameter list}
checkParms := false;                    {assume we won't need to check for parameter type errors}
StackDeclarations(varParmList);         {stack the type records}
while typeStack <> nil do begin         {reverse the type stack}
   tsPtr := typeStack;
   typeStack := tsPtr^.next;
   if isFunction and (not useGlobalPool) then begin
      tPtr2 := pointer(GMalloc(sizeof(typeRecord)));
      tPtr2^ := tsPtr^.typeDef^;
      tPtr2^.saveDisp := 0;
      end {if}
   else
      tPtr2 := tsPtr^.typeDef;
   dispose(tsPtr);
   if tPtr^.kind = functionType then
      PopTable;
   case tPtr2^.kind of
      pointerType: begin
         tPtr2^.pType := tPtr;                     
         end;
      functionType: begin
         while tPtr^.kind = definedType do
            tPtr := tPtr^.dType;
         tPtr2^.fType := tPtr;
         if tPtr^.kind in [functionType,arrayType] then
            Error(103);
         end;
      arrayType: begin
         tPtr2^.size := tPtr^.size * tPtr2^.elements;
         tPtr2^.aType := tPtr;
         end;
      otherwise: ;
      end; {case}
   tPtr := tPtr2;
   end; {while}

if checkParms then begin                {check for parameter type conflicts}
   with variable^ do begin
      if doingParameters then begin
         if itype = nil then begin
            itype := tPtr;
            numberOfParameters := numberOfParameters-1;
            if pfunc^.itype^.prototyped then begin
               pfunc^.itype^.overrideKR := true;
               p1 := nil;
               for i := 1 to bitdisp do begin
                  p2 := pfunc^.itype^.parameterList;
                  while (p2^.next <> p1) and (p2 <> nil) do
                     p2 := p2^.next;
                  p1 := p2;
                  end; {for}
               compatible := false;
               if CompTypes(p1^.parameterType, tPtr) then
                  compatible := true
               else begin
                  tk1 := p1^.parameterType^.kind;
                  tk2 := tPtr^.kind;
                  if (tk1 = arrayType) and (tk2 = pointerType) then
                     compatible :=
                        CompTypes(p1^.parameterType^.aType, tPtr^.pType)
                  else if (tk1 = pointerType) and (tk2 = arrayType) then
                     compatible :=
                        CompTypes(p1^.parameterType^.pType, tPtr^.aType);
                  end; {else}
               if not compatible then
                  Error(47);
               end; {if}
            end {if}
         else
            Error(42);
         storage := parameter;
         parameterStorage := true;
         end; {if}
      end; {with}
   end {if}
else if doingParameters then
   if pfunc^.itype^.prototyped then
      if not doingPrototypes then
         if tPtr^.kind in
            [enumConst,structType,unionType,definedType,pointerType]
            then Error(50);

if tPtr^.kind = functionType then begin {declare the identifier}
   if variable <> nil then begin
      t1 := variable^.itype;
      if CompTypes(t1, tPtr) then begin
         if t1^.prototyped and tPtr^.prototyped then begin
            p2 := tptr^.parameterList;
            if isPascal then begin
               {reverse the parameter list}
               p1 := nil;
               while p2 <> nil do begin
                  p3 := p2;
                  p2 := p2^.next;
                  p3^.next := p1;
                  p1 := p3;
                  end; {while}
               tPtr^.parameterList := p1;
               end; {if}
            p2 := tPtr^.parameterList;
            p1 := t1^.parameterList;
            while (p1 <> nil) and (p2 <> nil) do begin
               if p1^.parameter = nil then
                  pt1 := p1^.parameterType
               else
                  pt1 := p1^.parameter^.itype;
               if p2^.parameter = nil then
                  pt2 := p2^.parameterType
               else
                  pt2 := p2^.parameter^.itype;
               if not CompTypes(pt1, pt2) then begin
                  Error(47);
                  goto 1;
                  end; {if}
               p1 := p1^.next;
               p2 := p2^.next;
               end; {while}
            if p1 <> p2 then
               Error(47);
            p2 := tptr^.parameterList;
            if isPascal then begin
               {reverse the parameter list}
               p1 := nil;
               while p2 <> nil do begin
                  p3 := p2;
                  p2 := p2^.next;
                  p3^.next := p1;
                  p1 := p3;
                  end; {while}
               tPtr^.parameterList := p1;
               end; {if}
            end; {if}
         end {if}
      else
         Error(42);
1:
      end; {if}
   end; {if}
if tPtr^.kind = functionType then
   state := declared;
if newName <> nil then                  {declare the variable}
   variable := NewSymbol(newName, tPtr, storageClass, space, state)
else if unnamedParm then
   variable^.itype := tPtr
else begin
   if token.kind <> semicolonch then
      Error(9);
   variable := nil;
   end; {else}
if variable <> nil then begin
   if parameterStorage then
      variable^.storage := parameter;
   if isForwardDeclared then begin      {handle forward declarations}
      tPtr := variable^.itype;
      lastWasPointer := false;
      while tPtr^.kind in
         [pointerType,arrayType,functionType,definedType] do begin
         if tPtr^.kind = pointerType then
            lastWasPointer := true
         else if tPtr^.kind <> definedType then
            lastWasPointer := false;
         tPtr := tPtr^.pType;
         end; {while}
      if ((tPtr <> typeSpec) and (not (tPtr^.kind in [structType,unionType])))
         then begin
         Error(107);
         SkipStatement;
         end; {if}
      variable^.isForwardDeclared := true;
      end; {if}
   end; {if}
end; {Declarator}


procedure Initializer (var variable: identPtr);

{ handle a variable initializer                                 }
{                                                               }
{ paramaters:                                                   }
{       variable - ptr to the identifier begin initialized      }

var
   bitcount: integer;                   {# if bits initialized}
   bitvalue: longint;                   {bit field initializer value}
   done: boolean;                       {for loop termination}
   errorFound: boolean;                 {used to remove bad initializations}
   iPtr,jPtr,kPtr: initializerPtr;      {for reversing the list}
   ip: identList;                       {used to place an id in the list}
   luseGlobalPool: boolean;             {local copy of useGlobalPool}


   procedure InitializeBitField;

   { If bit fields have been initialized, fill them in          }
   {                                                            }
   { Inputs:                                                    }
   {    bitcount - # of bits initialized                        }
   {    bitvalue - value of initializer                         }

   var
      iPtr: initializerPtr;             {for creating an initializer entry}

   begin {InitializeBitField}
   if bitcount <> 0 then begin          {skip if there has been no initializer}
{ writeln('InitializeBitField; bitcount = ', bitcount:1); {debug}
                                        {create the initializer entry}
      iPtr := pointer(Malloc(sizeof(initializerRecord)));
      iPtr^.next := variable^.iPtr;
      variable^.iPtr := iPtr;
      iPtr^.isConstant := isConstant;
      iPtr^.count := 1;
      iPtr^.bitdisp := 0;
      iPtr^.bitsize := 0;
      iPtr^.isStruct := false;
      iPtr^.iVal := bitvalue;
      if bitcount > 16 then
         iPtr^.itype := cgULong
      else if bitcount > 8 then
         iPtr^.itype := cgUWord
      else
         iPtr^.itype := cgUByte;
      bitcount := 0;                    {reset the bit field values}
      bitvalue := 0;
      end; {if}
   end; {InitializeBitField}


   procedure GetInitializerValue (tp: typePtr; bitsize,bitdisp: integer);
 
   { get the value of an initializer from a single expression    }
   {                                                             }
   { parameters:                                                 }
   {     tp - type of the variable being initialized             }
   {     bitsize - size of bit field (0 for non-bit fields)      }
   {     bitdisp - disp of bit field; unused if bitsize = 0      }
 
   label 1,2,3;

   var
      bitmask: longint;                 {used to add a value to a bit field}
      bKind: baseTypeEnum;              {type of constant}
      etype: typePtr;                   {expression type}
      i: integer;                       {loop variable}
      ip: identPtr;                     {ident in pointer constant}
      iPtr: initializerPtr;             {for creating an initializer entry}
      kind: tokenEnum;                  {kind of constant}
      offset, offset2: longint;		{integer offset from a pointer}
      operator: tokenEnum;              {operator for constant pointers}
      tKind: typeKind;                  {type of constant}
      tree: tokenPtr;                   {for evaluating pointer constants}


      function Subscript (tree: tokenPtr): typePtr;

      { handle subscripts in a pointer constant                 }
      {                                                         }
      { parameters:                                             }
      {    tree - subscript operators                           }
      {                                                         }
      { returns: type of the variable                           }
      {                                                         }
      { variables:                                              }
      {    iPtr - initializer location to store the array name  }
      {    offset - bytes past the start of the array           }

      var
         ip: identPtr;                  {ident pointer}
         rtree: tokenPtr;               {work pointer}
         tp: typePtr;                   {for tracking types}
         select: longint;               {selector size}
         size: longint;                 {subscript value}

      begin {Subscript}
      if tree^.token.kind = uasterisk then begin
         tree := tree^.left;
         if tree^.token.kind = plusch then begin
            rtree := tree^.right;
            if rtree^.token.kind in [intconst,uintconst] then
               size := rtree^.token.ival
            else if rtree^.token.kind in [longconst,ulongconst] then
               size := rtree^.token.lval
            else begin
               Error(18);
               errorFound := true;
               end; {else}
            tp := Subscript(tree^.left);
            if tp^.kind <> arrayType then
               Error(47)
            else begin
               tp := tp^.atype;
               offset := offset + size*tp^.size;
               Subscript := tp;
               end; {else}
            end {if}
         else begin
            Error(47);
            errorFound := true;
            Subscript := wordPtr;
            end; {else}
         end {if}
      else if tree^.token.kind = dotch then begin
         tp := Subscript(tree^.left);
         if tp^.kind in [structType,unionType] then begin
            DoSelection(tp, tree^.right, select);
            Subscript := expressionType;
            offset := offset+select;
            if isBitField then
               Error(106);
            end {if}
         else begin
            Error(47);
            errorFound := true;
            Subscript := wordPtr;
            end; {else}
         end {else if}
      else if tree^.token.kind = ident then begin
         ip := FindSymbol(tree^.token, allSpaces, false, true);
         if ip = nil then begin
            Error(31);
            errorFound := true;
            Subscript := wordPtr;
            iPtr^.pName := @'?';
            end {if}
         else begin
            Subscript := ip^.itype;
            iPtr^.pName := ip^.name;
            end; {else}
         end {else if}
      else begin
         Error(47);
         errorFound := true;
         Subscript := wordPtr;
         end; {else}
      end; {Subscript}


   begin {GetInitializerValue}
   if variable^.storage = stackFrame then
      Expression(autoInitializerExpression, [commach,rparench,rbracech])
   else
      Expression(initializerExpression, [commach,rparench,rbracech]);
   if bitsize = 0 then begin
      iPtr := pointer(Malloc(sizeof(initializerRecord)));
      iPtr^.next := variable^.iPtr;
      variable^.iPtr := iPtr;
      iPtr^.isConstant := isConstant;
      iPtr^.count := 1;
      iPtr^.bitdisp := 0;
      iPtr^.bitsize := 0;
      iPtr^.isStruct := false;
      end; {if}
   etype := expressionType;
   AssignmentConversion(tp, expressionType, isConstant, expressionValue,
      false, false);
   if variable^.storage = external then
      variable^.storage := global;
   if isConstant and (variable^.storage in [external,global,private]) then begin
      if bitsize = 0 then begin
         iPtr^.iVal := expressionValue;
         iPtr^.itype := tp^.baseType;
         InitializeBitField;
         end; {if}
      case tp^.kind of

         scalarType: begin
            bKind := tp^.baseType;
            if (bKind in [cgByte..cgULong])
               and (etype^.baseType in [cgByte..cgULong]) then begin
               if bKind in [cgLong,cgULong] then
                  if eType^.baseType = cgUByte then
                     iPtr^.iVal := iPtr^.iVal & $000000FF
                  else if eType^.baseType = cgUWord then
                     iPtr^.iVal := iPtr^.iVal & $0000FFFF;
               goto 3;
               end; {if}
            if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin
               if etype^.baseType in [cgByte..cgULong] then
                  iPtr^.rVal := expressionValue
               else if etype^.baseType in
                  [cgReal,cgDouble,cgComp,cgExtended] then
                  iPtr^.rval := realExpressionValue;
               goto 3;
               end; {if}
            Error(47);
            errorFound := true;
            goto 2;

3:          if bitsize <> 0 then begin

               {set up a bit field value}
               if bitdisp < bitcount then
                  InitializeBitField;
               bitmask := 0;
               for i := 1 to bitsize do
                  bitmask := (bitmask << 1) | 1;
               bitmask := bitmask & expressionValue;
               for i := 1 to bitdisp do
                  bitmask := bitmask << 1;
               bitvalue := bitvalue | bitmask;
               bitcount := bitcount + bitsize;
               end; {if}
            end;

         arrayType: begin
            if tp^.aType^.kind = scalarType then
               if tp^.aType^.baseType in [cgByte,cgUByte] then
                  if eType^.baseType = cgString then
                     goto 2;
            Error(46);
            errorFound := true;
            end;

         pointerType:
            if etype = stringTypePtr then begin
               iPtr^.isConstant := true;
               iPtr^.iType := ccPointer;
               iPtr^.pval := 0;
               iPtr^.pPlus := operator = plusch;
               iPtr^.isName := false;
               iPtr^.pStr := longstringPtr(expressionValue);
               end {if}
            else if etype^.kind = scalarType then
               if etype^.baseType in [cgByte..cgULong] then
                  if expressionValue = 0 then
                     iPtr^.iType := cgULong
                  else begin
                     Error(47);
                     errorFound := true;
                     end {else}
               else begin
                  Error(48);
                  errorFound := true;
                  end {else}
            else if etype^.kind = pointerType then begin
               iPtr^.iType := cgULong;
               iPtr^.pval := expressionValue;
               end {else if}
            else begin
               Error(48);
               errorFound := true;
               end; {else}

         structType,enumType: begin
            Error(46);
            errorFound := true;
            end;

         otherwise:
            Error(57);

         end; {case}
2:    DisposeTree(initializerTree);
      end {if}
   else begin
      if (tp^.kind = pointerType)
         or ((tp^.kind = scalarType) and (tp^.baseType in [cgLong,cgULong]))
         then begin
         iPtr^.iType := ccPointer;
         if variable^.storage in [external,global,private] then begin

            {do pointer constants with + or -}
            iPtr^.isConstant := true;
            tree := initializerTree;
            while tree^.token.kind = castoper do
               tree := tree^.left;
            offset := 0;
            operator := tree^.token.kind;
            while operator in [plusch,minusch] do begin
               with tree^.right^.token do
                  if kind in [intConst,longConst] then begin
                     if kind = intConst then
                        offSet2 := ival
                     else
                        offset2 := lval;
                     if operator = plusch then
                        offset := offset + offset2
                     else
                        offset := offset - offset2;
                     end {if}
                  else begin
                     Error(47);
                     errorFound := true;
                     end; {else}
               tree := tree^.left;
               operator := tree^.token.kind;
               end; {if}
            kind := tree^.token.kind;
            if kind = ident then begin

               {handle names of functions or static arrays}
               ip := FindSymbol(tree^.token, allSpaces, false, true);
               if ip = nil then begin
                  Error(31);
                  errorFound := true;
                  end {if}
               else begin
                  tKind := ip^.itype^.kind;
                  if tKind = functionType then begin
                     if operator in [plusch,minusch] then begin
                        Error(47);
                        errorFound := true;
                        end; {if}
                     end {if}
                  else if (tKind = arrayType)
                     and (ip^.storage in [external,global,private]) then begin
                     offset := offset*ip^.itype^.atype^.size;
                     end {else if}
                  else if tKind = pointerType then begin
                     Error(48);
                     errorFound := true;
                     end {else if}
                  else begin
                     Error(47);
                     errorFound := true;
                     end; {else}
                  iPtr^.pval := offset;
                  iPtr^.pPlus := true;
                  iPtr^.isName := true;
                  iPtr^.pName := ip^.name;
                  end; {if}
               end {if}
            else if kind = uand then begin
               tree := tree^.left;
               iPtr^.pPlus := true;
               iPtr^.isName := true;
               if tree^.token.kind = ident then begin
                  ip := FindSymbol(tree^.token, allSpaces, false, true);
                  if ip = nil then begin
                     Error(31);
                     errorFound := true;
                     end {if}
                  else
                     if ip^.storage in [external,global,private] then begin
                        offset := offset*ip^.itype^.size;
                        iPtr^.pName := ip^.name;
                        end {if}
                     else begin
                        Error(47);
                        errorFound := true;
                        end; {else}
                  end {if}
               else begin
                  tp := Subscript(tree);
                  if offset > 0 then
                     iPtr^.pPlus := true
                  else begin
                     iPtr^.pPlus := false;
                     offset := -offset;
                     end; {else}
                  end; {else}
               iPtr^.pval := offset;
               end {else if}
            else if kind in [dotch,uasterisk] then begin
               iPtr^.isName := true;
               tp := Subscript(tree);
               if offset > 0 then
                  iPtr^.pPlus := true
               else begin
                  iPtr^.pPlus := false;
                  offset := -offset;
                  end; {else}
               iPtr^.pval := offset;
               end {else if}
            else if kind = stringConst then begin
               iPtr^.pval := offset;
               iPtr^.pPlus := true;
               iPtr^.isName := false;
               iPtr^.pStr := tree^.token.sval;
               end {else if}
            else begin
               Error(47);
               errorFound := true;
               end; {else}
            DisposeTree(initializerTree);
            goto 1;
            end; {if}
         end {if}
      else if tp^.kind = structType then
         iPtr^.isStruct := true;

      {handle auto variables}
      if bitsize <> 0 then begin
         iPtr := pointer(Malloc(sizeof(initializerRecord)));
         iPtr^.next := variable^.iPtr;
         variable^.iPtr := iPtr;
         iPtr^.isConstant := isConstant;
         iPtr^.count := 1;
         iPtr^.bitdisp := bitdisp;
         iPtr^.bitsize := bitsize;
         iPtr^.isStruct := false;
         end; {if}
      if variable^.storage in [external,global,private] then begin
         Error(41);
         errorFound := true;
         end; {else}
      iPtr^.isConstant := false;
      iPtr^.iTree := initializerTree;
      iPtr^.bitdisp := bitdisp;
      iPtr^.bitsize := bitsize;
      end; {else}
1:
   end; {GetInitializerValue}


   procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer;
      main: boolean);
 
   { initialize one level of the type                           }
   {                                                            }
   { parameters:                                                }
   {     tp - pointer to the type being initialized             }
   {     bitsize - size of bit field (0 for non-bit fields)     }
   {     bitdisp - disp of bit field; unused if bitsize = 0     }
   {     main - is this a call from the main level?             }
 
   var
      bitCount: integer;                {# of bits in a union}
      braces: boolean;                  {is the initializer inclosed in braces?}
      count,maxCount: longint;          {for tracking the size of an initializer}
      ep: tokenPtr;                     {for forming string expression}
      iPtr: initializerPtr;             {for creating an initializer entry}
      ip: identPtr;                     {for tracing field lists}
      kind: typeKind;                   {base type of an initializer}
      ktp: typePtr;			{array type with definedTypes removed}


      procedure Fill (count: longint; tp: typePtr);

      { fill in unspecified space in an initialized array with 0  }
      {                                                           }
      { parameters:                                               }
      {   count - ^ elements of this type to create               }
      {   tp - ptr to type of elements to create                  }

      var
         i: longint;                    {loop variable}
         iPtr: initializerPtr;          {for creating an initializer entry}
         tk: tokenPtr;                  {expression record}
         ip: identPtr;                  {pointer to next field in a structure}

      begin {Fill}
{     writeln('Fill tp^.kind = ', ord(tp^.kind):1, '; count = ', count:1); {debug}
      InitializeBitField;               {if needed, do the bit field}
      if tp^.kind = arrayType then

         {fill an array}
         Fill(count*tp^.elements ,tp^.aType)
      else if tp^.kind = structType then begin

         {fill a structure}
         i := count;
         while i <> 0 do begin
            ip := tp^.fieldList;
            while ip <> nil do begin
               Fill(1, ip^.iType);
               ip := ip^.next;
               end; {while}
            i := i-1;
            end; {while}
         end {else if}
      else if tp^.kind = unionType then

         {fill a union}
         Fill(count, tp^.fieldList^.iType)
      else

         {fill a single value}
         while count <> 0 do begin
            iPtr := pointer(Calloc(sizeof(initializerRecord)));
            iPtr^.next := variable^.iPtr;
            variable^.iPtr := iPtr;
            iPtr^.isConstant := variable^.storage in [external,global,private];
           {iPtr^.bitdisp := 0;}
           {iPtr^.bitsize := 0;}
           {iPtr^.isStruct := false;}
            if iPtr^.isConstant then begin
               if tp^.kind = scalarType then
                  iPtr^.itype := tp^.baseType
               else if tp^.kind = pointertype then begin
                  iPtr^.itype := cgULong;
                 {iPtr^.iVal := 0;}
                  end {else if}
               else begin
                  iPtr^.itype := cgWord;
                  Error(47);
                  errorFound := true;
                  end; {else}
               end {if}
            else begin
               new(tk);
               tk^.next := nil;
               tk^.left := nil;
               tk^.middle := nil;
               tk^.right := nil;
               tk^.token.kind := intconst;
               tk^.token.class := intConstant;
               tk^.token.ival := 0;
               iPtr^.iTree := tk;
               end; {else}
            if count < 16384 then begin
               iPtr^.count := long(count).lsw;
               count := 0;
               end {if}
            else begin
               iPtr^.count := 16384;
               count := count-16384;
               end; {else}
            end; {while}
      end; {Fill}
 
 
      procedure RecomputeSizes (tp: typePtr);
  
      { a size has been infered from an initializer - set the     }
      { appropriate type size values                              }
      {                                                           }
      { parameters:                                               }
      {   tp - type to check                                      }
  
      begin {RecomputeSizes}
      if tp^.aType^.kind = arrayType then
         RecomputeSizes(tp^.aType);
      with tp^ do
         size := aType^.size*elements;
      end; {RecomputeSizes}
 
   begin {InitializeTerm}
   braces := false;                     {allow for an opening brace}
   if token.kind = lbracech then begin
      NextToken;
      braces := true;
      end; {if}

   {handle arrays}
   while tp^.kind = definedType do
      tp := tp^.dType;
   kind := tp^.kind;
   if kind = arrayType then begin
      ktp := tp^.atype;
      while ktp^.kind = definedType do
	 ktp := ktp^.dType;
      kind := ktp^.kind;

      {handle string constants}
      if (token.kind = stringConst) and (kind = scalarType)
         and (ktp^.baseType in [cgByte,cgUByte]) then begin
         if tp^.elements = 0 then begin
            tp^.elements := token.sval^.length + 1;
            RecomputeSizes(variable^.itype);
            end {if}
         else if tp^.elements < token.sval^.length then begin
            Error(44);
            errorFound := true;
            end; {else if}
         with ktp^ do begin
            iPtr := pointer(Malloc(sizeof(initializerRecord)));
            iPtr^.next := variable^.iPtr;
            variable^.iPtr := iPtr;
            iPtr^.count := 1;
            iPtr^.bitdisp := 0;
            iPtr^.bitsize := 0;
            iPtr^.isStruct := false;
            if (variable^.storage in [external,global,private]) then begin
               iPtr^.isConstant := true;
               iPtr^.itype := cgString;
               iPtr^.sval := token.sval;
               count := tp^.elements - token.sval^.length;
               if count <> 0 then
                  Fill(count, bytePtr);
               end {if}
            else begin
               iPtr^.isConstant := false;
               new(ep);
               iPtr^.iTree := ep;
               ep^.next := nil;
               ep^.left := nil;
               ep^.middle := nil;
               ep^.right := nil;
               ep^.token := token;
               end; {else}
            end; {with}
         NextToken;
         end {if}

      {handle arrays of non-strings}
      else if kind in
         [scalarType,pointerType,enumType,arrayType,structType,unionType] then
         begin
         count := 0;                    {get the expressions|initializers}
         maxCount := tp^.elements;
         if token.kind <> rbracech then
            repeat
               InitializeTerm(ktp, 0, 0, false);
               count := count+1;
               if count <> maxCount then begin
                  if token.kind = commach then begin
                     NextToken;
                     done := token.kind = rbracech;
                     end {if}
                  else
                     done := true;
                  end {if}
               else
                  done := true;
            until done or (token.kind = eofsy) or (count = maxCount);
         if maxCount <> 0 then begin
            count := maxCount-count;
            if count <> 0 then          {if there weren't enough initializers...}
               Fill(count,ktp);         { fill in the blank spots}
            end {if}
         else begin
            tp^.elements := count;      {set the array size}
            RecomputeSizes(variable^.itype);
            end; {else}
         end {else if}

      else begin
         Error(47);
         errorFound := true;
         end; {else}
      end {if}

   {handle structures}
   else if kind = structType then begin
      if braces or (not main) then begin
         count := tp^.size;
         ip := tp^.fieldList;
         bitCount := 0;
         while (ip <> nil) and (token.kind <> rbracech) do begin
            if ip^.isForwardDeclared then
               ResolveForwardReference(ip);
            InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false);
            if ip^.bitSize <> 0 then begin
               bitCount := bitCount + ip^.bitSize;
               if bitCount > maxBitField then begin
                  count := count - (maxBitField div 8);
                  bitCount := ip^.bitSize;
                  end; {if}
               end {if}
            else begin
               if bitCount > 0 then begin
                  bitCount := (bitCount+7) div 8;
                  count := count-bitCount;
                  bitCount := 0;
                  end; {if}
               count := count-ip^.itype^.size;
               end; {else}
{           writeln('Initializer: ', ip^.bitsize:10, ip^.bitdisp:10, bitCount:10); {debug}
            ip := ip^.next;
            if token.kind = commach then begin
               if ip <> nil then
                  NextToken;
               end {if}
            else
               ip := nil;
            end; {while}
         if bitCount > 0 then begin
            InitializeBitField;
            bitCount := (bitCount+7) div 8;
            count := count-bitCount;
            bitCount := 0;
            end; {if}
         if count > 0 then
            Fill(count, bytePtr);
         end {if}
      else                              {struct assignment initializer}
         GetInitializerValue(tp, bitsize, bitdisp);
      end {else if}

   {handle unions}
   else if kind = unionType then begin
      ip := tp^.fieldList;
      if ip^.isForwardDeclared then
         ResolveForwardReference(ip);
      InitializeTerm(ip^.itype, 0, 0, false);
      count := tp^.size - ip^.itype^.size;
      if count > 0 then
         Fill(count, bytePtr);
      end {else if}

   {handle single-valued types}
   else if kind in [scalarType,pointerType,enumType] then
      GetInitializerValue(tp, bitsize, bitdisp)

   else begin
      Error(47);
      errorFound := true;
      end; {else}

   if braces then begin                 {if there was an opening brace then }
      if token.kind = commach then      { insist on a closing brace         }
         NextToken;
      if token.kind = rbracech then
         NextToken
      else begin
         Error(23);
         while not (token.kind in [rbracech,eofsy]) do
            NextToken;
         NextToken;
         errorFound := true;
         end; {else}
      end; {if}
   end; {InitializeTerm}

begin {Initializer}
bitcount := 0;                          {set up for bit fields}
bitvalue := 0;
errorFound := false;                    {no errors found so far}
luseGlobalPool := useGlobalPool;        {use global memory for global vars}
useGlobalPool := (variable^.storage in [external,global,private])
   or useGlobalPool;
                                        {make sure a required '{' is there}
if not (token.kind in [lbracech,stringConst]) then
   if variable^.itype^.kind = arrayType then begin
      Error(27);
      errorFound := true;
      end; {if}
InitializeTerm(variable^.itype, 0, 0, true); {do the initialization}
variable^.state := initialized;         {mark the variable as initialized}
iPtr := variable^.iPtr;                 {reverse the initializer list}
jPtr := nil;
while iPtr <> nil do begin
   kPtr := iPtr;
   iPtr := iPtr^.next;
   kPtr^.next := jPtr;
   jPtr := kPtr;
   end; {while}
variable^.iPtr := jPtr;
if errorFound then                      {eliminate bad initializers}
   variable^.state := defined;
new(ip);                                {place the initializer in the list}
ip^.next := initializerList;
ip^.id := variable;
initializerList := ip;
useGlobalPool := luseGlobalPool;        {restore useGlobalPool}
end; {Initializer}


procedure TypeSpecifier {doingFieldList,isConstant: boolean};

{ handle a type specifier                                       }
{                                                               }
{ parameters:                                                   }
{       doingFieldList - are we processing a field list?        }
{       isConstant - did we already find a constsy?             }
{                                                               }
{ outputs:                                                      }
{       isForwardDeclared - is the field list component         }
{               referenceing a forward struct/union?            }
{       skipDeclarator - for enum,struct,union with no          }
{               declarator                                      }
{       typespec - type specifier                               }

label 1,2;

var
   done: boolean;                       {for loop termination}
   enumVal: integer;                    {default value for the next enum constant}
   tPtr: typePtr;                       {for building types}
   variable: identPtr;                  {enumeration variable}
 
   structPtr: identPtr;                 {structure identifier}
   structTypePtr: typePtr;              {structure type}
   tKind: typeKind;                     {defining structure or union?}
 
   ttoken: tokenType;                   {temp variable for struct name}
   lUseGlobalPool: boolean;             {local copy of useGlobalPool}
   globalStruct: boolean;               {did we force global pool use?}

 
   procedure FieldList (tp: typePtr; kind: typeKind);
 
   { handle a field list                                         }
   {                                                             }
   { parameters                                                  }
   {     tp - place to store the type pointer                    }
 
   var
      bitDisp: integer;                 {current bit disp}
      disp: longint;                    {current byte disp}
      done: boolean;                    {for loop termination}
      fl,tfl,ufl: identPtr;             {field list}
      ldoingParameters: boolean;        {local copy of doingParameters}
      lisForwardDeclared: boolean;      {local copy of isForwardDeclared}
      lstorageClass: tokenEnum;         {storage class of the declaration}
      maxDisp: longint;                 {for determining union sizes}
      variable: identPtr;               {variable being defined}
 
   begin {FieldList}
   ldoingParameters := doingParameters; {allow fields in K&R dec. area}
   doingParameters := false;
   lisForwardDeclared := isForwardDeclared; {stack this value}
   lStorageClass := storageClass;       {don't allow auto in a struct}
   storageClass := ident;
   bitDisp := 0;                        {start allocation from byte 0}
   disp := 0;
   maxDisp := 0;
   fl := nil;                           {nothing in the field list, yet}
                                        {check for no declarations}
   if not (token.kind in [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,
      floatsy,doublesy,compsy,extendedsy,enumsy,structsy,unionsy,typedefsy,
      typedef,voidsy,constsy,volatilesy]) then
      Error(26);
                                        {while there are entries in the field list...}
   while token.kind in [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy,
      doublesy,compsy,extendedsy,enumsy,structsy,unionsy,typedefsy,typedef,
      voidsy,constsy,volatilesy] do begin
      typeSpec := wordPtr;              {default type specifier is an integer}
      TypeSpecifier(true,false);        {get the type specifier}
      if not skipDeclarator then
         repeat                         {declare the variables...}
            variable := nil;
            if token.kind <> colonch then begin
               Declarator(typeSpec, variable, fieldListSpace, false);
               if variable <> nil then  {enter the var in the field list}
                  begin
                  tfl := fl;            {(check for dups)}
                  while tfl <> nil do begin
                     if tfl^.name^ = variable^.name^ then
                        Error(42);
                     tfl := tfl^.next;
                     end; {while}
                  variable^.next := fl;
                  fl := variable;
                  end; {if}
               end; {if}
            if token.kind = colonch then {handle a bit field}
               begin
               if kind = unionType then
                  Error(56);
               NextToken;
               Expression(arrayExpression,[commach,semicolonch]);
               if (expressionValue >= maxBitField) or (expressionValue < 0) then
                  begin
                  Error(54);
                  expressionValue := maxBitField-1;
                  end; {if}
               if (bitdisp+long(expressionValue).lsw > maxBitField)
                  or (long(expressionValue).lsw = 0) then begin
                  disp := disp+((bitDisp+7) div 8);
                  bitdisp := 0;
                  if long(expressionValue).lsw = 0 then
                     if variable <> nil then
                        Error(55);
                  end; {if}
               if variable <> nil then begin
                  variable^.disp := disp;
                  variable^.bitdisp := bitdisp;
                  variable^.bitsize := long(expressionValue).lsw;
                  bitdisp := bitdisp+long(expressionValue).lsw;
                  end; {if}
               end {if}
            else if variable <> nil then begin
               if bitdisp <> 0 then begin
                  disp := disp+((bitDisp+7) div 8);
                  bitdisp := 0;
                  end {if}
               else if kind = unionType then
                  disp := 0;
               variable^.disp := disp;
               variable^.bitdisp := bitdisp;
               variable^.bitsize := 0;
               disp := disp + variable^.itype^.size;
               if disp > maxDisp then
                  maxDisp := disp;
               end; {if}
            if token.kind = commach then {allow repeated declarations}
               begin
               NextToken;
               done := false;
               end {if}
            else
               done := true;
         until done or (token.kind = eofsy);
      Match(semicolonch,22);            {insist on a closing ';'}
      end; {while}
   if fl <> nil then begin
      ufl := nil;                       {reverse the field list}
      while fl <> nil do begin
         tfl := fl;
         fl := fl^.next;
         tfl^.next := ufl;
         ufl := tfl;
         end; {while}
      if kind = structType then begin   {return the field list}
         if bitdisp <> 0 then
            disp := disp+((bitDisp+7) div 8);
         tp^.size := disp;
         end {if}
      else
         tp^.size := maxDisp;
      tp^.fieldList := ufl;
      end; {if}
   storageClass := lStorageClass;       {restore default storage class}
   isForwardDeclared := lisForwardDeclared; {restore the forward flag}
   doingParameters := ldoingParameters; {restore the parameters flag}
   end; {FieldList}


   procedure CheckConst;

   { Check the token to see if it is a const or volatile        }

   begin {CheckConst}
   while token.kind in [constsy,volatilesy] do begin
      if token.kind = constsy then
         isConstant := true
      else
         volatile := true;
      NextToken;
      end; {while}
   end; {CheckConst}


begin {TypeSpecifier}
isForwardDeclared := false;             {not doing a forward reference (yet)}
skipDeclarator := false;                {declarations are required (so far)}
CheckConst;
case token.kind of
   unsignedsy: begin                    {unsigned}
      NextToken;
      CheckConst;
      if token.kind = shortsy then begin
         NextToken;
         CheckConst;
         if token.kind = intsy then begin
            NextToken;
            CheckConst;
            end; {if}
         typeSpec := uWordPtr;
         end {if}
      else if token.kind = longsy then begin
         NextToken;
         CheckConst;
         if token.kind = intsy then begin
            NextToken;
            CheckConst;
            end; {if}
         typeSpec := uLongPtr;
         end {else if}
      else if token.kind = charsy then begin
         NextToken;
         CheckConst;
         typeSpec := uBytePtr;
         end {else if}
      else if token.kind = intsy then begin
         NextToken;
         CheckConst;
	 if unix_1 then
            typeSpec := uLongPtr
	 else
            typeSpec := uWordPtr;
         end {else if}
      else begin
         CheckConst;
	 if unix_1 then
            typeSpec := uLongPtr
	 else
            typeSpec := uWordPtr;
         end; {else if}
      end;

   signedsy: begin                      {signed}
      NextToken;
      CheckConst;
      if token.kind = shortsy then begin
         NextToken;
         CheckConst;
         if token.kind = intsy then begin
            NextToken;
            CheckConst;
            end; {if}
         typeSpec := wordPtr;
         end {if}
      else if token.kind = longsy then begin
         NextToken;
         CheckConst;
         if token.kind = intsy then begin
            NextToken;
            CheckConst;
            end; {if}
         typeSpec := longPtr;
         end {else if}
      else if token.kind = intsy then begin
         NextToken;
         CheckConst;
	 if unix_1 then
            typeSpec := longPtr
	 else
            typeSpec := wordPtr;
         end {else if}
      else if token.kind = charsy then begin
         NextToken;
         CheckConst;
         typeSpec := bytePtr;
         end; {else if}
      end;

   intsy: begin                         {int}
      NextToken;
      CheckConst;
      if unix_1 then
         typeSpec := longPtr
      else
         typeSpec := wordPtr;
      end;

   longsy: begin                        {long}
      NextToken;
      CheckConst;
      typeSpec := longPtr;
      if token.kind in [intsy,floatsy] then begin
         if token.kind = floatsy then
            typeSpec := doublePtr;
         NextToken;
         CheckConst;
         end {if}
      else if token.kind = doublesy then begin
         typeSpec := extendedPtr;
         NextToken;
         CheckConst;
         end; {else if}
      end;

   charsy: begin                        {char}
      NextToken;
      CheckConst;
      typeSpec := uBytePtr;
      end;

   shortsy: begin                       {short}
      NextToken;
      CheckConst;
      if token.kind = intsy then begin
         NextToken;
         CheckConst;
         end; {if}
      typeSpec := wordPtr;
      end;

   floatsy: begin                       {float}
      NextToken;
      CheckConst;
      typeSpec := realPtr;
      end;

   doublesy: begin                      {double}
      NextToken;
      CheckConst;
      typeSpec := doublePtr;
      end;

   compsy: begin                        {comp}
      NextToken;
      CheckConst;
      typeSpec := compPtr;
      end;

   extendedsy: begin                    {extended}
      NextToken;
      CheckConst;
      typeSpec := extendedPtr;
      end;

   voidsy: begin                        {void}
      NextToken;
      CheckConst;
      typeSpec := voidPtr;
      end;

   enumsy: begin                        {enum}
      NextToken;                        {skip the 'enum' token}
      if token.kind = ident then begin  {handle a type definition}
         variable := FindSymbol(token, tagSpace, true, true);
         ttoken := token;
         NextToken;
         if variable <> nil then
            if variable^.itype^.kind = enumType then
               if token.kind <> lbracech then
                  goto 1;
         tPtr := pointer(Malloc(sizeof(typeRecord)));
         tPtr^.size := cgWordSize;
         tPtr^.saveDisp := 0;
         tPtr^.isConstant := false;
         tPtr^.kind := enumType;
         variable :=
            NewSymbol(ttoken.name, tPtr, storageClass, tagSpace, defined);
         CheckConst;
         end {if}
      else if token.kind <> lbracech then
         Error(9);
      enumVal := 0;                     {set the default value}
      if token.kind = lbracech then begin
         NextToken;                     {skip the '{'}
         repeat                         {declare the enum constants}
            tPtr := pointer(Malloc(sizeof(typeRecord)));
            tPtr^.size := cgWordSize;
            tPtr^.saveDisp := 0;
            tPtr^.isConstant := false;
            tPtr^.kind := enumConst;
            if token.kind = ident then begin
               variable :=
                  NewSymbol(token.name, tPtr, ident, variableSpace, defined);
               NextToken;
               end {if}
            else
               Error(9);
            if token.kind = eqch then begin {handle explicit enumeration values}
               NextToken;
               Expression(arrayExpression,[commach,rbracech]);
               enumVal := long(expressionValue).lsw;
               if enumVal <> expressionValue then
                  Error(6);
               end; {if}
            tPtr^.eval := enumVal;      {set the enumeration constant value}
            enumVal := enumVal+1;       {inc the default enumeration value}
            if token.kind = commach then {next enumeration...}
               begin
               done := false;
               NextToken;
               end {if}
            else
               done := true;
         until done or (token.kind = eofsy);
         if token.kind = rbracech then
            NextToken
         else begin
            Error(23);
            SkipStatement;
            end; {else}
         end; {if}
1:    skipDeclarator := token.kind = semicolonch;
      end;
  
   structsy,                            {struct}
   unionsy: begin                       {union}
      globalStruct := false;            {we didn't make it global}
      if token.kind = structsy then     {set the type kind to use}
         tKind := structType
      else
         tKind := unionType;
      structPtr := nil;                 {no record, yet}
      structTypePtr := defaultStruct;   {use int as a default type}
      NextToken;                        {skip 'struct' or 'union'}
      if token.kind in [ident,typedef]  {if there is a struct name then...}
         then begin
					{look up the name}
         structPtr := FindSymbol(token, tagSpace, true, true);
         ttoken := token;               {record the structure name}
         NextToken;                     {skip the structure name}
         if structPtr = nil then begin  {if the name hasn't been defined then...}
            if token.kind <> lbracech then
               structPtr := FindSymbol(ttoken, tagSpace, false, true);
            if structPtr <> nil then
               structTypePtr := structPtr^.itype
            else begin
               isForwardDeclared := true;
               globalStruct := doingParameters and (token.kind <> lbracech);
               if globalStruct then begin
                  lUseGlobalPool := useGlobalPool;
                  useGlobalPool := true;
                  end; {if}
               structTypePtr := pointer(Calloc(sizeof(typeRecord)));
              {structTypePtr^.size := 0;}
              {structTypePtr^.saveDisp := 0;}
              {structTypePtr^.isConstant := false;}
               structTypePtr^.kind := tkind;
              {structTypePtr^.fieldList := nil;}
              {structTypePtr^.sName := nil;}
               structPtr := NewSymbol(ttoken.name, structTypePtr, ident,
                  tagSpace, defined);
               structTypePtr^.sName := structPtr^.name;
               end;
            end {if}
                                        {the name has been defined, so...}
         else if structPtr^.itype^.kind <> tKind then begin
            Error(42);			{it's an error if it's not a struct}
            structPtr := nil;
            end {else}
         else begin                     {record the existing structure type}
            structTypePtr := structPtr^.itype;
            CheckConst;
            end; {else}
         end {if}
      else if token.kind <> lbracech then
         Error(9);                      {its an error if there's no name or struct}
2:    if token.kind = lbracech then     {handle a structure definition...}
         begin                          {error if we already have one!}
         if (structTypePtr <> defaultStruct)
            and (structTypePtr^.fieldList <> nil) then begin
            Error(53);
            structPtr := nil;
            end; {if}
         NextToken;                     {skip the '{'}
         if structTypePtr = defaultStruct then begin
            structTypePtr := pointer(Calloc(sizeof(typeRecord)));
           {structTypePtr^.size := 0;}
           {structTypePtr^.saveDisp := 0;}
           {structTypePtr^.isConstant := false;}
            structTypePtr^.kind := tkind;
           {structTypePtr^.fieldList := nil;}
           {structTypePtr^.sName := nil;}
            end; {if}
         if structPtr <> nil then
            structPtr^.itype := structTypePtr;
         FieldList(structTypePtr,tKind); {define the fields}
         if token.kind = rbracech then  {insist on a closing rbrace}
            NextToken
         else begin
            Error(23);
            SkipStatement;
            end; {else}
         end; {if}
      if globalStruct then
         useGlobalPool := lUseGlobalPool;
      typeSpec := structTypePtr;
      skipDeclarator := token.kind = semicolonch;
      end;
 
   typedef: begin                       {named type definition}
      typeSpec := token.symbolPtr^.itype;
      NextToken;
      end;

   otherwise: ;
   end; {case}

if isconstant then begin                {handle a constant type}
   new(tPtr);
   if typeSpec^.kind in [structType,unionType] then begin
      with tPtr^ do begin
         size := typeSpec^.size;
         kind := definedType;
         dType := typeSpec;
         end; {with}
      end {if}
   else
      tPtr^ := typeSpec^;
   tPtr^.isConstant := true;
   typeSpec := tPtr;
   end; {if}
end; {TypeSpecifier}


{-- Externally available subroutines ---------------------------}

procedure DoDeclaration {doingPrototypes: boolean};

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

label 1,2,3;

var
   done: boolean;                       {for loop termination}
   foundConstsy: boolean;               {did we find a constsy?}
   fName: stringPtr;                    {for forming uppercase names}
   i: integer;                          {loop variable}
   isAsm: boolean;                      {has the asm modifier been used?}
   lDoingParameters: boolean;           {local copy of doingParameters}
   lisPascal: boolean;                  {local copy of isPascal}
   lp,tlp,tlp2: identPtr;               {for tracing parameter list}
   ltypeSpec: typePtr;                  {copy of type specifier}
   lUseGlobalPool: boolean;             {local copy of useGlobalPool}
   nextPdisp: integer;                  {for calculating parameter disps}
   noFDefinitions: boolean;             {are function definitions inhibited?}
   p1,p2,p3: parameterPtr;              {for reversing prototyped parameters}
   variable: identPtr;                  {pointer to the variable being declared}
   fnType: typePtr;                     {function type}
   segType: integer;                    {segment type}
   tp: typePtr;                         {for tracing type lists}
   tk: tokenType;                       {work token}
   typeFound: boolean;                  {has some type specifier been found?}


   procedure CheckArray (v: identPtr; firstVariable: boolean);
 
   { make sure all required array sizes are specified            }
   {                                                             }
   { parameters:                                                 }
   {     v - pointer to the identifier to check                  }
   {     firstVariable - can the first array subscript be of a   }
   {             non-fixed size?                                 }
 
   label 1;
 
   var
      tp: typePtr;                      {work pointer}
 
   begin {CheckArray}
   if v <> nil then begin               {skip check if there's no variable}
      tp := v^.itype;                   {initialize the type pointer}
      while tp <> nil do begin          {check all types}
         if tp^.kind = arrayType then   {if it's an array with an unspecified  }
            if tp^.elements = 0 then    { size and an unspecified size is not  }
               if not firstVariable then { allowed here, flag an error.         }
                  begin
                  Error(49);
                  goto 1;
                  end; {if}
         firstVariable := false;        {unspecified sizes are only allowed in }
                                        { the first subscript                  }
         case tp^.kind of               {next type...}
            arrayType:
               tp := tp^.aType;
            pointerType: begin
               tp := tp^.pType;
               firstVariable := true;   {(also allowed for pointers to arrays)}
               end;
            functionType:
               tp := tp^.fType;
            otherwise:
               tp := nil;
            end; {case}
         end; {while}
      end; {if}
1:
   end; {CheckArray}


   procedure SegmentStatement;

   { compile a segment statement                                }
   {                                                            }
   { statement syntax:                                          }
   {                                                            }
   {    'segment' string-constant [',' 'dynamic']               }

   var
      i: integer;                       {loop variable}
      len: integer;                     {segment name length}

   begin {SegmentStatement}
   NextToken;
   if token.kind = stringConst then begin
      for i := 1 to 10 do begin
         defaultSegment[i] := chr(0);
         currentSegment[i] := chr(0);
         end; {for}
      len := token.sval^.length;
      if len > 10 then
         len := 10;
      for i := 1 to len do
         defaultSegment[i] := token.sval^.str[i];
      for i := 1 to len do
         currentSegment[i] := token.sval^.str[i];
      FlagPragmas(p_segment);
      NextToken;
      if token.kind = commach then begin
         NextToken;
         if token.kind = ident then begin
            if token.name^ = 'dynamic' then
               segmentKind := $8000
            else Error(84);
            NextToken;
            end {if}
         else Error(84);
         end {if}
      else
         segmentKind := 0;
      Match(semicolonch,22);
      end {if}
   else begin
      Error(83);
      SkipStatement;
      end; {else}
   end; {SegmentStatement}


   function InPartialList (fName: stringPtr): boolean;

   { See if the function is in the partial compile list.        }
   {                                                            }
   { If the function is in the list, the function name is       }
   { removed from the list, and true is returned.  If not,      }
   { false is returned.                                         }
   {                                                            }
   { parameters:                                                }
   {    fName - name of the function to check for               }

   label 1,2;

   var
      ch: char;                         {work character}
      i,j: integer;                     {loop variable}
      len: integer;                     {length of fName}

   begin {InPartialList}
   i := partialFileGS.theString.size;   {strip trailing blanks}
   while (i > 0) and (partialFileGS.theString.theString[i] = ' ') do begin
      partialFileGS.theString.theString[i] := chr(0);
      i := i-1;
      end; {while}
   while partialFileGS.theString.theString[1] = ' ' do               {skip leading blanks}
      for i := 1 to partialFileGS.theString.size do
         partialFileGS.theString.theString[i] :=
            partialFileGS.theString.theString[i+1];
   InPartialList := true;               {assume success}
   i := 1;                              {scan the name list}
   len := length(fName^);
   while partialFileGS.theString.theString[i] <> chr(0) do begin
      for j := 1 to len do begin
         if partialFileGS.theString.theString[i+j-1] <> fName^[j] then
            goto 1;
         end; {for}
      if partialFileGS.theString.theString[i+len] in [' ', chr(0)] then begin

         {found a match - remove from list & return}
         j := i+len;
         while partialFileGS.theString.theString[j] = ' ' do
            j := j+1;
         repeat
            ch := partialFileGS.theString.theString[j];
            partialFileGS.theString.theString[i] := ch;
            i := i+1;
            j := j+1;
         until ch = chr(0);
         goto 2;
         end; {if}
1:    {no match - skip to next name}
      while not (partialFileGS.theString.theString[i] in [chr(0), ' ']) do
         i := i+1;
      while partialFileGS.theString.theString[i] = ' ' do
         i := i+1;
      end; {while}
   InPartialList := false;              {no match found}
2:
   end; {InPartialList}


   procedure SkipFunction (isAsm: boolean);

   { Skip a function body for a partial compile                 }
   {                                                            }
   { Parameters:                                                }
   {    isAsm - are we compiling an asm function?               }

   var
      braceCount: integer;              {# of unmatched { chars}
      doingAsm: boolean;                {compiling an asm statement?}

   begin {SkipFunction}
   Match(lbracech,27);                  {skip to the closing rbrackch}
   braceCount := 1;
   doingAsm := false;
   if isAsm then
      charKinds[ord('#')] := ch_pound;
   while (not (token.kind = eofsy)) and (braceCount <> 0) do begin
      if token.kind = asmsy then begin
         doingAsm := true;
         charKinds[ord('#')] := ch_pound;
         end {if}
      else if token.kind = lbracech then
         braceCount := braceCount+1
      else if token.kind = rbracech then begin
         braceCount := braceCount-1;
         if doingAsm then begin
            doingAsm := false;
            charKinds[ord('#')] := illegal;
            end; {if}
         end; {else if}
      NextToken;
      end; {while}
   nameFound := false;                  {no pc_nam for the next function (yet)}
   doingFunction := false;              {no longer doing a function}
   charKinds[ord('#')] := illegal;      {# is a preprocessor command}
   end; {SkipFunction}


begin {DoDeclaration}
lDoingParameters := doingParameters;    {record the status}
noFDefinitions := false;                {are function definitions inhibited?}
typeFound := false;                     {no explicit type found, yet}
foundConstsy := false;                  {did not find a constsy}
if doingPrototypes then                 {prototypes implies a parm list}
   doingParameters := true
else
   lastParameter := nil;                {init parm list if we're not doing prototypes}
isFunction := false;                    {assume it's not a function}
if not doingFunction then               {handle any segment statements}
   while token.kind = segmentsy do
      SegmentStatement;
inhibitHeader := true;			{block imbedded includes in headers}
if token.kind in [constsy,volatilesy]   {handle leading constsy, volatile}
   then begin
   while token.kind in [constsy,volatilesy] do begin
      if token.kind = constsy then
         foundConstsy := true
      else
         volatile := true;
      NextToken;
      end; {while}
   end; {if}
storageClass := ident;                  {handle a StorageClassSpecifier}
lUseGlobalPool := useGlobalPool;
if token.kind in [autosy,externsy,registersy,staticsy,typedefsy] then begin
   typeFound := true;
   storageClass := token.kind;
   if not doingFunction then
      if token.kind = autosy then
         Error(62);
   if doingParameters then begin
      if token.kind <> registersy then
         Error(87);
      end {if}
   else if storageClass in [staticsy,typedefsy] then
      useGlobalPool := true;
   NextToken;
   end; {if}
isAsm := false;
isPascal := false;
while token.kind in [pascalsy,asmsy] do begin
   if token.kind = pascalsy then
      isPascal := true
   else
      isAsm := true;
   NextToken;
   end; {while}
lisPascal := isPascal;
typeSpec := wordPtr;                    {default type specifier is an integer}
if token.kind in                        {handle a TypeSpecifier/declarator}
   [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy,doublesy,compsy,
   extendedsy,voidsy,enumsy,structsy,unionsy,typedef,volatilesy,constsy] then
   begin
   typeFound := true;
   TypeSpecifier(false,foundConstsy);
   if not skipDeclarator then begin
      variable := nil;
      Declarator(typeSpec, variable, variableSpace, doingPrototypes);
      if variable = nil then begin
         inhibitHeader := false;
         if token.kind = semicolonch then
            NextToken
         else begin
            Error(22);
            SkipStatement;
            end; {else}
         goto 1;
         end; {if}
      end; {if}
   end {if}
else begin
   variable := nil;
   Declarator (typeSpec, variable, variableSpace, doingPrototypes);
   if variable = nil then begin
      inhibitHeader := false;
      if token.kind = semicolonch then
         NextToken
      else begin
         Error(22);
         SkipStatement;
         end; {else}
      goto 1;
      end; {if}
   end;
isPascal := lisPascal;

{make sure variables have some type info}
if isFunction then begin
   if not typeFound then
      if (lint & lintNoFnType) <> 0 then
         Error(104);
   end {if}
else
   if not typeFound then
      Error(26);

3:
{handle a function declaration}
if isFunction then begin

   if doingParameters then              {a function cannot be a parameter}
      Error(28);
   fnType := variable^.itype;           {get the type of the function}
   while (fnType <> nil) and (fnType^.kind <> functionType) do
      case fnType^.kind of
         arrayType  : fnType := fnType^.aType;
         pointerType: fnType := fnType^.pType;
         definedType: fnType := fnType^.dType;
         otherwise  : fnType := nil;
         end; {case}
   if fnType = nil then begin
      SkipStatement;
      goto 1;
      end; {if}
   if isPascal then begin		{reverse prototyped parameters}
      p1 := fnType^.parameterList;
      if p1 <> nil then begin
         p2 := nil;
         while p1 <> nil do begin
            p3 := p1;
            p1 := p1^.next;
            p3^.next := p2;
            p2 := p3;
            end; {while}
         fnType^.parameterList := p2;
         end; {if}
      end; {if}

   {handle functions in the parameter list}
   if doingPrototypes then
      PopTable

   {external or forward declaration}
   else if (storageClass = externsy)
      or (token.kind in [commach,semicolonch,inlinesy]) then begin
      fnType^.isPascal := isPascal;     {note if we have pascal parms}
      if token.kind = inlinesy then     {handle tool declarations}
         with fnType^ do begin
            NextToken;
            Match(lparench,13);
            if token.kind in [intconst,uintconst] then begin
               toolNum := token.ival;
               NextToken;
               end {if}
            else
               Error(18);
            Match(commach,86);
            if token.kind in [longconst,ulongconst] then begin
               dispatcher := token.lval;
               NextToken;
               end {if}
            else if token.kind in [intconst,uintconst] then begin
               dispatcher := token.ival;
               NextToken;
               end {if}
            else
               Error(18);
            Match(rparench,12);
            end; {with}
      doingParameters := doingPrototypes; {not doing parms any more}
      if token.kind = semicolonch then begin
         inhibitHeader := false;
         NextToken;                     {skip the trailing semicolon}
         end {if}
      else if (token.kind = commach) and (not doingPrototypes) then begin
         PopTable;			{pop the symbol table}
         NextToken;                     {allow further declarations}
         variable := nil;
         isFunction := false;
         Declarator (typeSpec, variable, variableSpace, doingPrototypes);
         if variable = nil then begin
            inhibitHeader := false;
            if token.kind = semicolonch then
               NextToken
            else begin
               Error(22);
               SkipStatement;
               end; {else}
            goto 1;
            end; {if}
         goto 3;
         end {else if}
      else begin
         Error(22);
         SkipStatement;
         end; {else}
      PopTable;				{pop the symbol table}
      end {if}

   {cannot imbed functions...}
   else if doingFunction then begin
      isPascal := false;
      Error(28);
      while token.kind <> eofsy do
         NextToken;
      end {if}

   {local declaration}
   else begin
      if noFDefinitions then
         Error(22);
      ftype := fnType^.ftype;           {record the type of the function}
      while fType^.kind = definedType do
         fType := fType^.dType;
      variable^.state := defined;       {note that the function is defined}
      pfunc := variable;                {set the identifier for parm checks}
      fnType^.isPascal := isPascal;     {note if we have pascal parms}
      doingFunction := true;            {read the parameter list}
      doingParameters := true;
                                        {declare the parameters}
      lp := lastParameter;              {(save now; it's volatile)}
      while not (token.kind in [lbracech,eofsy]) do
         if (token.kind in [autosy,externsy,registersy,staticsy,typedefsy,
                            unsignedsy,signedsy,intsy,longsy,charsy,shortsy,
                            floatsy,doublesy,compsy,extendedsy,enumsy,
                            structsy,unionsy,typedef,voidsy,volatilesy,
                            constsy,ident]) then
            DoDeclaration(false)
         else begin
            Error(27);
            NextToken;
            end; {else}
      if numberOfParameters <> 0 then   {default K&R parm type is int}
         begin
         tlp := lp;
         while tlp <> nil do begin
            if tlp^.itype = nil then
               tlp^.itype := wordPtr;
            tlp := tlp^.pnext;
            end; {while}
         end; {if}
      tlp := lp;			{make sure all parameters have an}
      while tlp <> nil do		{ identifier			 }
         if tlp^.name^ = '?' then begin
            Error(113);
            tlp := nil;
            end {if}
         else
            tlp := tlp^.pnext;
      doingParameters := false;
      fName := variable^.name;          {skip if this is not needed for a      }
      if doingPartial then              { partial compile                      }
         if not InPartialList(fName) then begin
            SkipFunction(isAsm);
            goto 2;
            end; {if}
      TermHeader;			{make sure the header file is closed}
      if progress then                  {write progress information}
         writeln('Compiling ', fName^);
      useGlobalPool := false;           {start a local label pool}
      if not codegenStarted and (liDCBGS.kFlag <> 0) then begin {init the code generator (if it needs it)}
         CodeGenInit (outFileGS, liDCBGS.kFlag, doingPartial);
         liDCBGS.kFlag := 3;
         codegenStarted := true;
         end; {if}
      foundFunction := true;            {got one...}
      segType := ord(variable^.class = staticsy) * $4000;
      if fnType^.isPascal then begin
         fName := pointer(Malloc(length(variable^.name^)+1));
         CopyString(pointer(fName), pointer(variable^.name));
         for i := 1 to length(fName^) do
            if fName^[i] in ['a'..'z'] then
               fName^[i] := chr(ord(fName^[i]) & $5F);
         Gen2Name (dc_str, segType, 0, fName);
         end {if}
      else
         Gen2Name (dc_str, segType, 0, variable^.name);
      doingMain := variable^.name^ = 'main';
      firstCompoundStatement := true;
      Gen0 (dc_pin);
      if not isAsm then
         Gen0(pc_ent);
      nextLocalLabel := 1;              {initialize GetLocalLabel}
      returnLabel := GenLabel;          {set up an exit point}
      tempList := nil;                  {initialize the work label list}
      if not isAsm then                 {generate traceback, profile code}
         if traceBack or profileFlag then begin
            if traceBack then
               nameFound := true;
            GenPS(pc_nam, variable^.name);
            end; {if}
      nextPdisp := 0;                   {assign displacements to the parameters}
      if not fnType^.isPascal then begin
         tlp := lp;
         lp := nil;
         while tlp <> nil do begin
            tlp2 := tlp;
            tlp := tlp^.pnext;
            tlp2^.pnext := lp;
            lp := tlp2;
            end; {while}
         end; {if}
      while lp <> nil do begin
         lp^.pdisp := nextPdisp;
         if lp^.itype^.kind = arrayType then
            nextPdisp := nextPdisp + cgPointerSize
         else begin
            if lp^.itype^.kind = scalarType then
               if lp^.itype^.baseType in [cgReal,cgDouble,cgComp] then
                  {all floating-points are passed as extended}
                  lp^.itype := extendedPtr;
            nextPdisp := nextPdisp + long(lp^.itype^.size).lsw;
            if (long(lp^.itype^.size).lsw = 1)
               and (lp^.itype^.kind = scalarType) then
               nextPdisp := nextPdisp+1;
            end; {else}
         lp := lp^.pnext;
         end; {while}
      gotoList := nil;                  {initialize the label list}
                                        {set up struct/union area}
      if variable^.itype^.ftype^.kind in [structType,unionType] then begin
         lp := NewSymbol(@'@struct', variable^.itype^.ftype, staticsy,
            variablespace, declared);
         tk.kind := ident;
         tk.class := identifier;
         tk.name := @'@struct';
         tk.symbolPtr := nil;
         lp := FindSymbol(tk, variableSpace, false, true);
         Gen1Name(pc_lao, 0, lp^.name);
         Gen2t(pc_str, 0, 0, cgULong);
         end; {if}
      if isAsm then begin
         AsmFunction(variable);         {handle assembly language functions}
         PopTable;
         end {if}
      else begin
					{generate parameter labels}
         if fnType^.overrideKR then
            GenParameters(nil)
         else
            GenParameters(fnType^.parameterList); 
         CompoundStatement(false);      {process the statements}
         end; {else}
      end; {else}
2: ;
   end {if}

{handle a variable declaration}
else {if not isFunction then} begin
   noFDefinitions := true;
   if not SkipDeclarator then
      repeat
         if isPascal then begin
            tp := variable^.itype;
            while tp <> nil do
               case tp^.kind of
                  scalarType,
                  enumType,
                  enumConst,
                  definedType,
                  structType,
                  unionType:    begin tp := nil; Error(94); end;
                  arrayType:    tp := tp^.atype;
                  pointerType:  tp := tp^.pType;
                  functionType: begin tp^.isPascal := true; tp := nil; end;
                  end; {case}
            end; {if}
         if token.kind = eqch then begin
            if storageClass = typedefsy then
               Error(52);
            if doingPrototypes then
               Error(88);
                                        {allocate copy of incomplete array type,}
            tp := variable^.itype;      {so it can be completed by Initializer}
            if (tp^.kind = arrayType) and (tp^.elements = 0) then begin
               variable^.itype := pointer(Malloc(sizeof(typeRecord)));
               variable^.itype^ := tp^;
               variable^.itype^.saveDisp := 0;
               end;
            NextToken;                  {handle an initializer}
            ltypeSpec := typeSpec;
            Initializer(variable);
            typeSpec := ltypeSpec;
            end; {if}
                                        {check to insure array sizes are specified}
         if storageClass <> typedefsy then
            CheckArray(variable, (storageClass = externsy) or doingParameters);
                                        {allocate space}
         if variable^.storage = stackFrame then begin
            variable^.lln := GetLocalLabel;
            Gen2(dc_loc, variable^.lln, long(variable^.itype^.size).lsw);
            end; {if}
         if (token.kind = commach) and (not doingPrototypes) then begin
            done := false;              {allow multiple variables on one line}
            NextToken;
            variable := nil;
            Declarator(typeSpec, variable, variableSpace, doingPrototypes);
            if variable = nil then begin
               if token.kind = semicolonch then
                  NextToken
               else begin
                  Error(22);
                  SkipStatement;
                  end; {else}
               goto 1;
               end; {if}
            goto 3;
            end {if}
         else
            done := true;
      until done or (token.kind = eofsy);
   if doingPrototypes then begin
      protoVariable := variable;        {make the var available to Declarator}
      if protoVariable = nil then
         protoType := typeSpec
      else
         protoType := protoVariable^.iType;
      end {if}
   else begin
      inhibitHeader := false;
      if token.kind = semicolonch then  {must end with a semicolon}
         NextToken
      else begin
         Error(22);
         SkipStatement;
         end; {else}
      end; {else}
   end; {else}
1:
doingParameters := lDoingParameters;    {restore the status}
useGlobalPool := lUseGlobalPool;
inhibitHeader := false;
end; {DoDeclaration}


procedure DoStatement;

{ process a statement from a function                           }


   procedure AutoInit;
   
   { initialize auto variables                                  }
   
   var
      count: integer;                   {initializer counter}
      ip: identPtr;                     {pointer to a symbol table entry}
      lp1,lp2: identList;               {used to reverse, track the list}
      iPtr: initializerPtr;             {pointer to the next initializer}


      procedure Initialize (id: identPtr; disp: longint; itype: typePtr);

      { initialize a variable                                   }
      {                                                         }
      { parameters:                                             }
      {    id - pointer to the identifier                       }
      {    disp - disp past the identifier to initialize        }
      {    itype - type of the variable to initialize           }
      {                                                         }
      { variables:                                              }
      {    count - number of times to re-use the initializer    }
      {    ip - pointer to the initializer record to use        }

      label 1;

      var
         elements: longint;             {# array elements}
         fp: identPtr;                  {for tracing field lists}
         size: integer;			{fill size}
         union: boolean;                {are we doing a union?}

                                        {bit field manipulation}
                                        {----------------------}
         bitcount: integer;             {# if bits so far}
         bitsize,bitdisp: integer;      {defines size, location of a bit field}

                                        {assignment conversion}
                                        {---------------------}
         tree: tokenPtr;                {expression tree}
         val: longint;                  {constant expression value}
         isConstant: boolean;           {is the expression a constant?}


         procedure LoadAddress;

         { Load the address of the operand                      }

         begin {LoadAddress}
         with id^ do                    {load the base address}
            case storage of
               stackFrame:     Gen2(pc_lda, lln, 0);
               parameter:      if itype^.kind = arrayType then
                                  Gen2t(pc_lod, pln, 0, cgULong)
                               else
                                  Gen2(pc_lda, pln, 0);
               external,
               global,
               private:        Gen1Name(pc_lao, 0, name);
               otherwise: ;
               end; {case}
         if disp <> 0 then
            Gen1t(pc_inc, long(disp).lsw, cgULong)
         end; {LoadAddress}


         function ZeroFill (elements: longint; itype: typePtr;
                            count: integer; iPtr: initializerPtr): boolean;

         { See if an array can be zero filled				}
         {								}
         { parameters:							}
         {    elements - elements in the array				}
         {    itype - type of each array element			}
         {    count - remaining initializer repititions			}
         {    iPtr - initializer record					}

         begin {ZeroFill}
         ZeroFill := false;
         if not iPtr^.isConstant then
            if itype^.kind in [scalarType,enumType] then
               if count >= elements then
                  with iPtr^.itree^ do
        	     if token.kind = intconst then
                        if token.ival = 0 then
                           ZeroFill := true;
         end; {ZeroFill}


      begin {Initialize}
      case itype^.kind of

         scalarType,pointerType,enumType,functionType: begin
            LoadAddress;                {load the destination address}
            doDispose := count = 1;     {generate the expression value}
            tree := iptr^.itree;        {see if this is a constant}
                                        {do assignment conversions}
            while tree^.token.kind = castoper do
               tree := tree^.left;
            isConstant := tree^.token.class in [intConstant,longConstant];
            if isConstant then
               if tree^.token.class = intConstant then
                  val := tree^.token.ival
               else
                  val := tree^.token.lval;

{        if isConstant then
            if tree^.token.class = intConstant then
               Writeln('loc 2: bitsize = ', iPtr^.bitsize:1, '; ival = ', tree^.token.ival:1) {debug}
{           else
               Writeln('loc 2: bitsize = ', iPtr^.bitsize:1, '; lval = ', tree^.token.lval:1) {debug}
{        else
            Writeln('loc 2: bitsize = ', iPtr^.bitsize:1); {debug}

            GenerateCode(iptr^.iTree);
            AssignmentConversion(itype, expressionType, isConstant, val, true,
               false);
            case itype^.kind of         {save the value}
               scalarType:
                  if iptr^.bitsize <> 0 then
                     Gen2t(pc_sbf, iptr^.bitdisp, iptr^.bitsize, itype^.basetype)
                  else
                     Gen0t(pc_sto, itype^.baseType);
               enumType:
                  Gen0t(pc_sto, cgWord);
               pointerType,functionType:
                  Gen0t(pc_sto, cgULong);
               end; {case}
            end;

         arrayType: begin
            if itype^.aType^.kind = scalarType then
               if itype^.aType^.baseType in [cgByte,cgUByte] then
                  if iPtr^.iTree^.token.kind = stringConst then begin
                     GenLdcLong(itype^.elements);
                     Gen0t(pc_stk, cgULong);
                     GenS(pc_lca, iPtr^.iTree^.token.sval);
                     Gen0t(pc_stk, cgULong);
                     Gen0t(pc_bno, cgULong);
                     LoadAddress;
                     Gen0t(pc_stk, cgULong);
                     Gen0t(pc_bno, cgULong);
                     Gen1tName(pc_cup, 0, cgVoid, @'strncpy');
                     iPtr := iPtr^.next;
                     goto 1;
                     end; {if}
            elements := itype^.elements;
            itype := itype^.atype;
            if ZeroFill(elements, itype, count, iPtr) then begin
               if itype^.kind = enumType then
                  size := cgWordSize
               else
                  size := TypeSize(itype^.baseType);
               size := size * long(elements).lsw;
               LoadAddress;
               Gen0t(pc_stk, cgULong);
               Gen1t(pc_ldc, size, cgWord);
               Gen0t(pc_stk, cgWord);
               Gen0t(pc_bno, cgULong);
               Gen1tName(pc_cup, 0, cgVoid, @'~ZERO');
               disp := disp + size;
               count := count - long(elements).lsw;
               if count = 0 then begin
                  iPtr := iPtr^.next;
                  count := iPtr^.count;
                  end; {if}
               end {if}
            else begin
               while elements <> 0 do begin
        	  Initialize(id, disp, itype);
        	  if itype^.kind in [scalarType,pointerType,enumType] then begin
                     count := count-1;
                     if count = 0 then begin
                	iPtr := iPtr^.next;
                	count := iPtr^.count;
                	end; {if}
                     end; {if}
        	  disp := disp+itype^.size;
        	  elements := elements-1;
        	  end; {while}
               end; {else}
1:          end;

         structType,unionType: begin
            if iPtr^.isStruct then begin
               LoadAddress;             {load the destination address}
               GenerateCode(iptr^.iTree); {load the stuct address}
                                        {do the assignment}
               AssignmentConversion(itype, expressionType, isConstant, val,
                  true, false);
               with expressionType^ do
                  Gen2(pc_mov, long(size).msw, long(size).lsw);
               Gen0t(pc_pop, UsualUnaryConversions);
               end {if}
            else begin
               union := itype^.kind = unionType;
               fp := itype^.fieldList;
               bitsize := iPtr^.bitsize;
               bitdisp := iPtr^.bitdisp;
               bitcount := 0;
               while fp <> nil do begin
                  itype := fp^.itype;
{                 writeln('Initialize:    disp = ',    disp:3, '; fp^.   Disp = ', fp^.disp:3, 'itype^.size = ', itype^.size:1); {debug}
{                 writeln('            bitDisp = ', bitDisp:3, '; fp^.bitDisp = ', fp^.bitDisp:3); {debug}
{                 writeln('            bitSize = ', bitSize:3, '; fp^.bitSize = ', fp^.bitSize:3); {debug}
                  Initialize(id, disp, itype);
                  if bitsize = 0 then begin
                     if bitcount <> 0 then begin
                        disp := disp + (bitcount+7) div 8;
                        bitcount := 0;
                        end {if}
                     else if fp^.bitSize <> 0 then begin
                        bitcount := 8;
                        while (fp <> nil) and (bitcount > 0) do begin
                           bitcount := bitcount - fp^.bitSize;
                           if bitcount > 0 then
                              if fp^.next <> nil then
                                 if fp^.next^.bitSize <> 0 then
                                    fp := fp^.next
                        	 else
                        	    bitcount := 0;
                           end; {while}
                        bitcount := 0;
                        disp := disp + 1;
                        end {else if}
                     else
                        disp := disp + itype^.size;
                     end {if}
                  else if fp^.bitSize = 0 then begin
                     bitsize := 0;
                     disp := disp + itype^.size;
                     end {else if}
                  else begin
                     if bitsize + bitdisp < bitcount then
                        disp := disp + (bitcount + 7) div 8;
                     bitcount := bitsize + bitdisp;
                     end; {else}
                  if itype^.kind in [scalarType,pointerType,enumType] then begin
                     count := count-1;
                     if count = 0 then begin
                        iPtr := iPtr^.next;
                        count := iPtr^.count;
                        bitsize := iPtr^.bitsize;
                        bitdisp := iPtr^.bitdisp;
                        end; {if}
                     end; {if}
                  if union then
                     fp := nil
                  else
                     fp := fp^.next;
                  end; {while}
               end; {else}
            end;

         otherwise: Error(57);
         end; {case}
      end; {Initialize}


   begin {AutoInit}
   lp1 := nil;                          {reverse the list}
   while initializerList <> nil do begin
      lp2 := initializerList;
      initializerList := lp2^.next;
      lp2^.next := lp1;
      lp1 := lp2;
      end; {while}
  while lp1 <> nil do begin             {initialize the variables}
     ip := lp1^.id;
     iPtr := ip^.iPtr;
     count := iPtr^.count;
     if ip^.class <> staticsy then
        Initialize(ip, 0, ip^.itype);
     lp2 := lp1;
     lp1 := lp1^.next;
     dispose(lp2);
     end; {while}
   end; {AutoInit}


begin {DoStatement}
case statementList^.kind of

   compoundSt: begin
      if token.kind = rbracech then begin
         if statementList^.doingDeclaration then
            if initializerList <> nil then
               AutoInit;
         EndCompoundStatement;
         end {if}
      else if (statementList^.doingDeclaration = true)
         and (token.kind in [autosy,externsy,registersy,staticsy,typedefsy,
                             unsignedsy,signedsy,intsy,longsy,charsy,shortsy,
                             floatsy,doublesy,compsy,extendedsy,enumsy,
                             structsy,unionsy,typedef,voidsy,volatilesy,
                             constsy])
         then
         DoDeclaration(false)
      else begin
         if statementList^.doingDeclaration then begin
            statementList^.doingDeclaration := false;
            if firstCompoundStatement then begin
               Gen1Name(dc_sym, ord(doingMain), pointer(table));
               firstCompoundStatement := false;
               end; {if}
            if initializerList <> nil then
               AutoInit;
            end; {if}
         Statement;
         end; {else}
      end;
 
   ifSt:
      EndIfStatement;
 
   elseSt:
      EndElseStatement;
 
   doSt:
      EndDoStatement;
 
   whileSt:
      EndWhileStatement;
 
   forSt:
      EndForStatement;

   switchSt:
      EndSwitchStatement;

   otherwise: Error(57);
   end; {case}
end; {DoStatement}


procedure InitParser;

{ Initialize the parser                                         }

begin {InitParser}
doingFunction := false;                 {not doing a function (yet)}
doingParameters := false;               {not processing parameters}
lastLine := 0;                          {no pc_lnm generated yet}
nameFound := false;                     {no pc_nam generated yet}
statementList := nil;                   {no open statements}
codegenStarted := false;                {code generator is not started}
end; {InitParser}


procedure TermParser;

{ shut down the parser                                          }

begin {TermParser}
if statementList <> nil then
   case statementList^.kind of
      compoundSt  : Error(34);
      doSt        : Error(33);
      elseSt      : Error(67);
      forSt       : Error(69);
      ifSt        : Error(32);
      switchSt    : Error(70);
      whileSt     : Error(68);
      otherwise: Error(57);
      end; {case}
end; {TermParser}

end.