{$optimize 7}
{---------------------------------------------------------------}
{                                                               }
{  Symbol Table                                                 }
{                                                               }
{  Handle the symbol table.                                     }
{                                                               }
{  External Subroutines:                                        }
{                                                               }
{  CheckStaticFunctions - check for undefined functions         }
{  CompTypes - Determine if the two types are compatible        }
{  DoGlobals - declare the ~globals and ~arrays segments        }
{  FindSymbol - locate a symbol in the symbol table             }
{  GenParameters - Generate labels and space for the parameters }
{  GenSymbols - generate a symbol table for the debugger        }
{  InitSymbol - initialize the symbol table handler             }
{  NewSymbol - insert a new symbol in the symbol table          }
{  PopTable - Pop a symbol table (remove definitions local to a }
{       block)                                                  }
{  PushTable - Create a new symbol table, pushing the old one   }
{  ResolveForwardReference - resolve a forward reference        }
{                                                               }
{  External Variables:                                          }
{                                                               }
{  table - current symbol table                                 }
{                                                               }
{  charPtr - pointer to the base type for char                  }
{  sCharPtr - pointer to the base type for signed char          }
{  uCharPtr - pointer to the base type for unsigned char        }
{  shortPtr - pointer to the base type for short                }
{  uShortPtr - pointer to the base type for unsigned short      }
{  intPtr - pointer to the base type for int                    }
{  uIntPtr - pointer to the base type for unsigned int          }
{  int32Ptr - pointer to the base type for 32-bit int           }
{  uInt32Ptr - pointer to the base type for 32-bit unsigned int }
{  longPtr - pointer to the base type for long                  }
{  uLongPtr - pointer to the base type for unsigned long        }
{  longLongPtr - pointer to the base type for long long         }
{  uLongLongPtr - pointer to base type for unsigned long long   }
{  floatPtr - pointer to the base type for float                }
{  doublePtr - pointer to the base type for double              }
{  compPtr - pointer to the base type for comp                  }
{  extendedPtr - pointer to the base type for extended          }
{  boolPtr - pointer to the base type for _Bool                 }
{  voidPtr - pointer to the base type for void                  }
{  voidPtrPtr - typeless pointer, for some type casting         }
{  charPtrPtr - pointer to type record for char *               }
{  vaInfoPtr - pointer to type record for internal va info type }
{  stringTypePtr - pointer to the base type for string literals }
{  utf16StringTypePtr - pointer to the base type for UTF-16     }
{       string literals                                         }
{  utf32StringTypePtr - pointer to the base type for UTF-32     }
{       string literals                                         }
{  constCharPtr - pointer to the type const char                }
{  defaultStruct - default for structures with errors           }
{                                                               }
{---------------------------------------------------------------}

unit Symbol;

{$LibPrefix '0/obj/'}

interface

uses CCommon, CGI, MM, Scanner;

{$segment 'CC'}

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

const
   staticNumLen = 5;                    {length of staticNum name prefix}

type
   symbolTablePtr = ^symbolTable;
   symbolTable = record                 {a symbol table}
      {NOTE: the array of buckets must come first in the record!}
      buckets: array[0..hashSize2] of identPtr; {hash buckets}
      next: symbolTablePtr;             {next symbol table}
      isEmpty: boolean;                 {is the pool empty (nothing in buckets)?}
      case noStatics: boolean of        {no statics/staticNum for this table?}
         false: (staticNum: packed array[1..6] of char); {staticNum for this table}
         true: ();
      end;

var
   table: symbolTablePtr;               {current symbol table}
   globalTable: symbolTablePtr;         {global symbol table}
   functionTable: symbolTablePtr;       {table for top level of current function}

                                        {output from GenParameters}
   lastParameterLLN: integer;           {label number of last parameter (0 if none)}
   lastParameterSize: integer;          {size of last parameter}

                                        {base types}
   charPtr,sCharPtr,uCharPtr,shortPtr,uShortPtr,intPtr,uIntPtr,int32Ptr,
      uInt32Ptr,longPtr,uLongPtr,longLongPtr,uLongLongPtr,boolPtr,
      floatPtr,doublePtr,compPtr,extendedPtr,stringTypePtr,utf16StringTypePtr,
      utf32StringTypePtr,voidPtr,voidPtrPtr,charPtrPtr,vaInfoPtr,constCharPtr,
      defaultStruct: typePtr;

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

procedure CheckStaticFunctions;

{ check for undefined functions                                 }


procedure CheckUnused (tPtr: symbolTablePtr);

{ check for unused variables in symbol table                    }


function CompTypes (t1, t2: typePtr): boolean;

{ Determine if the two types are compatible                     }


function StrictCompTypes (t1, t2: typePtr): boolean;

{ Determine if the two types are compatible, strictly following }
{ C standard rules.                                             }


procedure DoGlobals;

{ declare the ~globals and ~arrays segments                     }


function FindSymbol (var tk: tokenType; class: spaceType; oneLevel: boolean;
                     staticAllowed: boolean): identPtr;

{ locate a symbol in the symbol table                           }
{                                                               }
{ parameters:                                                   }
{       tk - token record for the identifier to find            }
{       class - the kind of variable space to search            }
{       oneLevel - search one level only? (used to check for    }
{               duplicate symbols)                              }
{       staticAllowed - can we check for static variables?      }
{                                                               }
{ returns:                                                      }
{       A pointer to the symbol table entry is returned.  If    }
{       there is no entry, nil is returned.                     }


procedure GenParameters (pp: parameterPtr);

{ Generate labels and space for the parameters                  }
{								}
{ parameters:							}
{    pp - pointer to first parameter				}
{                                                               }
{ variables:                                                    }
{     lastParameterLLN - label number of last parameter         }
{     lastParameterSize - size of last parameter                }
          

procedure GenSymbols (sym: symbolTablePtr; doGlobals: boolean);

{ generate a symbol table for the debugger                      }
{                                                               }
{ parameters:                                                   }
{       sym - symbol table to generate                          }
{       doGlobals - include global symbols in the table         }
{                                                               }
{ outputs:                                                      }
{       symLength - length of debug symbol table                }


procedure InitSymbol;

{ Initialize the symbol table module                            }


function IsVoid (tp: typePtr): boolean;

{ Check to see if a type is void                                }
{                                                               }
{ Parameters:                                                   }
{    tp - type to check                                         }
{                                                               }
{ Returns: True if the type is void, else false                 }


function LabelToDisp (lab: integer): integer; extern;

{ convert a local label number to a stack frame displacement    }
{                                                               }
{ parameters:                                                   }
{       lab - label number                                      }


function MakePascalType (origType: typePtr): typePtr;

{ make a version of a type with the pascal qualifier applied    }
{                                                               }
{ parameters:                                                   }
{       origType - the original type                            }
{                                                               }
{ returns: pointer to the pascal-qualified type                 }


function MakePointerTo (pType: typePtr): typePtr;

{ make a pointer type                                           }
{                                                               }
{ parameters:                                                   }
{       pType - the type pointed to                             }
{                                                               }
{ returns: the pointer type                                     }


function MakeCompositeType (t1, t2: typePtr): typePtr;

{ Make the composite type of two compatible types.              }
{ See C17 section 6.2.7.                                        }
{                                                               }
{ parameters:                                                   }
{       t1,t2 - the input types (must be compatible)            }
{                                                               }
{ returns: pointer to the composite type                        }


function MakeQualifiedType (origType: typePtr; qualifiers: typeQualifierSet):
   typePtr;

{ make a qualified version of a type                            }
{                                                               }
{ parameters:                                                   }
{       origType - the original type                            }
{       qualifiers - the type qualifier(s) to add               }
{                                                               }
{ returns: pointer to the qualified type                        }


function Unqualify (tp: typePtr): typePtr;

{ returns the unqualified version of a type                     }
{                                                               }
{ parameters:                                                   }
{       tp - the original type                                  }
{                                                               }
{ returns: pointer to the unqualified type                      }


function NewSymbol (name: stringPtr; itype: typePtr; class: tokenEnum;
                   space: spaceType; state: stateKind; isInline: boolean):
                   identPtr;

{ insert a new symbol in the symbol table                       }
{                                                               }
{ parameters:                                                   }
{       name - pointer to the symbol name                       }
{       itype - pointer to the symbol type                      }
{       class - storage class                                   }
{       space - the kind of variable space to put the           }
{               identifier in                                   }
{       state - variable declaration state                      }
{                                                               }
{ returns: pointer to the inserted symbol                       }


procedure PopTable;

{ Pop a symbol table (remove definitions local to a block)      }


{procedure PrintOneSymbol (ip: identPtr); {debug}

{ Print a symbol						}
{								}
{ Parameters:							}
{    ip - identifier to print					}


{procedure PrintTable (sym: symbolTablePtr);  {debug}

{ print a symbol table                                          }
{                                                               }
{ parameters:                                                   }
{       sym - symbol table to print                             }


procedure PushTable;

{ Create a new symbol table, pushing the old one                }


procedure ResolveForwardReference (iPtr: identPtr);

{ resolve a forward reference                                   }
{                                                               }
{ parameters:                                                   }
{       iPtr - ptr to the forward declared identifier           }


function StringType(prefix: charStrPrefixEnum): typePtr;

{ returns the type of a string literal with specified prefix    }
{                                                               }
{ parameters:                                                   }
{       prefix - the prefix                                     }

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

implementation

type
                                        {From CGC.pas}
   realrec = record                     {used to convert from real to in-SANE}
      itsReal: extended;
      inCOMP: packed array[1..8] of byte;
      end;

var
   staticNum: packed array[1..6] of char; {static variable number}
   tablePool: symbolTablePtr;           {pool of reusable empty symbol tables}
   tablePoolSize: 0..maxint;            {number of tables in pool}
   tablePoolMaxSize: 0..maxint;         {max number of tables in pool}

{- Imported from CGC.pas ---------------------------------------}

procedure CnvSC (rec: realrec); extern;

{ convert a real number to SANE comp format                     }
{                                                               }
{ parameters:                                                   }
{       rec - record containing the value to convert; also      }
{               has space for the result                        }

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

procedure CnOut (i: integer); extern;

{ write a byte to the constant buffer                           }
{                                                               }
{ parameters:                                                   }
{       i - byte to write                                       }


procedure CnOut2 (i: integer); extern;

{ write a word to the constant buffer                           }
{                                                               }
{ parameters:                                                   }
{       i - word to write                                       }


procedure Out (b: integer); extern;

{ write a byte to the output file                               }
{                                                               }
{ parameters:                                                   }
{       b - byte to write                                       }


procedure Out2 (w: integer); extern;

{ write a word to the output file                               }
{                                                               }
{ parameters:                                                   }
{       w - word to write                                       }


procedure RefName (lab: stringPtr; disp, len, shift: integer); extern;

{ handle a reference to a named label                           }
{                                                               }
{ parameters:                                                   }
{       lab - label name                                        }
{       disp - displacement past the label                      }
{       len - number of bytes in the reference                  }
{       shift - shift factor                                    }


procedure LabelSearch (lab: integer; len, shift, disp: integer); extern;

{ resolve a label reference                                     }
{                                                               }
{ parameters:                                                   }
{       lab - label number                                      }
{       len - # bytes for the generated code                    }
{       shift - shift factor                                    }
{       disp - disp past the label                              }
{                                                               }
{ Note 1: maxlabel is reserved for use as the start of the      }
{       string space                                            }
{ Note 2: negative length indicates relative branch             }
{ Note 3: zero length indicates 2 byte addr -1                  }


procedure Purge; extern;

{ write any constant bytes to the output buffer                 }

{- Imported from IIGS Memory Manager ---------------------------}

function MaxBlock: longint; tool ($02, $1C);

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

procedure ClearTable (table: symbolTable); extern;

{ clear the symbol table to all zeros                           }

procedure SaveBF (addr: ptr; bitdisp, bitsize: integer; val: longint); extern;

{ save a value to a bit-field                                   }
{                                                               }
{ parameters:                                                   }
{       addr - address to copy to                               }
{       bitdisp - displacement past the address                 }
{       bitsize - number of bits                                }
{       val - value to copy                                     }

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


procedure CheckStaticFunctions;

{ check for undefined functions                                 }

var
   i: 0..hashSize;                      {loop variable}
   sp: identPtr;                        {pointer to a symbol table entry}

   msg: stringPtr;                      {error message ptr}

begin {CheckStaticFunctions}
for i := 0 to hashSize do begin
   sp := globalTable^.buckets[i];
   while sp <> nil do begin
      if sp^.storage = private then
         if sp^.itype^.kind = functionType then
            if sp^.state <> defined then
               if sp^.used then begin
                  numErrors := numErrors+1;
                  new(msg);
                  msg^ := concat('The static function ', sp^.name^,
                     ' was used but never defined.');
                  writeln('*** ', msg^);
                  if terminalErrors then begin
                     if enterEditor then
                        ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr))
                     else
                        TermError(0);
                     end; {if}
                  liDCBGS.merrf := 16;
                  end; {if}
      sp := sp^.next;
      end; {while}
   end; {for}
end; {CheckStaticFunctions}


procedure CheckUnused {tPtr: symbolTablePtr};

{ check for unused variables in symbol table                    }

var
   i: integer;                          {loop variable}
   ip: identPtr;                        {current symbol}
   nameStr: stringPtr;

begin {CheckUnused}
if not tPtr^.isEmpty or not tPtr^.noStatics then
   for i := 0 to hashSize do begin      {loop over all hash buckets}
      if not tPtr^.isEmpty then begin
         ip := tPtr^.buckets[i];        {trace through non-static symbols}
         while ip <> nil do begin
            if not ip^.used then
               if ip^.itype <> nil then
                  if not (ip^.itype^.kind in [functionType,enumConst]) then
                     if ip^.storage in [stackFrame,private] then
                        if not (ip^.name^[1] in ['~','@']) then begin
                           new(nameStr);
                           nameStr^ := ip^.name^;
                           ErrorWithExtraString(185, nameStr);
                           end; {if}
            ip := ip^.next;
            end; {while}
         end; {if}
      if not tPtr^.noStatics then begin
         ip := globalTable^.buckets[i]; {trace through static symbols}
         while ip <> nil do begin
            if not ip^.used then
               if ip^.itype <> nil then
                  if not (ip^.itype^.kind in [functionType,enumConst]) then
                     if ip^.storage = private then
                        if copy(ip^.name^,1,staticNumLen) = tPtr^.staticNum then
                           if not (ip^.name^[staticNumLen+1] in ['~','@']) then
                              begin
                              new(nameStr);
                              nameStr^ :=
                                 copy(ip^.name^, staticNumLen+1, maxint);
                              ErrorWithExtraString(185, nameStr);
                              end; {if}
            ip := ip^.next;
            end; {while}
         end; {if}
      end; {for}
end; {CheckUnused}


function CompTypes {t1, t2: typePtr): boolean};

{ Determine if the two types are compatible                     }

label 1;

var
   el1,el2: longint;                    {array sizes}
   kind1,kind2: typeKind;               {temp variables (for speed)}

begin {CompTypes}
CompTypes := false;                     {assume the types are not compatible}
kind1 := t1^.kind;                      {get these for efficiency}
kind2 := t2^.kind;
if kind2 = definedType then             {scan past type definitions}
   CompTypes := CompTypes(t1, t2^.dType)
else if kind1 = definedType then
   CompTypes := CompTypes(t1^.dType, t2)

else
   case kind1 of

      scalarType:
         if kind2 = scalarType then begin
            CompTypes := t1^.baseType = t2^.baseType;
            if t1^.cType <> t2^.cType then
               if (not looseTypeChecks) 
                  or (t1^.cType = ctBool) or (t2^.cType = ctBool) then
                  CompTypes := false;
            end {if}
         else if kind2 = enumType then
            CompTypes := (t1^.baseType = cgWord) and (t1^.cType = ctInt);

      arrayType:
         if kind2 = arrayType then begin
            el1 := t1^.elements;
            el2 := t2^.elements;
            if el1 = 0 then
               el1 := el2
            else if el2 = 0 then
               el2 := el1;
            if el1 = el2 then
               CompTypes := CompTypes(t1^.atype, t2^.atype);
            end; {if}

      functionType:
         if kind2 = functionType then begin
            if looseTypeChecks or (t1^.prototyped <> t2^.prototyped) then
               CompTypes := CompTypes(t1^.ftype,t2^.ftype)
            else
               CompTypes := StrictCompTypes(t1, t2);
            end {if}
         else if kind2 = pointerType then
            if t2^.ptype^.kind = functionType then
               CompTypes := CompTypes(t1, t2^.ptype);

      pointerType: begin
         if IsVoid(t1^.ptype) or IsVoid(t2^.ptype) then begin
            CompTypes := true;
            goto 1;
            end; {if}
         if kind2 = pointertype then
            CompTypes := CompTypes(t1^.ptype, t2^.ptype)
         else if kind2 = functionType then
            CompTypes := CompTypes(t1^.ptype, t2);
         end;

      enumType:
         if kind2 = scalarType then
            CompTypes := (t2^.baseType = cgWord) and (t2^.cType = ctInt)
         else if kind2 = enumType then
            CompTypes := true;

      structType,unionType:
         CompTypes := t1 = t2;

      otherwise: ;

      end; {case t1^.kind}
1:
end; {CompTypes}


function StrictCompTypes {t1, t2: typePtr): boolean};

{ Determine if the two types are compatible, strictly following }
{ C standard rules.                                             }

label 1;

var
   el1,el2: longint;                    {array sizes}
   kind1,kind2: typeKind;               {temp variables (for speed)}
   p1, p2: parameterPtr;                {for tracing parameter lists}
   tp1,tp2: typeRecord;                 {temporary types used in comparison}


begin {StrictCompTypes}
if t1 = t2 then begin                   {shortcut}
   StrictCompTypes := true;
   goto 1;
   end; {if}
StrictCompTypes := false;               {assume the types are not compatible}
if t1^.qualifiers <> t2^.qualifiers then {qualifiers must be the same}
   goto 1;
while t1^.kind = definedType do         {scan past type definitions}
   t1 := t1^.dType;
while t2^.kind = definedType do
   t2 := t2^.dType;
kind1 := t1^.kind;                      {get these for efficiency}
kind2 := t2^.kind;

case kind1 of

   scalarType:
      if kind2 = scalarType then begin
         StrictCompTypes :=
            (t1^.baseType = t2^.baseType) and (t1^.cType = t2^.cType);
         end {if}
      else if kind2 = enumType then
         StrictCompTypes := (t1^.baseType = cgWord) and (t1^.cType = ctInt);

   arrayType:
      if kind2 = arrayType then begin
         el1 := t1^.elements;
         el2 := t2^.elements;
         if el1 = 0 then
            el1 := el2
         else if el2 = 0 then
            el2 := el1;
         if el1 = el2 then
            StrictCompTypes := StrictCompTypes(t1^.atype, t2^.atype);
         end; {if}

   functionType:
      if kind2 = functionType then begin
         if not StrictCompTypes(t1^.ftype, t2^.ftype) then
            goto 1;
         if t1^.varargs <> t2^.varargs then
            goto 1;
         if t1^.prototyped and t2^.prototyped then begin
            p1 := t1^.parameterList;
            p2 := t2^.parameterList;
            while (p1 <> nil) and (p2 <> nil) do begin
               tp1 := p1^.parameterType^;
               tp2 := p2^.parameterType^;
               if p1^.parameterType = p2^.parameterType then
                  {these parameters are compatible}
               else begin
                  tp1.qualifiers := [];
                  tp2.qualifiers := [];
                  if tp1.kind = arrayType then
                     tp1.kind := pointerType
                  else if tp1.kind = functionType then begin
                     tp1.size := cgPointerSize;
                     tp1.qualifiers := [];
                     tp1.saveDisp := 0;
                     tp1.kind := pointerType;
                     tp1.pType := p1^.parameterType;
                     end; {else if}
                  if tp2.kind = arrayType then
                     tp2.kind := pointerType
                  else if tp2.kind = functionType then begin
                     tp2.size := cgPointerSize;
                     tp2.qualifiers := [];
                     tp2.saveDisp := 0;
                     tp2.kind := pointerType;
                     tp2.pType := p2^.parameterType;
                     end; {else if}
                  if not StrictCompTypes(@tp1, @tp2) then
                     goto 1;
                  end; {else}
                  p1 := p1^.next;
                  p2 := p2^.next;
               end; {while}
            if p1 <> p2 then
               goto 1;
            end {if}
         else if t1^.prototyped then begin
            p1 := t1^.parameterList;
            while p1 <> nil do begin
               if p1^.parameterType^.kind = scalarType then
                  if p1^.parameterType^.cType in [ctChar,ctSChar,ctUChar,
                     ctShort,ctUShort,ctFloat,ctBool] then
                     goto 1;
               p1 := p1^.next;
               end; {while}
            end {else if}
         else if t2^.prototyped then begin
            p2 := t2^.parameterList;
            while p2 <> nil do begin
               if p2^.parameterType^.kind = scalarType then
                  if p2^.parameterType^.cType in [ctChar,ctSChar,ctUChar,
                     ctShort,ctUShort,ctFloat,ctBool] then
                     goto 1;
               p2 := p2^.next;
               end; {while}
            end; {else if}
         StrictCompTypes := true;
         end; {if}

   pointerType:
      if kind2 = pointertype then
         StrictCompTypes := StrictCompTypes(t1^.ptype, t2^.ptype);

   enumType:
      if kind2 = scalarType then
         StrictCompTypes := (t2^.baseType = cgWord) and (t2^.cType = ctInt)
      else if kind2 = enumType then
         StrictCompTypes := true;

   structType,unionType:
      StrictCompTypes := t1 = t2;

   otherwise: ;

   end; {case}
1:
end; {StrictCompTypes}


procedure DoGlobals;

{ declare the ~globals and ~arrays segments                     }


   procedure FreeTablePool;
   
   { free the symbol table pool                                 }
   
   var
      tPtr: symbolTablePtr;
   
   begin {FreeTablePool}
   while tablePool <> nil do begin
      tPtr := tablePool;
      tablePool := tPtr^.next;
      dispose(tPtr);
      end;   
   end; {FreeTablePool}


   procedure StaticInit (variable: identPtr);

   { statically initialize a variable                           }

   type
                                        {record of pointer initializers}
      relocPtr = ^relocationRecord;
      relocationRecord = record
         next: relocPtr;                {next record}
         initializer: initializerPtr;   {the initializer}
         disp: longint;                 {disp in overall data structure}
         end;

                                        {pointers to each type}
      bytePtr = ^byte;
      wordPtr = ^integer;
      longPtr = ^longint;
      quadPtr = ^longlong;
      realPtr = ^real;
      doublePtr = ^double;
      extendedPtr = ^extended;

   var
      buffPtr: ptr;                     {pointer to data buffer}
      count: integer;                   {# of duplicate records}
      disp: longint;                    {disp into buffer (for output)}
      endDisp: longint;                 {ending disp for current chunk}
      i: integer;                       {loop counter}
      ip: initializerPtr;               {used to trace initializer lists}
      lastReloc, nextReloc: relocPtr;   {for reversing relocs list}
      realVal: realRec;                 {used for extended-to-comp conversion}
      relocs: relocPtr;                 {list of records needing relocation}
      
                                        {pointers used to write data}
      bp: bytePtr;
      wp: wordPtr;
      lp: longPtr;
      qp: quadPtr;
      rp: realPtr;
      dp: doublePtr;
      ep: extendedPtr;


      procedure UpdateRelocs;

      { update relocation records to account for an initializer }

      var
         disp: longint;                 {disp of current initializer}
         done: boolean;                 {done with loop?}
         endDisp: longint;              {disp at end of current initializer}
         last: ^relocPtr;               {the pointer referring to rp}
         rp: relocPtr;                  {reloc record being processed}

      begin {UpdateRelocs}
      disp := ip^.disp;
      if ip^.bitsize <> 0 then begin
         endDisp := disp + (ip^.bitdisp + ip^.bitsize + 7) div 8;
         disp := disp + ip^.bitdisp div 8;
         end {if}
      else if ip^.basetype = cgString then
         endDisp := disp + ip^.sVal^.length
      else
         endDisp := disp + TypeSize(ip^.baseType);
      last := @relocs;
      rp := relocs;
      done := false;
      while (rp <> nil) and not done do begin
         if rp^.disp + cgPointerSize <= disp then begin
            {initializer is entirely after this reloc: no conflicts}
            done := true;
            end {if}
         else if endDisp <= rp^.disp then begin
            {initializer is entirely before this reloc}
            last := @rp^.next;
            rp := rp^.next;
            end {else if}
         else begin
            {conflict: remove the conflicting reloc record}
            last^ := rp^.next;
            lp := pointer(ord4(buffPtr) + rp^.disp);
            lp^ := 0;
            dispose(rp);
            rp := last^;
            end; {else}
         end; {while}
      if ip^.basetype = ccPointer then begin
         new(rp);
         rp^.next := last^;
         last^ := rp;
         rp^.disp := ip^.disp;
         rp^.initializer := ip;
         end; {if}
      end; {UpdateRelocs}
   
   begin {StaticInit}
                                        {allocate buffer}
                                        {(+3 for possible bitfield overhang)}
   buffPtr := GLongMalloc(variable^.itype^.size+3);
   
   relocs := nil;                       {evaluate initializers}
   ip := variable^.iPtr;
   while ip <> nil do begin
      count := 0;
      while count < ip^.count do begin
         UpdateRelocs;
         if ip^.bitsize <> 0 then begin
            bp := pointer(ord4(buffPtr) + ip^.disp + count);
            SaveBF(bp, ip^.bitdisp, ip^.bitsize, ip^.iVal);
            end {if}
         else
            case ip^.basetype of
               cgByte,cgUByte: begin
                  bp := pointer(ord4(buffPtr) + ip^.disp + count);
                  bp^ := ord(ip^.iVal) & $ff;
                  end;

               cgWord,cgUWord: begin
                  wp := pointer(ord4(buffPtr) + ip^.disp + count);
                  wp^ := ord(ip^.iVal);
                  end;

               cgLong,cgULong: begin
                  lp := pointer(ord4(buffPtr) + ip^.disp + count);
                  lp^ := ip^.iVal;
                  end;
            
               cgQuad,cgUQuad: begin
                  qp := pointer(ord4(buffPtr) + ip^.disp + count);
                  qp^ := ip^.qVal;
                  end;

               cgReal: begin
                  rp := pointer(ord4(buffPtr) + ip^.disp + count);
                  rp^ := ip^.rVal;
                  end;

               cgDouble: begin
                  dp := pointer(ord4(buffPtr) + ip^.disp + count);
                  dp^ := ip^.rVal;
                  end;

               cgExtended: begin
                  ep := pointer(ord4(buffPtr) + ip^.disp + count);
                  ep^ := ip^.rVal;
                  end;

               cgComp: begin
                  realVal.itsReal := ip^.rVal;
                  CnvSC(realVal);
                  for i := 1 to 8 do begin
                     bp := pointer(ord4(buffPtr) + ip^.disp + count + i-1);
                     bp^ := realVal.inCOMP[i];
                     end; {for}
                  end;
     
               cgString: begin
                  for i := 1 to ip^.sVal^.length do begin
                     bp := pointer(ord4(buffPtr) + ip^.disp + count + i-1);
                     bp^ := ord(ip^.sVal^.str[i]);
                     end; {for}
                  end;
     
               ccPointer: ;             {handled by UpdateRelocs}
         
               cgVoid: Error(57);
               end; {case}
         count := count + 1;            {assumes count > 1 only for bytes}
         end; {while}
      ip := ip^.next;
      end; {while}
                        
   lastReloc := nil;                    {reverse the relocs list}
   while relocs <> nil do begin
      nextReloc := relocs^.next;
      relocs^.next := lastReloc;
      lastReloc := relocs;
      relocs := nextReloc;
      end; {while}
   relocs := lastReloc;

   disp := 0;                           {generate the initialization data}
   while disp < variable^.itype^.size do begin
      if relocs = nil then
         endDisp := variable^.itype^.size
      else
         endDisp := relocs^.disp;
      if disp <> endDisp then begin
         GenBS(dc_cns, pointer(ord4(buffPtr) + disp), endDisp - disp);
         disp := endDisp;
         end; {if}
      if relocs <> nil then begin
         code^.optype := ccPointer;
         code^.r := ord(relocs^.initializer^.pPlus);
         code^.q := 1;
         code^.pVal := relocs^.initializer^.pVal;
         if relocs^.initializer^.isName then begin
            code^.lab := relocs^.initializer^.pName;
            code^.pstr := nil;
            end {if}
         else
            code^.pstr := relocs^.initializer^.pstr;
         Gen0(dc_cns);
         lastReloc := relocs;
         relocs := relocs^.next;
         dispose(lastReloc);
         disp := disp + cgPointerSize;
         end; {if}
      end; {while}
   end; {StaticInit}


   procedure GenArrays;

   { define global arrays                                       }

   var
      didOne: boolean;                  {have we found an array yet?}
      i: 0..hashSize;                   {loop variable}
      ip: initializerPtr;               {used to trace initializer lists}
      lval: longint;                    {for converting types}
      size: longint;                    {size of the array}
      sp: identPtr;                     {pointer to a symbol table entry}
      tPtr: typePtr;                    {type of global array/struct/union}
      msg: stringPtr;                   {error message ptr}

   begin {GenArrays}
   didOne := false;
   for i := 0 to hashSize do begin
      sp := table^.buckets[i];
      while sp <> nil do begin
         if sp^.storage in [global,private] then begin
            tPtr := sp^.itype;
            while tPtr^.kind = definedType do
               tPtr := tPtr^.dType;
            if tPtr^.kind in [arrayType,structType,unionType] then begin
               if not didOne then begin
                  if smallMemoryModel then
                     currentSegment := '          '
                  else
                     currentSegment := '~ARRAYS   ';
                  segmentKind := 0;     {this segment is not dynamic!}
                  Gen2Name(dc_str, $4000, 1, @'~ARRAYS');
                  didOne := true;
                  end; {if}
               if sp^.state = initialized then begin
                  Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name);
                  StaticInit(sp);
                  end {if}
               else begin
                  size := sp^.itype^.size;
                  if size = 0 then begin
                     if sp^.itype^.kind = arrayType then begin
                                        {implicitly initialize with one element}
                        size := sp^.itype^.aType^.size;
                        end {if}
                     else begin
                        numErrors := numErrors+1;
                        new(msg);
                        msg^ := concat('The struct or union ''', sp^.name^,
                           ''' has incomplete type that was never completed.');
                        writeln('*** ', msg^);
                        if terminalErrors then begin
                           if enterEditor then
                              ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr))
                           else
                              TermError(0);
                           end; {if}
                        liDCBGS.merrf := 16;
                        end; {else}
                     end; {if}
                  Gen2Name(dc_glb, long(size).lsw & $7FFF,
                     ord(sp^.storage = private), sp^.name);
        	  size := size & $FFFF8000;
        	  while size <> 0 do begin
                     Gen1(dc_dst, 16384);
                     size := size-16384;
                     end; {while}
                  end; {else}
               end; {if}
            end; {if}
         sp := sp^.next;
         end; {while}
      end; {for}
   if didOne then
      Gen0(dc_enp);
   end; {GenArrays}


   procedure GenGlobals;

   { define non-array global variables                          }

   var
      i: 0..hashSize;                   {loop variable}
      ip: initializerPtr;               {used to trace initializer lists}
      lval: longint;                    {for extracting lsw}
      sp: identPtr;                     {pointer to a symbol table entry}

   begin {GenGlobals}
   Gen2t(dc_cns, 0, 1, cgByte);
   for i := 0 to hashSize do begin
      sp := table^.buckets[i];
      while sp <> nil do begin
         if sp^.storage in [global,private] then
            if sp^.itype^.kind in [scalarType,pointerType] then begin
               if sp^.state = initialized then begin
                  Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name);
                  ip := sp^.iPtr;
                  case ip^.basetype of
                     cgByte,cgUByte,cgWord,cgUWord: begin
                        lval := ip^.ival;
                        Gen2t(dc_cns, long(lval).lsw, 1, ip^.basetype);
                        end;
                     cgLong,cgULong:
                        GenL1(dc_cns, ip^.ival, 1);
                     cgQuad,cgUQuad:
                        GenQ1(dc_cns, ip^.qval, 1);
                     cgReal,cgDouble,cgComp,cgExtended:
                        GenR1t(dc_cns, ip^.rval, 1, ip^.basetype);
                     cgString:
                        GenS(dc_cns, ip^.sval);
                     ccPointer: begin
                        code^.optype := ccPointer;
                        code^.q := 1;
                        code^.r := ord(ip^.pPlus);
                        code^.pVal := ip^.pVal;
                        if ip^.isName then begin
                           code^.lab := ip^.pName;
                           code^.pstr := nil;
                           end {if}
                        else
                           code^.pstr := ip^.pstr;
                        Gen0(dc_cns);
                        end;
                     otherwise: Error(57);
                     end; {case}
                  end {if}
               {else if sp^.itype^.size = 0 then begin
                  Error(57);
                  end {else if}
               else
                  Gen2Name(dc_glb, ord(sp^.itype^.size),
                     ord(sp^.storage = private), sp^.name);
               end;
         sp := sp^.next;
         end; {while}
      end; {for}
   end; {GenGlobals}

begin {DoGlobals}
{print the global symbol table}
{if printSymbols then                 {debug}
{   PrintTable(globalTable);          {debug}

FreeTablePool;                          {dispose of unneeded symbol tables}

{declare the ~globals segment, which holds non-array data types}
if smallMemoryModel then
   currentSegment := '          '
else
   currentSegment := '~GLOBALS  ';
segmentKind := 0;                       {this segment is not dynamic!}
Gen2Name(dc_str, $4000, 0, @'~GLOBALS');
GenGlobals;
Gen0(dc_enp);

{declare the ~arrays segment, which holds global arrays}
GenArrays;
end; {DoGlobals}


function FindSymbol {var tk: tokenType; class: spaceType; oneLevel: boolean;
                     staticAllowed: boolean): identPtr};

{ locate a symbol in the symbol table                           }
{                                                               }
{ parameters:                                                   }
{       tk - token record for the identifier to find            }
{       class - the kind of variable space to search            }
{       oneLevel - search one level only? (used to check for    }
{               duplicate symbols)                              }
{       staticAllowed - can we check for static variables?      }
{                                                               }
{ returns:                                                      }
{       A pointer to the symbol table entry is returned.  If    }
{       there is no entry, nil is returned.                     }

label 1,2;

var
   hashDisp: longint;                   {disp into the hash table}
   i: integer;                          {loop variable}
   iHandle: ^identPtr;                  {pointer to start of hash bucket}
   iPtr: identPtr;                      {pointer to the current symbol}
   name: stringPtr;                     {name to search for}
   np: stringPtr;                       {for searching for static variables}
   sPtr: symbolTablePtr;                {^ to current symbol table}

begin {FindSymbol}
{get ready to search}
staticAllowed := staticAllowed and (staticNum <> '~0000');
name := tk.name;                        {use a local variable}
hashDisp := Hash(name);                 {get the disp into the symbol table}
np := nil;                              {no string buffer, yet}

{check for the variable}
2:
sPtr := table;                          {initialize the address of the sym. tbl}
while sPtr <> nil do begin
   iHandle := pointer(hashDisp+ord4(sPtr));
   if class = tagSpace then
      iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
   iPtr := iHandle^;

   {scan the hash bucket for a global or auto variable}
   while iPtr <> nil do begin
      if iPtr^.name^ = name^ then begin
         FindSymbol := iPtr;
         if iPtr^.isForwardDeclared then
            ResolveForwardReference(iPtr);
         tk.symbolPtr := iPtr;
         goto 1;
         end; {if}
      iPtr := iPtr^.next;
      end; {while}

   {rescan for a static variable}
   if staticAllowed and not sPtr^.noStatics then begin
      if np = nil then begin            {form the static name}
         if length(name^) < 251 then begin
            new(np);
            np^[0] := chr(5+length(name^));
            for i := 1 to 5 do
               np^[i] := sPtr^.staticNum[i];
            for i := 1 to length(name^) do
               np^[i+5] := name^[i];
            end; {if}
         end {if}
      else
         for i := 2 to 5 do
            np^[i] := sPtr^.StaticNum[i];

      {scan the hash bucket for the identifier}
      iHandle := pointer(hashDisp+ord4(globalTable));
      if class = tagSpace then
         iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
      iPtr := iHandle^;

      while iPtr <> nil do begin
         if iPtr^.name^ = np^ then begin
            FindSymbol := iPtr;
            if iPtr^.isForwardDeclared then
               ResolveForwardReference(iPtr);
            tk.symbolPtr := iPtr;
            goto 1;
            end; {if}
         iPtr := iPtr^.next;
         end; {while}
      end; {if staticAllowed}

   if oneLevel then
      sPtr := nil
   else
      sPtr := sPtr^.next;
   end; {while}

{we only get here if a symbol was not found}
if class = allSpaces then begin
   class := tagSpace;
   goto 2;
   end; {if}
FindSymbol := nil;

1:
if np <> nil then
   dispose(np);
end; {FindSymbol}


procedure GenParameters {pp: parameterPtr};

{ Generate labels and space for the parameters                  }
{								}
{ parameters:							}
{    pp - pointer to first parameter				}
{                                                               }
{ variables:                                                    }
{     lastParameterLLN - label number of last parameter         }
{     lastParameterSize - size of last parameter                }

var
   i: 0..hashSize;                      {loop variable}
   pln: integer;			{label number}
   size: integer;                       {size of the parameter}
   sp: identPtr;			{symbol pointer}
   tk: tokenType;			{symbol name token}
   first: boolean;                      {first iteration of loop over params?}

begin {GenParameters}
first := true;
if pp <> nil then begin			{prototyped parameters}
   tk.kind := ident;
   tk.numString := nil;
   tk.class := identifier;
   while pp <> nil do begin
      pln := GetLocalLabel;
      tk.name := pp^.parameter^.name;
      tk.symbolPtr := nil;
      sp := FindSymbol(tk, variableSpace, true, false);
      if sp = nil then
         sp := pp^.parameter;
      if sp^.itype^.kind = arrayType then begin
         size := cgPointerSize;
         Gen3(dc_prm, pln, cgPointerSize, sp^.pdisp);
         end {if}
      else begin
	 size := long(sp^.itype^.size).lsw;
	 if (size = 1) and (sp^.itype^.kind = scalarType) then
            size := 2;
	 if sp^.itype^.kind = scalarType then
            if sp^.itype^.baseType in [cgReal,cgDouble,cgComp] then begin
               {convert floating-point parameters to declared type}
               Gen1t(pc_fix, pln, sp^.itype^.baseType);
               size := cgExtendedSize;
               end; {if}
	 Gen3(dc_prm, pln, size, sp^.pdisp);
	 end; {else}
      sp^.pln := pln;
      if first then begin
         first := false;
         lastParameterLLN := pln;
         lastParameterSize := size;
         end; {if}
      pp := pp^.next;
      end; {while}
   end {if}
else begin				{K&R parameters}
   for i := 0 to hashSize do begin              
      sp := table^.buckets[i];
      while sp <> nil do begin
	 if sp^.storage = parameter then begin
            pln := GetLocalLabel;
            sp^.pln := pln;
            if sp^.itype^.kind = arrayType then begin
               size := cgPointerSize;
               Gen3(dc_prm, sp^.lln, cgPointerSize, sp^.pdisp);
               end {if}
            else begin
               size := long(sp^.itype^.size).lsw;
               if (size = 1) and (sp^.itype^.kind = scalarType) then
        	  size := 2;
               if sp^.itype^.kind = scalarType then
                  if sp^.itype^.baseType in [cgReal,cgDouble,cgComp] then begin
                     {convert floating-point parameters to declared type}
                     Gen1t(pc_fix, pln, sp^.itype^.baseType);
                     size := cgExtendedSize;
                     end; {if}
               Gen3(dc_prm, sp^.lln, size, sp^.pdisp);
               end; {else}
            if first then begin
               first := false;
               lastParameterLLN := pln;
               lastParameterSize := size;
               end; {if}
            end; {if}
	 sp := sp^.next;
	 end; {while}
      end; {for}
   if first then begin
      lastParameterLLN := 0;
      lastParameterSize := 0;
      end; {if}
   end; {else}
end; {GenParameters}


procedure GenSymbols {sym: symbolTablePtr; doGlobals: boolean};

{ generate a symbol table for the debugger                      }
{                                                               }
{ parameters:                                                   }
{       sym - symbol table to generate                          }
{       doGlobals - include global symbols in the table         }
{                                                               }
{ outputs:                                                      }
{       symLength - length of debug symbol table                }

const
   noDisp = -1;				{disp returned by GetTypeDisp if the type was not found}

type
   tpPtr = ^tpRecord;			{type list displacements}
   tpRecord = record
      next: tpPtr;
      tp: typePtr;
      disp: integer;
      end;

var
   i: 0..hashSize;			{loop/index variable}
   ip: identPtr;			{used to trace identifier lists}
   tpList,tp2: tpPtr;			{type displacement list}


   function GetTypeDisp (tp: typePtr): integer;

   { Look for an existing entry for this type			}
   {								}
   { Parameters:						}
   {    tp - type to look for					}
   {								}
   { Returns: Disp to a variable of the same type, or noDisp if	}
   {    there is no such entry.					}
   {								}
   { Notes: If the type is not in the type list, it is entered	}
   {   in the list by this call.				}

   var
      tp1, tp2: tpPtr;			{used to manipulate type list}

   begin {GetTypeDisp}
   tp1 := tpList;			{look for the type}
   tp2 := nil;
   while tp1 <> nil do 
      if tp1^.tp = tp then begin
         tp2 := tp1;
         tp1 := nil;
         end {if}
      else
         tp1 := tp1^.next;
   if tp2 <> nil then            
      GetTypeDisp := tp2^.disp		{return disp to entry}
   else begin
      GetTypeDisp := noDisp;		{no entry}
      new(tp1);				{create a new entry}
      tp1^.next := tpList;
      tpList := tp1;
      tp1^.tp := tp;
      tp1^.disp := symLength-12;
      end; {else}
   end; {GetTypeDisp}


   procedure GenSymbol (ip: identPtr; storage: storageType);

   { Generate a single symbol or struct field			}
   {								}
   { parameters:						}
   {    ip - identifier to generate				}
   {    storage - storage type; none for struct/union fields	}

   var
      disp: integer;			{disp to symbol of same type}
      tPtr: typePtr;


      procedure WriteAddress (ip: identPtr);

      { Write the address and DP flag				}
      {								}
      { parameters:						}
      {    ip - identifier					}

      var
         size: longint;			{used to break apart longints}

      begin {WriteAddress}
      if storage in [external,global,private] then begin
         RefName(ip^.name, 0, 4, 0);
         CnOut(1);
         end {if}
      else if storage = none then begin
         size := ip^.disp;
         CnOut2(long(size).lsw);
         CnOut2(long(size).msw);
         CnOut(ord(ip^.next <> nil));
         end {else if}
      else begin
         CnOut2(LabelToDisp(ip^.lln));
         CnOut2(0);
         CnOut(0);
         end; {else}
      end; {WriteAddress}


      procedure WriteName (ip: identPtr);

      { Write the name field for an identifier			}
      {								}
      { parameters:						}
      {    ip - identifier					}

      var
         len: 0..maxint;		{string length}
         j: 0..maxint;			{loop/index variable}

      begin {WriteName}
      Purge;				{generate the address of the variable  }
      Out(235); Out(4);			{ name                                 }
      LabelSearch(maxLabel, 4, 0, 0);
      if stringsize <> 0 then begin
         Out(129);
         Out2(stringsize); Out2(0);
         Out(1);
         end; {if}
      Out(0);
      len := length(ip^.name^);		{place the name in the string buffer}
      if maxstring-stringsize >= len+1 then begin
         stringspace^[stringsize+1] := chr(len);
         for j := 1 to len do
            stringspace^[j+stringsize+1] := ip^.name^[j];
         stringsize := stringsize+len+1;
         end {if}
      else
         Error(60);
      end; {WriteName}


      procedure WriteScalarType (tp: typePtr; modifiers, subscripts: integer);

      { Write a scalar type and subscript field			}
      {								}
      { parameters:						}
      {    tp - type pointer					}
      {    modifiers - value to or with the type code		}
      {    subscripts - number of subscripts			}

      var
         val: integer;			{type value}

      begin {WriteScalarType}
      case tp^.baseType of
	 cgByte:	val := $40;
         cgUByte:	val := $00;
         cgWord:	if tp^.cType = ctBool then
                	   val := $09
                	else
                	   val := $01;
         cgUWord:	val := $41;
         cgLong:	val := $02;
         cgULong:	val := $42;
         cgReal:	val := $03;
         cgDouble:	val := $04;
         cgComp:	val := $0A;
         cgExtended:	val := $05;
         cgQuad:	val := $0A; {same as comp}
         cgUQuad:	val := $4A;
         otherwise:	val := $01;
         end; {case}
      CnOut(val | modifiers);		{write the format byte}
      CnOut2(subscripts);		{write the # of subscripts}
      end; {WriteScalarType}


      procedure WritePointerType (tp: typePtr; subscripts: integer);

      { write a pointer type field				}
      {								}
      { parameters:						}
      {    tp - pointer type					}
      {    subscripts - number of subscript fields		}

      begin {WritePointerType}
      tp := tp^.ptype;
      while tp^.kind = definedType do
         tp := tp^.dType;
      case tp^.kind of
         scalarType:	WriteScalarType(tp, $80, subscripts);
         enumType,
         functionType:  WriteScalarType(intPtr, $80, subscripts);
         otherwise:	begin
        		CnOut(11);
        		CnOut2(subscripts);
                        end;
         end; {case}
      end; {WritePointerType}


      procedure ExpandPointerType (tp: typePtr); forward;
      

      procedure ExpandStructType (tp: typePtr);

      { write the type entries for a struct or union		}
      {								}
      { parameters:						}
      {    tp - struct/union type				}

      var
         ip: identPtr;			{used to trace the field list}

      begin {ExpandStructType}
      ip := tp^.fieldList;
      { fieldList is nil if this is a forward declared struct. }
      if ip = nil then ip := defaultStruct^.fieldList;

      while ip <> nil do begin
         if ip^.name^[1] <> '~' then
            GenSymbol(ip, none);
         ip := ip^.next;
         end; {while}
      end; {ExpandStructType}


      procedure WriteArrays (tp: typePtr);

      { handle an array type					}
      {								}
      { parameters:						}
      {    tp - array type					}

      var
         count: 0..maxint;		{# of subscripts}
         size: longint;			{for converting long numbers}
         tp2: typePtr;			{used to trace array type list}

      begin {WriteArrays}
      count := 0;			{count the subscripts}
      tp2 := tp;
      while tp2^.kind = arrayType do begin
         count := count+1;
         tp2 := tp2^.aType;
         end; {while}
      while tp2^.kind = definedType do
         tp2 := tp2^.dType;         
      if tp2^.kind = scalarType then	{write the type code}
         if tp2^.baseType in [cgByte,cgUByte] then begin
            count := count-1;
            CnOut(6);
            CnOut2(count);
            end {if}
         else
            WriteScalarType(tp2, 0, count)
      else if tp2^.kind = enumType then
         WriteScalarType(intPtr, 0, count)
      else if tp2^.kind = pointerType then
         WritePointerType(tp2, count)
      else begin
         CnOut(12);
         CnOut2(count);
         end; {else if}
      while count <> 0 do begin		{write the subscript entries}
         CnOut2(0); CnOut2(0);
         if tp^.elements = 0 then
            size := $00FFFFFF
         else
            size := tp^.elements-1;
         CnOut2(long(size).lsw); CnOut2(long(size).msw);
         size := tp^.aType^.size;
         CnOut2(long(size).lsw); CnOut2(long(size).msw);
         symLength := symLength+12;
         tp := tp^.aType;
         count := count-1;
         end; {while}
      if tp2^.kind = pointerType then	{expand complex types}
         ExpandPointerType(tp2)
      else if tp2^.kind in [structtype,uniontype] then
         ExpandStructType(tp2);
      end; {WriteArrays}


      procedure ExpandPointerType {tp: typePtr};

      { write the type entries for complex pointer types	}
      {								}
      { parameters:						}
      {    tp - pointer type					}

      var
	 disp: integer;			{disp to symbol of same type}

      begin {ExpandPointerType}
      tp := tp^.ptype;
      while tp^.kind = definedType do
         tp := tp^.dType;
      if tp^.kind in [pointerType,arrayType,structType,unionType] then
         begin
         symLength := symLength+12;
         CnOut2(0); CnOut2(0);
         CnOut2(0); CnOut2(0);
         CnOut(0);
	 case tp^.kind of
            pointerType:	begin
         		   	WritePointerType(tp, 0);
                           	ExpandPointerType(tp);
                           	end;
            arrayType:		WriteArrays(tp);
            structType,
            unionType:		begin
				disp := GetTypeDisp(tp);
                                if disp = noDisp then begin
        		   	   CnOut(12);
        		   	   CnOut2(0);
                           	   ExpandStructType(tp);
                                   end {if}
                                else begin
        		   	   CnOut(13);
        		   	   CnOut2(disp);
                                   end; {else}
                           	end;
            end; {case}
         end; {if}
      end; {ExpandPointerType}


   begin {GenSymbol}
   tPtr := ip^.itype;
   while tPtr^.kind = definedType do
      tPtr := tPtr^.dType;
   if tPtr^.kind in
      [scalarType,arrayType,pointerType,enumType,structType,unionType]
      then begin
      symLength := symLength+12;        {update length of symbol table}
      WriteName(ip);			{write the name field}
      WriteAddress(ip);			{write the address field}
      case tPtr^.kind of
         scalarType:	WriteScalarType(tPtr, 0, 0);
         enumType:	WriteScalarType(intPtr, 0, 0);
         pointerType:	begin
         		WritePointerType(tPtr, 0);
                        ExpandPointerType(tPtr);
                        end;
         arrayType:	WriteArrays(tPtr);
         structType,
         unionType:	begin
			disp := GetTypeDisp(tPtr);
                        if disp = noDisp then begin
        		   CnOut(12);
        		   CnOut2(0);
                           ExpandStructType(tPtr);
                           end {if}
                        else begin
        		   CnOut(13);
        		   CnOut2(disp);
                           end; {else}
                        end;
         end; {case}
      end; {if}
   end; {GenSymbol}


begin {GenSymbols}
tpList := nil;				{no types so far}
if sym <> nil then
   for i := 0 to hashSize do begin      {loop over all hash buckets}
      ip := sym^.buckets[i];            {trace through all symbols in this bucket}
      while ip <> nil do begin
         if ip^.storage <> none then
            GenSymbol(ip, ip^.storage);
         ip := ip^.next;                {next symbol}
         end; {while}
      end; {for}
while tpList <> nil do begin		{dispose of type list}
   tp2 := tpList;
   tpList := tp2^.next;
   dispose(tp2);
   end; {while}
if doGlobals then			{do globals}
   GenSymbols(globalTable, false);
end; {GenSymbols}


procedure InitSymbol;

{ Initialize the symbol table module                            }

var
   i: 0..hashSize;                      {loop variable}

begin {InitSymbol}
staticNum := '~0000';                   {no functions processed}
table := nil;                           {initialize the global symbol table}
tablePool := nil;                       {table pool is initially empty}
tablePoolSize := 0;
tablePoolMaxSize := ord(MaxBlock div 150000); {limit size of pool based on RAM}
PushTable;
globalTable := table;
globalTable^.isEmpty := false;          {global table is never treated as empty}
functionTable := nil;
                                        {declare base types}
new(sCharPtr);                          {signed char}
with sCharPtr^ do begin
   size := cgByteSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgByte;
   cType := ctSChar;
   end; {with}
new(charPtr);                           {char}
with charPtr^ do begin
   size := cgByteSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgUByte;
   cType := ctChar;
   end; {with}
new(uCharPtr);                          {unsigned char}
with uCharPtr^ do begin
   size := cgByteSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgUByte;
   cType := ctUChar;
   end; {with}
new(shortPtr);                          {short}
with shortPtr^ do begin
   size := cgWordSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgWord;
   cType := ctShort;
   end; {with}
new(uShortPtr);                         {unsigned short}
with uShortPtr^ do begin
   size := cgWordSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgUWord;
   cType := ctUShort;
   end; {with}
new(intPtr);                            {int}
with intPtr^ do begin
   size := cgWordSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgWord;
   cType := ctInt;
   end; {with}
new(uIntPtr);                           {unsigned int}
with uIntPtr^ do begin
   size := cgWordSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgUWord;
   cType := ctUInt;
   end; {with}
new(int32Ptr);                          {int (32-bit)}
with int32Ptr^ do begin
   size := cgLongSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgLong;
   cType := ctInt32;
   end; {with}
new(uInt32Ptr);                         {unsigned int (32-bit)}
with uInt32Ptr^ do begin
   size := cgLongSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgULong;
   cType := ctUInt32;
   end; {with}
new(longPtr);                           {long}
with longPtr^ do begin
   size := cgLongSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgLong;
   cType := ctLong;
   end; {with}
new(uLongPtr);                          {unsigned long}
with uLongPtr^ do begin
   size := cgLongSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgULong;
   cType := ctULong;
   end; {with}
new(longLongPtr);                       {long long}
with longLongPtr^ do begin
   size := cgQuadSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgQuad;
   cType := ctLongLong;
   end; {with}
new(uLongLongPtr);                      {unsigned long long}
with uLongLongPtr^ do begin
   size := cgQuadSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgUQuad;
   cType := ctULongLong;
   end; {with}
new(floatPtr);                          {real}
with floatPtr^ do begin
   size := cgRealSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgReal;
   cType := ctFloat;
   end; {with}
new(doublePtr);                         {double}
with doublePtr^ do begin
   size := cgDoubleSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgDouble;
   cType := ctDouble;
   end; {with}
new(compPtr);                           {comp}
with compPtr^ do begin
   size := cgCompSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgComp;
   cType := ctComp;
   end; {with}
new(extendedPtr);                       {extended, aka long double}
with extendedPtr^ do begin
   size := cgExtendedSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgExtended;
   cType := ctLongDouble;
   end; {with}
new(boolPtr);                           {_Bool}
with boolPtr^ do begin
   size := cgWordSize;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgWord;
   cType := ctBool;
   end; {with}
new(stringTypePtr);                     {string constant type}
with stringTypePtr^ do begin
   size := 0;
   saveDisp := 0;
   qualifiers := [];
   kind := arrayType;
   aType := charPtr;
   elements := 0;
   end; {with}
new(utf16StringTypePtr);                {UTF-16 string constant type}
with utf16StringTypePtr^ do begin
   size := 0;
   saveDisp := 0;
   qualifiers := [];
   kind := arrayType;
   aType := uShortPtr;
   elements := 0;
   end; {with}
new(utf32StringTypePtr);                {UTF-32 string constant type}
with utf32StringTypePtr^ do begin
   size := 0;
   saveDisp := 0;
   qualifiers := [];
   kind := arrayType;
   aType := uLongPtr;
   elements := 0;
   end; {with}
new(voidPtr);                           {void}
with voidPtr^ do begin
   size := 0;
   saveDisp := 0;
   qualifiers := [];
   kind := scalarType;
   baseType := cgVoid;
   cType := ctVoid;
   end; {with}
new(voidPtrPtr);                        {typeless pointer}
with voidPtrPtr^ do begin
   size := cgPointerSize;
   saveDisp := 0;
   qualifiers := [];
   kind := pointerType;
   pType := voidPtr;
   end; {with}
new(charPtrPtr);                        {char *}
with charPtrPtr^ do begin
   size := cgPointerSize;
   saveDisp := 0;
   qualifiers := [];
   kind := pointerType;
   pType := charPtr;
   end; {with}
new(vaInfoPtr);                         {internal varargs info type (char*[2])}
with vaInfoPtr^ do begin
   size := cgPointerSize*2;
   saveDisp := 0;
   qualifiers := [];
   kind := arrayType;
   aType := charPtrPtr;
   elements := 2;
   end; {with}
new(defaultStruct);                     {default structure}
with defaultStruct^ do begin            {(for structures with errors)}
   size := cgWordSize;
   saveDisp := 0;
   qualifiers := [];
   kind := structType;
   sName := nil;
   constMember := false;
   flexibleArrayMember := false;
   new(fieldList);
   with fieldlist^ do begin
      next := nil;
      name := @'field';
      itype := intPtr;
      class := ident;
      state := declared;
      disp := 0;
      bitdisp := 0;
      end; {with}
   end; {with}
new(constCharPtr);                      {const char}
constCharPtr^ := charPtr^;
constCharPtr^.qualifiers := [tqConst];
end; {InitSymbol}


function IsVoid {tp: typePtr): boolean};

{ Check to see if a type is void                                }
{                                                               }
{ Parameters:                                                   }
{    tp - type to check                                         }
{                                                               }
{ Returns: True if the type is void, else false                 }

begin {IsVoid}
IsVoid := false;
if tp = voidPtr then
   IsVoid := true
else if tp^.kind = scalarType then
   if tp^.baseType = cgVoid then
      IsVoid := true;
end; {IsVoid}


function CopyType (tp: typePtr): typePtr;

{ Make a new copy of a type, so it can be modified.             }
{                                                               }
{ Parameters:                                                   }
{    tp - type to copy                                          }
{                                                               }
{ Returns: The new copy of the type                             }

var
   tType: typePtr;                      {the new copy of the type}
   p1,p2: parameterPtr;                 {parameter ptrs for copying prototypes}
   pPtr: ^parameterPtr;                 {temp for copying prototypes}

begin {CopyType}
if tp^.kind in [structType,unionType] then
   Error(57);
tType := pointer(Malloc(sizeof(typeRecord)));
tType^ := tp^;                          {copy type record}
tType^.saveDisp := 0;
if tp^.kind = functionType then         {copy prototype parameter list}
   if tp^.prototyped then begin
      p1 := tp^.parameterList;
      pPtr := @tType^.parameterList;
      while p1 <> nil do begin
         p2 := pointer(Malloc(sizeof(parameterRecord)));
         p2^ := p1^;
         pPtr^ := p2;
         pPtr := @p2^.next;
         p1 := p1^.next;
         end; {while}
      end; {if}
CopyType := tType;
end; {CopyType}


function MakeCompositeType {t1, t2: typePtr): typePtr};

{ Make the composite type of two compatible types.              }
{ See C17 section 6.2.7.                                        }
{                                                               }
{ parameters:                                                   }
{       t1,t2 - the input types (should be compatible)          }
{                                                               }
{ returns: pointer to the composite type                        }

var
   compType: typePtr;                   {the composite type}
   tType: typePtr;                      {temp type}
   p1,p2: parameterPtr;                 {parameter ptrs for handling prototypes}

begin {MakeCompositeType}
compType := t2;                         {default to t2}
if t1 <> t2 then
   if t1^.kind = t2^.kind then begin
      if t2^.kind = functionType then   {switch fn types if only t1 is prototyped}
         if not t2^.prototyped then
            if t1^.prototyped then begin
               compType := t1;
               t1 := t2;
               t2 := compType;
               end; {if}
                                        {apply recursively for derived types}
      if t2^.kind in [arrayType,pointerType,functionType] then begin
            tType := MakeCompositeType(t1^.aType,t2^.aType);
            if tType <> t2^.aType then begin
               compType := CopyType(compType);
               compType^.aType := tType;
               end; {if}
         end; {if}
      if t2^.kind = arrayType then      {get array size from t1 if needed}
         if t2^.size = 0 then
            if t1^.size <> 0 then
               if t1^.aType^.size = t2^.aType^.size then begin
                  if compType = t2 then
                     compType := CopyType(t2);
                  CompType^.size := t1^.size;
                  CompType^.elements := t1^.elements;
                  end; {if}
      if t2^.kind = functionType then   {compose function parameter types}
         if t1^.prototyped and t2^.prototyped then begin
            if compType = t2 then
               compType := CopyType(t2);
            p1 := t1^.parameterList;
            p2 := compType^.parameterList;
            while (p1 <> nil) and (p2 <> nil) do begin
               p2^.parameterType :=
                  MakeCompositeType(p1^.parameterType,p2^.parameterType);
               p1 := p1^.next;
               p2 := p2^.next;
               end; {while}
            end;
      end; {if}
MakeCompositeType := compType;
end; {MakeCompositeType}


function MakePascalType {origType: typePtr): typePtr};

{ make a version of a type with the pascal qualifier applied    }
{                                                               }
{ parameters:                                                   }
{       origType - the original type                            }
{                                                               }
{ returns: pointer to the pascal-qualified type                 }

var
   pascalType: typePtr;                 {the modified type}
   tp,tp2: typePtr;                     {work pointers}
   p1,p2,p3: parameterPtr;              {for reversing prototyped parameters}

begin {MakePascalType}
pascalType := pointer(Malloc(sizeof(typeRecord)));
pascalType^ := origType^;
MakePascalType := pascalType;
tp := pascalType;
while tp <> nil do
   case tp^.kind of
      arrayType,
      pointerType:  begin
                    tp2 := pointer(Malloc(sizeof(typeRecord)));
                    tp2^ := tp^.pType^;
                    tp^.pType := tp2;
                    tp := tp2;
                    end;
      functionType: begin
                    if not tp^.isPascal then begin
                       {reverse the parameter list}
                       p1 := tp^.parameterList;
                       if p1 <> nil then begin
                          p2 := nil;
                          while p1 <> nil do begin
                             p3 := pointer(Malloc(sizeof(parameterRecord)));
                             p3^ := p1^;
                             p1 := p1^.next;
                             p3^.next := p2;
                             p2 := p3;
                             end; {while}
                          tp^.parameterList := p2;
                          end; {if}
                       tp^.isPascal := true;
                       end; {if}
                    tp := nil;
                    end;
      otherwise:    begin
                    Error(94);
                    MakePascalType := origType;
                    tp := nil;
                    end;
      end; {case}
end; {MakePascalType}


function MakePointerTo {pType: typePtr): typePtr};

{ make a pointer type                                           }
{                                                               }
{ parameters:                                                   }
{       pType - the type pointed to                             }
{                                                               }
{ returns: the pointer type                                     }

var
   tp: typePtr;                         {the pointer type}


begin {MakePointerTo}
tp := pointer(Malloc(sizeof(typeRecord)));
tp^.size := cgPointerSize;
tp^.saveDisp := 0;
tp^.qualifiers := [];
tp^.kind := pointerType;
tp^.pType := pType;
MakePointerTo := tp;
end; {MakePointerTo}


function MakeQualifiedType {origType: typePtr; qualifiers: typeQualifierSet):
   typePtr};

{ make a qualified version of a type                            }
{                                                               }
{ parameters:                                                   }
{       origType - the original type                            }
{       qualifiers - the type qualifier(s) to add               }
{                                                               }
{ returns: pointer to the qualified type                        }

var
   tp: typePtr;                         {the qualified type}
   elemType: typePtr;                   {array element type}

begin {MakeQualifiedType}
if qualifiers <> [] then begin          {make qualified version of type}
   tp := pointer(Malloc(sizeof(typeRecord)));
   if origType^.kind in [structType,unionType] then begin
      tp^.size := origType^.size;
      tp^.kind := definedType;
      tp^.dType := origType;
      tp^.saveDisp := 0;
      tp^.qualifiers := qualifiers;
      end {if}
   else begin
      tp^ := origType^;
      tp^.qualifiers := tp^.qualifiers + qualifiers;
      end; {else}
   MakeQualifiedType := tp;
                                        {move array type quals to element type}
   while tp^.kind = arrayType do begin
      elemType := pointer(Malloc(sizeof(typeRecord)));
      if tp^.aType^.kind in [structType,unionType] then begin
         elemType^.size := tp^.aType^.size;
         elemType^.kind := definedType;
         elemType^.dType := tp^.aType;
         elemType^.saveDisp := 0;
         elemType^.qualifiers := qualifiers;
         end {if}
      else begin
         elemType^ := tp^.aType^;
         elemType^.qualifiers := elemType^.qualifiers + qualifiers;
         end; {else}
      tp^.aType := elemType;
      tp^.qualifiers := [];             {remove for C23}
      tp := elemType;
      end; {if}
   end {if}
else
   MakeQualifiedType := origType;
end; {MakeQualifiedType}


function Unqualify {tp: typePtr): typePtr};

{ returns the unqualified version of a type                     }
{                                                               }
{ parameters:                                                   }
{       tp - the original type                                  }
{                                                               }
{ returns: pointer to the unqualified type                      }

var
   tp2: typePtr;                        {unqualified type}

begin {Unqualify}
while tp^.kind = definedType do
   tp := tp^.dType;
Unqualify := tp;
if tp^.qualifiers <> [] then
   if not (tp^.kind in [structType,unionType]) then begin
      tp2 := pointer(Malloc(sizeof(typeRecord)));
      tp2^ := tp^;
      tp2^.qualifiers := [];
      Unqualify := tp2;
      end;
end; {Unqualify}


function NewSymbol {name: stringPtr; itype: typePtr; class: tokenEnum;
                   space: spaceType; state: stateKind; isInline: boolean):
                   identPtr};

{ insert a new symbol in the symbol table                       }
{                                                               }
{ parameters:                                                   }
{       name - pointer to the symbol name                       }
{       itype - pointer to the symbol type                      }
{       class - storage class                                   }
{       space - the kind of variable space to put the           }
{               identifier in                                   }
{       state - variable declaration state                      }
{                                                               }
{ returns: pointer to the inserted symbol                       }

var
   cs: identPtr;                        {current symbol}
   hashPtr: ^identPtr;                  {pointer to hash bucket in symbol table}
   i: integer;                          {loop variable}
   isFunction: boolean;                 {is this the symbol for a function?}
   isGlobal: boolean;                   {are we using the global table?}
   lUseGlobalPool: boolean;             {use the global symbol pool?}
   needSymbol: boolean;                 {do we need to declare it?}
   np: stringPtr;                       {for forming static name}
   p: identPtr;                         {work pointer}
   tk: tokenType;                       {fake token; for FindSymbol}


   procedure AllocateStaticNum;
   
   { Allocate a staticNum value for the current table.          }
   
   var
   done: boolean;                       {loop termination}
      i: integer;                       {loop index}
   
   begin {AllocateStaticNum}
   i := 5;                              {increment the static var number}
   repeat
      staticNum[i] := succ(staticNum[i]);
      done := staticNum[i] <> succ('9');
      if not done then begin
         staticNum[i] := '0';
         i := i-1;
         done := i = 1;
         end; {if}
   until done;
   table^.staticNum := staticNum;       {record the static symbol table number}
   end; {AllocateStaticNum}


   procedure UnInline;

   { Generate a non-inline definition for a function previously }
   { defined with an (apparent) inline definition.              }
   
   var
      fName: stringPtr;                 {name of function}
      i: integer;                       {loop variable}
   
   begin {UnInline}
   if cs^.iType^.isPascal then begin
      fName := pointer(Malloc(length(name^)+1));
      CopyString(pointer(fName), pointer(name));
      for i := 1 to length(fName^) do
         if fName^[i] in ['a'..'z'] then
            fName^[i] := chr(ord(fName^[i]) & $5F);
      end {if}
   else
      fName := name;
   Gen2Name(dc_str, 0, 0, fName);
   code^.s := m_jml;
   code^.q := 0;
   code^.r := ord(longabsolute);
   new(code^.lab);
   code^.lab^ := concat('~inline~',name^);
   Gen0(pc_nat);
   Gen0(dc_enp);
   end; {UnInline}


begin {NewSymbol}
needSymbol := true;                     {assume we need a symbol}
isGlobal := false;                      {set up defaults}
isFunction := false;
lUseGlobalPool := useGlobalPool;
tk.name := name;
tk.symbolPtr := nil;
if space <> fieldListSpace then begin   {are we defining a function?}
   if (itype <> nil) and (itype^.kind = functionType) then begin
      isFunction := true;
      if class in [autosy, ident] then
         class := externsy
      else                              {If explicit storage class is given,}
         isInline := false;             {this is not an inline definition.  }
      end {if}
   else if (itype <> nil) and (itype^.kind in [structType,unionType])
      and (itype^.fieldList = nil) and doingParameters then begin
      useGlobalPool := true;
      end; {else if}
   cs := FindSymbol(tk, space, true, true); {check for duplicates}
   if cs <> nil then begin
      if ((itype = nil)
         or (cs^.itype = nil)
         or (not CompTypes(cs^.itype, itype))
         or ((cs^.state = initialized) and (state = initialized))
         or ((class = typedefsy) <> (cs^.class = typedefsy))
         or ((globalTable <> table) 
            and (not (class in [externsy,typedefsy])
               or not (cs^.class in [externsy,typedefsy]))))
         and ((not doingParameters) or (cs^.state <> declared))
         then
         Error(42)
      else begin
         itype := MakeCompositeType(cs^.itype, itype);
         if class = externsy then
            if cs^.class = staticsy then
               class := staticsy;
         if cs^.storage = external then
            if isInline then
               isInline := cs^.inlineDefinition
            else if cs^.inlineDefinition then
               if iType^.kind = functionType then
                  if cs^.state = defined then
                     if table = globalTable then
                        UnInline;
         p := cs;
         needSymbol := false;
         end; {else}
      end {if}
   else if class = externsy then        {check for outer decl of same object/fn}
      if table <> globalTable then begin
         cs := FindSymbol(tk, space, false, true);
         if cs <> nil then
            if cs^.name^[1] <> '~' then {exclude block-scope statics}
               if cs^.storage in [global,external,private] then begin
                  if not CompTypes(cs^.itype, itype) then
                     Error(47);
                  itype := MakeCompositeType(cs^.itype, itype);
                  end; {if}
         end; {if}
   end; {if}
if needSymbol then begin
   if class = staticsy then             {statics go in the global symbol table}
      if not isFunction then
         if globalTable <> table then begin
            isGlobal := true;           {note that we will use the global table}
            useGlobalPool := true;
            if table^.noStatics then begin
               table^.noStatics := false;
               AllocateStaticNum;
               end; {if}
            np := pointer(GMalloc(length(name^)+6)); {form static name}
            np^[0] := chr(5+length(name^));
            for i := 1 to 5 do
               np^[i] := table^.staticNum[i];
            for i := 1 to length(name^) do
               np^[i+5] := name^[i];
            name := np;
            end; {if}
   p := pointer(Calloc(sizeof(identRecord))); {get space for the record}
   {p^.iPtr := nil;}                    {no initializers, yet}
   {p^.saved := 0;}			{not saved}
   p^.state := state;                   {set the state}
   {p^.isForwardDeclared := false;}     {assume no forward declarations are used}
   p^.name := name;                     {record the name}
   {p^.next := nil;}
   {p^.used := false;}                  {unused for now}
   if space <> fieldListSpace then      {insert the symbol in the hash bucket}
      begin
      if (itype = nil) or not isGlobal then begin
         hashPtr := pointer(ord4(table)+Hash(name));
         table^.isEmpty := false;
         end {if}
      else
         hashPtr := pointer(ord4(globalTable)+Hash(name));
      if space = tagSpace then
         hashPtr := pointer(ord4(hashPtr) + 4*(hashSize+1));
      p^.next := hashPtr^;
      hashPtr^ := p;
      end; {if}
   end; {if}
if space = fieldListSpace then          {check and set the storage class}
   p^.storage := none
else if class in [autosy,registersy] then
   begin
   if doingFunction or doingParameters then begin
      p^.storage := stackFrame;
      class := ident;
      end {if}
   else begin
      p^.storage := global;
      Error(62);
      end; {else}
   end {if}
else if class = ident then begin
   if doingFunction then begin
      p^.storage := stackFrame;
      class := autosy;
      end {if}
   else
      p^.storage := global;
   end {else if}
else if class = externsy then begin
   p^.storage := external;
   p^.inlineDefinition := isInline;
   end {else if}
else if class = staticsy then
   p^.storage := private
else
   p^.storage := none;
p^.class := class;
p^.itype := itype;                      {set the symbol field values}
NewSymbol := p;                         {return a pointer to the new entry}
useGlobalPool := lUseGlobalPool;        {restore the useGlobalPool variable}
end; {NewSymbol}


procedure PopTable;

{ Pop a symbol table (remove definitions local to a block)      }

var
   tPtr: symbolTablePtr;                {work pointer}

begin {PopTable}
tPtr := table;
{if printSymbols then                 {debug}
{   PrintTable(tPtr);                 {debug}
if (lint & lintUnused) <> 0 then
   CheckUnused(tPtr);
if tPtr^.next <> nil then begin
   table := table^.next;
   if not tPtr^.isEmpty then begin
      dispose(tPtr);
      if token.kind = ident then
         if FindSymbol(token,variableSpace,false,false) <> nil then
            if token.symbolPtr^.class = typedefsy then
               token.kind := typedef;
      end {if}
   else if (tablePoolSize = tablePoolMaxSize) then
      dispose(tPtr)
   else begin
      tPtr^.next := tablePool;
      tablePool := tPtr;
      tablePoolSize := tablePoolSize + 1;
      end; {else}
   end; {if}
end; {PopTable}


{ copy 'symbol.print'} {debug}


procedure PushTable;

{ Create a new symbol table, pushing the old one                }

var
   tPtr: symbolTablePtr;                {work pointer}

begin {PushTable}
if tablePool <> nil then begin          {use existing empty table if available}
   tPtr := tablePool;
   tablePool := tPtr^.next;
   tablePoolSize := tablePoolSize - 1;
   end {if}
else begin
   new(tPtr);                           {...or create a new symbol table}
   ClearTable(tPtr^);
   tPtr^.isEmpty := true;
   end; {else}
tPtr^.next := table;
table := tPtr;
tPtr^.noStatics := true;
end; {PushTable}


procedure ResolveForwardReference {iPtr: identPtr};

{ resolve a forward reference                                   }
{                                                               }
{ parameters:                                                   }
{       iPtr - ptr to the forward declared identifier           }

var
   fl: identPtr;			{for tracing field lists}
   ltk: tokenType;                      {for searching for forward refs}
   sym: identPtr;                       {for finding forward refs}
   lPtr,tPtr: typePtr;                  {for tracing forward declared types}

begin {ResolveForwardReference}
iPtr^.isForwardDeclared := false;	{we will succeed or flag an error...}
tPtr := iPtr^.itype;			{skip to the struct/union type}
lPtr := nil;
while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do begin
   lPtr := tPtr;
   tPtr := tPtr^.pType;
   end;
if tPtr^.sName <> nil then begin	{resolve the forward reference}
   ltk.name := tPtr^.sName;
   ltk.symbolPtr := nil;
   sym := FindSymbol(ltk,tagSpace,false,true);
   if sym <> nil then begin
      if sym^.itype^.kind <> tPtr^.kind then
	 Error(107)
      else begin
         if sym^.itype = tPtr then
            tPtr^.sName := nil
         else begin
            tPtr := sym^.itype;
            if lPtr <> nil then
               lPtr^.ptype := tPtr;
            end; {else}
         end; {else}
      end; {if}
   end; {if}
if lPtr <> nil then
   tPtr := lPtr^.pType;			{check the field list for other fwd refs}
while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do
   tPtr := tPtr^.pType;
if tPtr^.kind in [structType,unionType] then begin
   fl := tPtr^.fieldList;
   while fl <> nil do begin
      if fl^.isForwardDeclared then
         ResolveForwardReference(fl);
      fl := fl^.next;
      end; {while}
   end; {if}
end; {ResolveForwardReference}


function StringType{prefix: charStrPrefixEnum): typePtr};

{ returns the type of a string literal with specified prefix    }
{                                                               }
{ parameters:                                                   }
{       prefix - the prefix                                     }

begin {StringType}
if prefix in [prefix_none,prefix_u8] then
   StringType := stringTypePtr
else if prefix in [prefix_u16,prefix_L] then
   StringType := utf16StringTypePtr
else
   StringType := utf32StringTypePtr;
end; {StringType}

end.

{$append 'symbol.asm'}