(* M2GCCDeclare.mod declares Modula-2 types to GCC.

Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.

This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Modula-2; see the file COPYING3.  If not see
<http://www.gnu.org/licenses/>.  *)

IMPLEMENTATION MODULE M2GCCDeclare ;

(*
    Title      : M2GCCDeclare
    Author     : Gaius Mulley
    System     : UNIX (gm2)
    Date       : Fri Jul 16 20:10:55 1999
    Description: declares Modula-2 types to GCC, it attempts
                 to only declare a type once all subcomponents are known.
*)

FROM SYSTEM IMPORT ADDRESS, ADR, WORD ;
FROM ASCII IMPORT nul ;
FROM Storage IMPORT ALLOCATE ;
FROM M2Debug IMPORT Assert ;
FROM M2Quads IMPORT DisplayQuadRange ;

IMPORT FIO ;

FROM M2Options IMPORT DisplayQuadruples,
                      GenerateDebugging, GenerateLineDebug, Iso, Optimizing, WholeProgram,
                      ScaffoldStatic, GetRuntimeModuleOverride ;

FROM M2AsmUtil IMPORT GetFullSymName, GetFullScopeAsmName ;

FROM M2Batch IMPORT MakeDefinitionSource ;
FROM NameKey IMPORT Name, MakeKey, NulName, KeyToCharStar, makekey ;
FROM M2FileName IMPORT CalculateFileName ;
FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, InitStringChar, Mark ;
FROM FormatStrings IMPORT Sprintf1 ;
FROM M2LexBuf IMPORT TokenToLineNo, FindFileNameFromToken, TokenToLocation, UnknownTokenNo, BuiltinTokenNo ;
FROM M2MetaError IMPORT MetaError1, MetaError3 ;
FROM M2Error IMPORT FlushErrors, InternalError ;
FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;

FROM Indexing IMPORT Index, InitIndex, PutIndice, GetIndice, InBounds,
                     IncludeIndiceIntoIndex, HighIndice,
                     DebugIndex ;

FROM Lists IMPORT List, InitList, IncludeItemIntoList,
                  PutItemIntoList, GetItemFromList,
                  RemoveItemFromList, ForeachItemInListDo,
      	       	  IsItemInList, NoOfItemsInList, KillList ;

FROM Sets IMPORT Set, InitSet, KillSet,
                 IncludeElementIntoSet, ExcludeElementFromSet,
                 NoOfElementsInSet, IsElementInSet, ForeachElementInSetDo ;

FROM SymbolTable IMPORT NulSym,
                        ModeOfAddr,
                        GetMode,
                        GetScope,
                        GetNth, SkipType, GetVarBackEndType,
			GetSType, GetLType, GetDType,
                        MakeType, PutType, GetLowestType,
      	       	     	GetSubrange, PutSubrange, GetArraySubscript,
      	       	     	NoOfParam, GetNthParam,
                        PushValue, PopValue, PopSize,
                        IsTemporary, IsUnbounded, IsPartialUnbounded,
                        IsEnumeration, IsVar,
      	       	     	IsSubrange, IsPointer, IsRecord, IsArray,
                        IsFieldEnumeration,
                        IsProcedure, IsProcedureNested, IsModule,
                        IsDefImp,
      	       	     	IsSubscript, IsVarient, IsFieldVarient,
      	       	     	IsType, IsProcType, IsSet, IsSetPacked,
                        IsConst, IsConstSet, IsConstructor,
                        IsFieldEnumeration,
                        IsExported, IsImported,
                        IsVarParam, IsRecordField, IsUnboundedParam,
                        IsValueSolved,
                        IsDefinitionForC, IsHiddenTypeDeclared,
                        IsInnerModule, IsUnknown,
                        IsProcedureReachable, IsParameter, IsConstLit,
                        IsDummy, IsVarAParam, IsProcedureVariable,
                        IsGnuAsm, IsGnuAsmVolatile, IsObject, IsTuple,
                        IsError, IsHiddenType,
                        IsComponent, IsPublic, IsExtern, IsCtor,
      	       	     	GetMainModule, GetBaseModule, GetModule, GetLocalSym,
                        PutModuleFinallyFunction,
                        GetProcedureScope, GetProcedureQuads,
                        IsRecordFieldAVarientTag, IsEmptyFieldVarient,
                        GetVarient, GetUnbounded, PutArrayLarge,
                        IsAModula2Type, UsesVarArgs,
                        GetSymName, GetParent,
                        GetDeclaredMod, GetVarBackEndType,
                        GetProcedureBeginEnd, IsProcedureNoReturn,
                        GetString, GetStringLength, IsConstString,
                        IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul,
                        GetAlignment, IsDeclaredPacked, PutDeclaredPacked,
                        GetDefaultRecordFieldAlignment, IsDeclaredPackedResolved,
                        GetPackedEquivalent,
                        GetParameterShadowVar,
                        GetUnboundedRecordType,
                        GetModuleCtors,
			ForeachOAFamily, GetOAFamily,
                        IsModuleWithinProcedure, IsVariableSSA,
                        IsVariableAtAddress, IsConstructorConstant,
                        ForeachLocalSymDo, ForeachFieldEnumerationDo,
      	       	     	ForeachProcedureDo, ForeachModuleDo,
                        ForeachInnerModuleDo, ForeachImportedDo,
                        ForeachExportedDo ;

FROM M2Base IMPORT IsPseudoBaseProcedure, IsPseudoBaseFunction,
                   GetBaseTypeMinMax, MixTypes,
                   Cardinal, Char, Proc, Integer,
                   LongInt, LongCard, ShortCard, ShortInt,
                   Real, LongReal, ShortReal, ZType, RType,
                   CType, Complex, LongComplex, ShortComplex,
                   Boolean, True, False, Nil,
                   IsRealType, IsNeededAtRunTime, IsComplexType ;

FROM M2System IMPORT IsPseudoSystemFunction, IsSystemType,
                     GetSystemTypeMinMax, Address, Word, Byte, Loc,
                     System, IntegerN, CardinalN, WordN, RealN, SetN, ComplexN,
		     CSizeT, CSSizeT ;

FROM M2Bitset IMPORT Bitset, Bitnum ;
FROM SymbolConversion IMPORT AddModGcc, Mod2Gcc, GccKnowsAbout, Poison, RemoveMod2Gcc ;
FROM M2GenGCC IMPORT ResolveConstantExpressions ;
FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock, ForeachScopeBlockDo ;

FROM M2ALU IMPORT Addn, Sub, Equ, GreEqu, Gre, Less, PushInt, PushCard, ConvertToType,
                  PushIntegerTree, PopIntegerTree, PopRealTree, ConvertToInt, PopSetTree,
                  PopChar,
                  IsConstructorDependants, WalkConstructorDependants,
                  PopConstructorTree, PopComplexTree, PutConstructorSolved,
                  ChangeToConstructor, EvaluateValue, TryEvaluateValue ;

FROM M2Batch IMPORT IsSourceSeen, GetModuleFile, IsModuleSeen, LookupModule ;
FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t, BuiltinsLocation ;

FROM m2decl IMPORT BuildIntegerConstant, BuildStringConstant, BuildCStringConstant,
                   BuildStartFunctionDeclaration,
                   BuildParameterDeclaration, BuildEndFunctionDeclaration,
                   DeclareKnownVariable, GetBitsPerBitset, BuildPtrToTypeString ;
(*                   DeclareM2linkStaticInitialization,
                   DeclareM2linkForcedModuleInitOrder ; *)

FROM m2type IMPORT MarkFunctionReferenced, BuildStartRecord, BuildStartVarient, BuildStartFunctionType,
                   BuildStartFieldVarient, BuildStartVarient, BuildStartType, BuildStartArrayType,
                   PutArrayType, BuildPointerType, BuildEndType, BuildCharConstant,
                   BuildTypeDeclaration, GetDefaultType, GetBooleanType, GetBooleanTrue,
                   GetBooleanFalse, BuildSubrangeType, GetM2ZType, GetM2RType, GetM2CType,
                   GetM2CardinalType, GetM2IntegerType, GetM2CharType, GetISOLocType, GetIntegerType,
                   GetISOByteType, GetISOWordType, GetByteType, GetWordType, GetProcType, GetPointerType,
                   GetM2LongIntType, GetM2LongCardType, GetM2ShortIntType, GetM2ShortCardType,
                   GetM2LongRealType, GetM2ShortRealType, GetM2RealType, GetBitnumType, GetBitsetType,
                   GetM2ComplexType, GetM2ComplexType, GetM2LongComplexType, GetM2ShortComplexType,
                   GetM2Integer8, GetM2Integer16, GetM2Integer32, GetM2Integer64, GetM2Cardinal8,
                   GetM2Cardinal16, GetM2Cardinal32, GetM2Cardinal64, GetM2Word16, GetM2Word32,
                   GetM2Word64, GetM2Bitset8, GetM2Bitset16, GetM2Bitset32, GetM2Real32, GetM2Real64,
                   GetM2Real96, GetM2Real128, GetM2Complex32, GetM2Complex64, GetM2Complex96,
                   GetM2Complex128, GetCSizeTType, GetCSSizeTType,
		   GetPackedBooleanType, BuildConstPointerType,
                   BuildPointerType, BuildEnumerator, BuildStartEnumeration, BuildEndEnumeration,
                   SetAlignment, SetTypePacked, SetDeclPacked, BuildSmallestTypeRange,
                   SetRecordFieldOffset, ChainOn, BuildEndRecord, BuildFieldRecord,
                   BuildEndFieldVarient, BuildArrayIndexType, BuildEndFunctionType,
                   BuildSetType, BuildEndVarient, BuildEndArrayType, InitFunctionTypeParameters,
                   BuildProcTypeParameterDeclaration, DeclareKnownType,
                   ValueOutOfTypeRange, ExceedsTypeRange ;

FROM m2convert IMPORT BuildConvert ;

FROM m2expr IMPORT BuildSub, BuildLSL, BuildTBitSize, BuildAdd, BuildDivTrunc, BuildModTrunc,
                   BuildSize, TreeOverflow,
                   GetPointerZero, GetIntegerZero, GetIntegerOne ;

FROM m2block IMPORT RememberType, pushGlobalScope, popGlobalScope, pushFunctionScope, popFunctionScope,
                    finishFunctionDecl, RememberConstant, GetGlobalContext ;


TYPE
   StartProcedure = PROCEDURE (location_t, ADDRESS) : Tree ;
   ListType       = (fullydeclared, partiallydeclared, niltypedarrays,
                     heldbyalignment, finishedalignment, todolist, tobesolvedbyquads) ;
   doDeclareProcedure = PROCEDURE (CARDINAL, CARDINAL) ;



CONST
   Debugging = FALSE ;
   Progress  = FALSE ;
   EnableSSA = FALSE ;

VAR
   ToBeSolvedByQuads,               (* constants which must be solved *)
                                    (* by processing the quadruples.  *)
   NilTypedArrays,                  (* arrays which have NIL as their *)
                                    (* type.                          *)
   FullyDeclared,                   (* those symbols which have been  *)
                                    (* fully declared.                *)
   PartiallyDeclared,               (* those types which have need to *)
                                    (* be finished (but already       *)
                                    (* started: records, function,    *)
                                    (* and array type).               *)
   HeldByAlignment,                 (* types which have a user        *)
                                    (* specified alignment constant.  *)
   FinishedAlignment,               (* records for which we know      *)
                                    (* their alignment value.         *)
   VisitedList,
   ChainedList,
   ToDoList            : Set ;      (* Contains a set of all          *)
                                    (* outstanding types that need to *)
                                    (* be declared to GCC once        *)
                                    (* its dependants have            *)
                                    (* been written.                  *)
   HaveInitDefaultTypes: BOOLEAN ;  (* have we initialized them yet?  *)
   WatchList           : Set ;      (* Set of symbols being watched   *)
   EnumerationIndex    : Index ;
   action              : IsAction ;
   enumDeps            : BOOLEAN ;


PROCEDURE mystop ; BEGIN END mystop ;

(* ***************************************************
(*
   PrintNum -
*)

PROCEDURE PrintNum (sym: WORD) ;
BEGIN
   printf1 ('%d, ', sym)
END PrintNum ;


(*
   DebugSet -
*)

PROCEDURE DebugSet (a: ARRAY OF CHAR; l: Set) ;
BEGIN
   printf0(a) ;
   printf0(' {') ;
   ForeachElementInSetDo (l, PrintNum) ;
   printf0('}\n')
END DebugSet ;


(*
   DebugSets -
*)

PROCEDURE DebugSets ;
BEGIN
   DebugSet('ToDoList', ToDoList) ;
   DebugSet('HeldByAlignment', HeldByAlignment) ;
   DebugSet('FinishedAlignment', FinishedAlignment) ;
   DebugSet('PartiallyDeclared', PartiallyDeclared) ;
   DebugSet('FullyDeclared', FullyDeclared) ;
   DebugSet('NilTypedArrays', NilTypedArrays) ;
   DebugSet('ToBeSolvedByQuads', ToBeSolvedByQuads)
END DebugSets ;
   ************************************************ *)


(*
   DebugNumber -
*)

PROCEDURE DebugNumber (a: ARRAY OF CHAR; s: Set) ;
VAR
   n: CARDINAL ;
BEGIN
   n := NoOfElementsInSet(s) ;
   printf1(a, n) ;
   FIO.FlushBuffer(FIO.StdOut)
END DebugNumber ;


(*
   FindSetNumbers -
*)

PROCEDURE FindSetNumbers (VAR t, a, p, f, n, b: CARDINAL) : BOOLEAN ;
VAR
   t1, p1, f1, n1, b1, a1: CARDINAL ;
   same                  : BOOLEAN ;
BEGIN
   t1 := NoOfElementsInSet(ToDoList) ;
   a1 := NoOfElementsInSet(HeldByAlignment) ;
   p1 := NoOfElementsInSet(PartiallyDeclared) ;
   f1 := NoOfElementsInSet(FullyDeclared) ;
   n1 := NoOfElementsInSet(NilTypedArrays) ;
   b1 := NoOfElementsInSet(ToBeSolvedByQuads) ;
   same := ((t=t1) AND (a=a1) AND (p=p1) AND (f=f1) AND (n=n1) AND (b=b1)) ;
   t := t1 ;
   a := a1 ;
   p := p1 ;
   f := f1 ;
   n := n1 ;
   b := b1 ;
   RETURN( same )
END FindSetNumbers ;


(*
   DebugSets -
*)

PROCEDURE DebugSetNumbers ;
BEGIN
   DebugNumber('ToDoList : %d\n', ToDoList) ;
   DebugNumber('HeldByAlignment : %d\n', HeldByAlignment) ;
   DebugNumber('PartiallyDeclared : %d\n', PartiallyDeclared) ;
   DebugNumber('FullyDeclared : %d\n', FullyDeclared) ;
   DebugNumber('NilTypedArrays : %d\n', NilTypedArrays) ;
   DebugNumber('ToBeSolvedByQuads : %d\n', ToBeSolvedByQuads)
END DebugSetNumbers ;


(*
   AddSymToWatch - adds symbol, sym, to the list of symbols
                   to watch and annotate their movement between
                   lists.
*)

(*
PROCEDURE AddSymToWatch (sym: WORD) ;
BEGIN
   IF (sym#NulSym) AND (NOT IsElementInSet(WatchList, sym))
   THEN
      IncludeElementIntoSet(WatchList, sym) ;
      WalkDependants(sym, AddSymToWatch) ;
      printf1("watching symbol %d\n", sym) ;
      FIO.FlushBuffer(FIO.StdOut)
   END
END AddSymToWatch ;
*)


(*
   TryFindSymbol -
*)

(*
PROCEDURE TryFindSymbol (module, symname: ARRAY OF CHAR) : CARDINAL ;
VAR
   mn, sn: Name ;
   mod   : CARDINAL ;
BEGIN
   mn := MakeKey(module) ;
   sn := MakeKey(symname) ;
   IF IsModuleSeen(mn)
   THEN
      mod := LookupModule (UnknownTokenNo, mn) ;
      RETURN( GetLocalSym(mod, sn) )
   ELSE
      RETURN( NulSym )
   END
END TryFindSymbol ;
*)


(*
   doInclude -
*)

PROCEDURE doInclude (l: Set; a: ARRAY OF CHAR; sym: CARDINAL) ;
BEGIN
   IF NOT IsElementInSet(l, sym)
   THEN
      printf0('rule: ') ;
      WriteRule ;
      printf0('  ') ;
      printf1(a, sym) ;
      FIO.FlushBuffer(FIO.StdOut) ;
      IncludeElementIntoSet(l, sym)
   END
END doInclude ;


(*
   WatchIncludeList - include a symbol onto the set first checking
                      whether it is already on the set and
                      displaying a debug message if the set is
                      changed.
*)

PROCEDURE WatchIncludeList (sym: CARDINAL; lt: ListType) ;
BEGIN
   IF IsElementInSet(WatchList, sym)
   THEN
      CASE lt OF

      tobesolvedbyquads :  doInclude(ToBeSolvedByQuads, "symbol %d -> ToBeSolvedByQuads\n", sym) |
      fullydeclared     :  doInclude(FullyDeclared, "symbol %d -> FullyDeclared\n", sym) ;
                           IF sym=1265
                           THEN
                              mystop
                           END |
      partiallydeclared :  doInclude(PartiallyDeclared, "symbol %d -> PartiallyDeclared\n", sym) |
      heldbyalignment   :  doInclude(HeldByAlignment, "symbol %d -> HeldByAlignment\n", sym) |
      finishedalignment :  doInclude(FinishedAlignment, "symbol %d -> FinishedAlignment\n", sym) |
      todolist          :  doInclude(ToDoList, "symbol %d -> ToDoList\n", sym) |
      niltypedarrays    :  doInclude(NilTypedArrays, "symbol %d -> NilTypedArrays\n", sym)

      ELSE
         InternalError ('unknown list')
      END
   ELSE
      CASE lt OF

      tobesolvedbyquads :  IncludeElementIntoSet(ToBeSolvedByQuads, sym) |
      fullydeclared     :  IncludeElementIntoSet(FullyDeclared, sym) |
      partiallydeclared :  IncludeElementIntoSet(PartiallyDeclared, sym) |
      heldbyalignment   :  IncludeElementIntoSet(HeldByAlignment, sym) |
      finishedalignment :  IncludeElementIntoSet(FinishedAlignment, sym) |
      todolist          :  IncludeElementIntoSet(ToDoList, sym) |
      niltypedarrays    :  IncludeElementIntoSet(NilTypedArrays, sym)

      ELSE
         InternalError ('unknown list')
      END
   END
END WatchIncludeList ;


(*
   doExclude -
*)

PROCEDURE doExclude (l: Set; a: ARRAY OF CHAR; sym: CARDINAL) ;
BEGIN
   IF IsElementInSet(l, sym)
   THEN
      printf0('rule: ') ;
      WriteRule ;
      printf0('  ') ;
      printf1(a, sym) ;
      FIO.FlushBuffer(FIO.StdOut) ;
      ExcludeElementFromSet(l, sym)
   END
END doExclude ;


(*
   WatchRemoveList - remove a symbol onto the list first checking
                     whether it is already on the list and
                     displaying a debug message if the list is
                     changed.
*)

PROCEDURE WatchRemoveList (sym: CARDINAL; lt: ListType) ;
BEGIN
   IF IsElementInSet(WatchList, sym)
   THEN
      CASE lt OF

      tobesolvedbyquads :  doExclude(ToBeSolvedByQuads, "symbol %d off ToBeSolvedByQuads\n", sym) |
      fullydeclared     :  doExclude(FullyDeclared, "symbol %d off FullyDeclared\n", sym) |
      partiallydeclared :  doExclude(PartiallyDeclared, "symbol %d off PartiallyDeclared\n", sym) |
      heldbyalignment   :  doExclude(HeldByAlignment, "symbol %d -> HeldByAlignment\n", sym) |
      finishedalignment :  doExclude(FinishedAlignment, "symbol %d -> FinishedAlignment\n", sym) |
      todolist          :  doExclude(ToDoList, "symbol %d off ToDoList\n", sym) |
      niltypedarrays    :  doExclude(NilTypedArrays, "symbol %d off NilTypedArrays\n", sym)

      ELSE
         InternalError ('unknown list')
      END
   ELSE
      CASE lt OF

      tobesolvedbyquads :  ExcludeElementFromSet(ToBeSolvedByQuads, sym) |
      fullydeclared     :  ExcludeElementFromSet(FullyDeclared, sym) |
      partiallydeclared :  ExcludeElementFromSet(PartiallyDeclared, sym) |
      heldbyalignment   :  ExcludeElementFromSet(HeldByAlignment, sym) |
      finishedalignment :  ExcludeElementFromSet(FinishedAlignment, sym) |
      todolist          :  ExcludeElementFromSet(ToDoList, sym) |
      niltypedarrays    :  ExcludeElementFromSet(NilTypedArrays, sym)

      ELSE
         InternalError ('unknown list')
      END
   END
END WatchRemoveList ;


(*
   GetEnumList -
*)

PROCEDURE GetEnumList (sym: CARDINAL) : Tree ;
BEGIN
   IF InBounds(EnumerationIndex, sym)
   THEN
      RETURN( GetIndice(EnumerationIndex, sym) )
   ELSE
      RETURN( NIL )
   END
END GetEnumList ;


(*
   PutEnumList -
*)

PROCEDURE PutEnumList (sym: CARDINAL; enumlist: Tree) ;
BEGIN
   PutIndice(EnumerationIndex, sym, enumlist)
END PutEnumList ;


(*
   MarkExported - tell GCC to mark all exported procedures in module sym.
*)

PROCEDURE MarkExported (sym: CARDINAL) ;
BEGIN
   IF Optimizing
   THEN
      MarkFunctionReferenced(Mod2Gcc(sym)) ;
      IF IsDefImp(sym) OR IsModule(sym)
      THEN
         ForeachExportedDo(sym, MarkExported)
      END
   END
END MarkExported ;


(*
   Chained - checks to see that, sym, has not already been placed on a chain.
             It returns the symbol, sym.
*)

PROCEDURE Chained (sym: CARDINAL) : CARDINAL ;
BEGIN
   IF IsElementInSet(ChainedList, sym)
   THEN
      InternalError ('symbol has already been chained onto a previous list')
   END ;
   IncludeElementIntoSet(ChainedList, sym) ;
   RETURN( sym )
END Chained ;


(*
   DoStartDeclaration - returns a tree representing a symbol which has
                        not yet been finished.  Used when declaring
                        recursive types.
*)

PROCEDURE DoStartDeclaration (sym: CARDINAL; p: StartProcedure) : Tree ;
VAR
   location: location_t ;
BEGIN
   IF NOT GccKnowsAbout (sym)
   THEN
      location := TokenToLocation (GetDeclaredMod (sym)) ;
      PreAddModGcc(sym, p (location, KeyToCharStar (GetFullSymName (sym))))
   END ;
   RETURN Mod2Gcc (sym)
END DoStartDeclaration ;


(*
   ArrayComponentsDeclared - returns TRUE if array, sym,
                             subscripts and type are known.
*)

PROCEDURE ArrayComponentsDeclared (sym: CARDINAL) : BOOLEAN ;
VAR
   Subscript      : CARDINAL ;
   Type, High, Low: CARDINAL ;
BEGIN
   Subscript := GetArraySubscript(sym) ;
   Assert(IsSubscript(Subscript)) ;
   Type := GetDType(Subscript) ;
   Low := GetTypeMin(Type) ;
   High := GetTypeMax(Type) ;
   RETURN( IsFullyDeclared(Type) AND
           IsFullyDeclared(Low) AND
           IsFullyDeclared(High) )
END ArrayComponentsDeclared ;


(*
   GetRecordOfVarient -
*)

PROCEDURE GetRecordOfVarient (sym: CARDINAL) : CARDINAL ;
BEGIN
   IF IsVarient(sym) OR IsFieldVarient(sym)
   THEN
      REPEAT
         sym := GetParent(sym)
      UNTIL IsRecord(sym)
   END ;
   RETURN( sym )
END GetRecordOfVarient ;


(*
   CanDeclareRecordKind -
*)

PROCEDURE CanDeclareRecordKind (sym: CARDINAL) : BOOLEAN ;
BEGIN
   sym := GetRecordOfVarient(sym) ;
   RETURN( IsRecord(sym) AND
           ((GetDefaultRecordFieldAlignment(sym)=NulSym) OR
            IsFullyDeclared(GetDefaultRecordFieldAlignment(sym))) )
END CanDeclareRecordKind ;


(*
   DeclareRecordKind - works out whether record, sym, is packed or not.
*)

PROCEDURE DeclareRecordKind (sym: CARDINAL) ;
BEGIN
   IF IsRecord(sym)
   THEN
      DetermineIfRecordPacked(sym)
   END ;
   WatchIncludeList(sym, todolist) ;
   WatchRemoveList(sym, heldbyalignment) ;
   WatchIncludeList(sym, finishedalignment) ;
   IF AllDependantsFullyDeclared(sym)
   THEN
      (* All good and ready to be solved. *)
   END
END DeclareRecordKind ;


(*
   CanDeclareRecord -
*)

PROCEDURE CanDeclareRecord (sym: CARDINAL) : BOOLEAN ;
BEGIN
   TraverseDependants(sym) ;
   IF AllDependantsFullyDeclared(sym)
   THEN
      RETURN TRUE
   ELSE
      WatchIncludeList(sym, finishedalignment) ;
      RETURN FALSE
   END
END CanDeclareRecord ;


(*
   FinishDeclareRecord -
*)

PROCEDURE FinishDeclareRecord (sym: CARDINAL) ;
BEGIN
   DeclareTypeConstFully(sym) ;
   WatchRemoveList(sym, heldbyalignment) ;
   WatchRemoveList(sym, finishedalignment) ;
   WatchRemoveList(sym, todolist) ;
   WatchIncludeList(sym, fullydeclared)
END FinishDeclareRecord ;


(*
   CanDeclareTypePartially - return TRUE if we are able to make a
                             gcc partially created type.
*)

PROCEDURE CanDeclareTypePartially (sym: CARDINAL) : BOOLEAN ;
VAR
   type: CARDINAL ;
BEGIN
   IF IsElementInSet(PartiallyDeclared, sym)
   THEN
      RETURN( FALSE )
   ELSIF IsProcType(sym) OR IsRecord(sym) OR IsVarient(sym) OR IsFieldVarient(sym)
   THEN
      RETURN( TRUE )
   ELSIF IsType(sym)
   THEN
      type := GetSType(sym) ;
      IF (type#NulSym) AND IsNilTypedArrays(type)
      THEN
         RETURN( TRUE )
      END
   END ;
   RETURN( FALSE )
END CanDeclareTypePartially ;


(*
   DeclareTypePartially - create the gcc partial type symbol from, sym.
*)

PROCEDURE DeclareTypePartially (sym: CARDINAL) ;
VAR
   location: location_t ;
BEGIN
   (* check to see if we have already partially declared the symbol *)
   IF NOT IsElementInSet(PartiallyDeclared, sym)
   THEN
      IF IsRecord(sym)
      THEN
         Assert (NOT IsElementInSet (HeldByAlignment, sym)) ;
         Assert (DoStartDeclaration (sym, BuildStartRecord) # NIL) ;
         WatchIncludeList (sym, heldbyalignment)
      ELSIF IsVarient (sym)
      THEN
         Assert(NOT IsElementInSet(HeldByAlignment, sym)) ;
         Assert (DoStartDeclaration(sym, BuildStartVarient) # NIL) ;
         WatchIncludeList(sym, heldbyalignment)
      ELSIF IsFieldVarient(sym)
      THEN
         Assert(NOT IsElementInSet(HeldByAlignment, sym)) ;
         Assert (DoStartDeclaration(sym, BuildStartFieldVarient) # NIL) ;
         WatchIncludeList(sym, heldbyalignment)
      ELSIF IsProcType(sym)
      THEN
         Assert (DoStartDeclaration(sym, BuildStartFunctionType) # NIL) ;
      ELSIF IsType(sym)
      THEN
         IF NOT GccKnowsAbout(sym)
         THEN
            location := TokenToLocation(GetDeclaredMod(sym)) ;
            PreAddModGcc(sym, BuildStartType(location,
                                             KeyToCharStar(GetFullSymName(sym)),
                                             Mod2Gcc(GetSType(sym))))
         END
      ELSE
         InternalError ('do not know how to create a partial type from this symbol')
      END ;
      WatchIncludeList(sym, partiallydeclared) ;
      TraverseDependants(sym)
   END
END DeclareTypePartially ;


(*
   CanDeclareArrayAsNil -
*)

PROCEDURE CanDeclareArrayAsNil (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsArray(sym) AND ArrayComponentsDeclared(sym) )
END CanDeclareArrayAsNil ;


(*
   DeclareArrayAsNil -
*)

PROCEDURE DeclareArrayAsNil (sym: CARDINAL) ;
BEGIN
   PreAddModGcc(sym, BuildStartArrayType(BuildIndex(GetDeclaredMod(sym), sym), NIL, GetDType(sym))) ;
   WatchIncludeList(sym, niltypedarrays)
END DeclareArrayAsNil ;


(*
   CanDeclareArrayPartially -
*)

PROCEDURE CanDeclareArrayPartially (sym: CARDINAL) : BOOLEAN ;
VAR
   type: CARDINAL ;
BEGIN
   IF IsArray(sym)
   THEN
      type := GetSType(sym) ;
      IF IsPartiallyOrFullyDeclared(type) OR
         (IsPointer(type) AND IsNilTypedArrays(type))
      THEN
         RETURN( TRUE )
      END
   END ;
   RETURN( FALSE )
END CanDeclareArrayPartially ;


(*
   DeclareArrayPartially -
*)

PROCEDURE DeclareArrayPartially (sym: CARDINAL) ;
BEGIN
   Assert(IsArray(sym) AND GccKnowsAbout(sym)) ;
   PutArrayType(Mod2Gcc(sym), Mod2Gcc(GetSType(sym))) ;
   WatchIncludeList(sym, partiallydeclared)
END DeclareArrayPartially ;


(*
   CanDeclarePointerToNilArray -
*)

PROCEDURE CanDeclarePointerToNilArray (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsPointer(sym) AND IsNilTypedArrays(GetSType(sym)) )
END CanDeclarePointerToNilArray ;


(*
   DeclarePointerToNilArray -
*)

PROCEDURE DeclarePointerToNilArray (sym: CARDINAL) ;
BEGIN
   PreAddModGcc(sym, BuildPointerType(Mod2Gcc(GetSType(sym)))) ;
   WatchIncludeList(sym, niltypedarrays)
END DeclarePointerToNilArray ;


(*
   CanPromotePointerFully -
*)

PROCEDURE CanPromotePointerFully (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsPointer(sym) AND IsPartiallyOrFullyDeclared(GetSType(sym)) )
END CanPromotePointerFully ;


(*
   PromotePointerFully -
*)

PROCEDURE PromotePointerFully (sym: CARDINAL) ;
BEGIN
   WatchIncludeList(sym, fullydeclared)
END PromotePointerFully ;


(*
   CompletelyResolved - returns TRUE if a symbols has been completely resolved
                        and is not partically declared (such as a record).
*)

PROCEDURE CompletelyResolved (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsElementInSet(FullyDeclared, sym) )
END CompletelyResolved ;


(*
   IsTypeQ - returns TRUE if all q(dependants) of, sym,
             return TRUE.
*)

PROCEDURE IsTypeQ (sym: CARDINAL; q: IsAction) : BOOLEAN ;
BEGIN
   IF IsVar(sym)
   THEN
      RETURN( IsVarDependants(sym, q) )
   ELSIF IsEnumeration(sym)
   THEN
      RETURN( IsEnumerationDependants(sym, q) )
   ELSIF IsFieldEnumeration(sym)
   THEN
      RETURN( TRUE )
   ELSIF IsSubrange(sym)
   THEN
      RETURN( IsSubrangeDependants(sym, q) )
   ELSIF IsPointer(sym)
   THEN
      RETURN( IsPointerDependants(sym, q) )
   ELSIF IsRecord(sym)
   THEN
      RETURN( IsRecordDependants(sym, q) )
   ELSIF IsRecordField(sym)
   THEN
      RETURN( IsRecordFieldDependants(sym, q) )
   ELSIF IsVarient(sym)
   THEN
      RETURN( IsVarientDependants(sym, q) )
   ELSIF IsFieldVarient(sym)
   THEN
      RETURN( IsVarientFieldDependants(sym, q) )
   ELSIF IsArray(sym)
   THEN
      RETURN( IsArrayDependants(sym, q) )
   ELSIF IsProcType(sym)
   THEN
      RETURN( IsProcTypeDependants(sym, q) )
   ELSIF IsUnbounded(sym)
   THEN
      RETURN( IsUnboundedDependants(sym, q) )
   ELSIF IsPartialUnbounded(sym)
   THEN
      InternalError ('should not be declaring a partial unbounded symbol')
   ELSIF IsSet(sym)
   THEN
      RETURN( IsSetDependants(sym, q) )
   ELSIF IsType(sym)
   THEN
      RETURN( IsTypeDependants(sym, q) )
   ELSIF IsConst(sym)
   THEN
      RETURN( IsConstDependants(sym, q) )
   ELSIF IsConstructor(sym) OR IsConstSet(sym)
   THEN
      (* sym can be a constructor, but at present we have not resolved whether
         all dependants are constants.
       *)
      RETURN( IsConstructorDependants(sym, q) )
   ELSIF IsProcedure(sym)
   THEN
      RETURN( IsProcedureDependants(sym, q) )
   ELSE
      RETURN( TRUE )
   END
END IsTypeQ ;


(*
   IsNilTypedArrays - returns TRUE if, sym, is dependant upon a NIL typed array
*)

PROCEDURE IsNilTypedArrays (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsElementInSet(NilTypedArrays, sym) )
END IsNilTypedArrays ;


(*
   IsFullyDeclared - returns TRUE if, sym, is fully declared.
*)

PROCEDURE IsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsElementInSet(FullyDeclared, sym) )
END IsFullyDeclared ;


(*
   AllDependantsFullyDeclared - returns TRUE if all dependants of,
                                sym, are declared.
*)

PROCEDURE AllDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsTypeQ(sym, IsFullyDeclared) )
END AllDependantsFullyDeclared ;


(*
   NotAllDependantsFullyDeclared - returns TRUE if any dependants of,
                                   sym, are not declared.
*)

PROCEDURE NotAllDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( NOT IsTypeQ(sym, IsFullyDeclared) )
END NotAllDependantsFullyDeclared ;


(*
   IsPartiallyDeclared - returns TRUE if, sym, is partially declared.
*)

PROCEDURE IsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsElementInSet(PartiallyDeclared, sym) )
END IsPartiallyDeclared ;


(*
   AllDependantsPartiallyDeclared - returns TRUE if all dependants of,
                                    sym, are partially declared.
*)

PROCEDURE AllDependantsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsTypeQ(sym, IsPartiallyDeclared) )
END AllDependantsPartiallyDeclared ;


(*
   NotAllDependantsPartiallyDeclared - returns TRUE if any dependants of,
                                       sym, are not partially declared.
*)

PROCEDURE NotAllDependantsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( NOT IsTypeQ(sym, IsPartiallyDeclared) )
END NotAllDependantsPartiallyDeclared ;


(*
   IsPartiallyOrFullyDeclared - returns TRUE if, sym, is partially or fully declared.
*)

PROCEDURE IsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsElementInSet(PartiallyDeclared, sym) OR
           IsElementInSet(FullyDeclared, sym) )
END IsPartiallyOrFullyDeclared ;


(*
   AllDependantsPartiallyOrFullyDeclared - returns TRUE if all dependants of,
                                           sym, are partially or fully declared.
*)

PROCEDURE AllDependantsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsTypeQ(sym, IsPartiallyOrFullyDeclared) )
END AllDependantsPartiallyOrFullyDeclared ;


(*
   NotAllDependantsPartiallyOrFullyDeclared - returns TRUE if all dependants of,
                                              sym, are not partially and not fully
                                              declared.
*)

(*
PROCEDURE NotAllDependantsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsTypeQ(sym, IsPartiallyOrFullyDeclared) )
END NotAllDependantsPartiallyOrFullyDeclared ;
*)


(*
   TypeConstDependantsFullyDeclared - returns TRUE if sym is a constant or
                                      type and its dependants are fully
                                      declared.
*)

PROCEDURE TypeConstDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( (NOT IsVar(sym)) AND
           (NOT IsRecord(sym)) AND
           (NOT IsParameter(sym)) AND
           AllDependantsFullyDeclared(sym) )
END TypeConstDependantsFullyDeclared ;


(*
   CanBeDeclaredViaPartialDependants - returns TRUE if this symbol
                                       can be declared by partial
                                       dependants.  Such a symbol must
                                       be a record, proctype or
                                       an array.
*)

PROCEDURE CanBeDeclaredViaPartialDependants (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( (IsPointer(sym) OR IsProcType(sym)) AND
           AllDependantsPartiallyOrFullyDeclared(sym) )
END CanBeDeclaredViaPartialDependants ;


(*
   DeclareConstFully - will add, sym, to the fully declared list and
                       also remove it from the to do list.  This is
                       called indirectly from M2GenGCC as it calculates
                       constants during quadruple processing.
*)

PROCEDURE DeclareConstFully (sym: CARDINAL) ;
BEGIN
   WatchIncludeList(sym, fullydeclared) ;
   WatchRemoveList(sym, todolist) ;
   WatchRemoveList(sym, partiallydeclared) ;
   WatchRemoveList(sym, tobesolvedbyquads)
END DeclareConstFully ;


(*
   PutToBeSolvedByQuads - places, sym, to this list and returns,
                          sym.
*)

PROCEDURE PutToBeSolvedByQuads (sym: CARDINAL) ;
BEGIN
   WatchIncludeList(sym, tobesolvedbyquads)
END PutToBeSolvedByQuads ;


(*
   DeclareTypeConstFully - declare the GCC type and add the double
                           book keeping entry.
*)

PROCEDURE DeclareTypeConstFully (sym: CARDINAL) ;
VAR
   t: Tree ;
BEGIN
   IF NOT IsElementInSet(ToBeSolvedByQuads, sym)
   THEN
      IF IsModule(sym) OR IsDefImp(sym)
      THEN
         WatchIncludeList(sym, fullydeclared) ;
         WatchRemoveList(sym, partiallydeclared) ;
         WatchRemoveList(sym, todolist)
      ELSIF IsProcedure(sym)
      THEN
         DeclareProcedureToGcc(sym) ;
         WatchIncludeList(sym, fullydeclared) ;
         WatchRemoveList(sym, partiallydeclared) ;
         WatchRemoveList(sym, todolist)
      ELSE
         t := TypeConstFullyDeclared(sym) ;
         IF t#NIL
         THEN
            (* add relationship between gccsym and sym *)
            PreAddModGcc(sym, t) ;
            WatchIncludeList(sym, fullydeclared) ;
            WatchRemoveList(sym, partiallydeclared) ;
            WatchRemoveList(sym, heldbyalignment) ;
            WatchRemoveList(sym, finishedalignment) ;
            WatchRemoveList(sym, todolist)
         END
      END
   END
END DeclareTypeConstFully ;


(*
   DeclareTypeFromPartial - declare the full GCC type from a partial type
                            and add the double book keeping entry.
*)

PROCEDURE DeclareTypeFromPartial (sym: CARDINAL) ;
VAR
   t: Tree ;
BEGIN
   t := CompleteDeclarationOf(sym) ;
   IF t=NIL
   THEN
      InternalError ('expecting to be able to create a gcc type')
   ELSE
      AddModGcc(sym, t) ;
      WatchIncludeList(sym, fullydeclared) ;
      WatchRemoveList(sym, partiallydeclared)
   END
END DeclareTypeFromPartial ;


(*
   DeclarePointerTypeFully - if, sym, is a pointer type then
                             declare it.
*)

(*
PROCEDURE DeclarePointerTypeFully (sym: CARDINAL) ;
BEGIN
   IF IsPointer(sym)
   THEN
      WatchIncludeList(sym, fullydeclared) ;
      WatchRemoveList(sym, partiallydeclared) ;
      WatchRemoveList(sym, todolist) ;
      PreAddModGcc(sym, DeclarePointer(sym))
   ELSE
      (* place sym and all dependants on the todolist
         providing they are not already on the FullyDeclared list
      *)
      TraverseDependants(sym)
   END
END DeclarePointerTypeFully ;
*)


(*
   CanBeDeclaredPartiallyViaPartialDependants - returns TRUE if, sym,
                                                can be partially declared via
                                                another partially declared type.
*)

PROCEDURE CanBeDeclaredPartiallyViaPartialDependants (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( IsType(sym) AND AllDependantsPartiallyDeclared(sym) )
END CanBeDeclaredPartiallyViaPartialDependants ;


(*
   EmitCircularDependancyError - issue a dependancy error.
*)

PROCEDURE EmitCircularDependancyError (sym: CARDINAL) ;
BEGIN
   MetaError1('circular dependancy error found when trying to resolve {%1Uad}',
              sym)
END EmitCircularDependancyError ;


TYPE
   Rule = (norule, partialtype, arraynil, pointernilarray, arraypartial,
           pointerfully, recordkind, recordfully, typeconstfully,
           pointerfrompartial, typefrompartial, partialfrompartial,
           partialtofully, circulartodo, circularpartial, circularniltyped) ;

VAR
   bodyp          : WalkAction ;
   bodyq          : IsAction ;
   bodyt          : ListType ;
   bodyl          : Set ;
   bodyr          : Rule ;
   recursionCaught,
   oneResolved,
   noMoreWritten  : BOOLEAN ;


(*
   WriteRule - writes out the name of the rule.
*)

PROCEDURE WriteRule ;
BEGIN
   IF Debugging
   THEN
      CASE bodyr OF

      norule            :  printf0('norule') |
      partialtype       :  printf0('partialtype') |
      arraynil          :  printf0('arraynil') |
      pointernilarray   :  printf0('pointernilarray') |
      arraypartial      :  printf0('arraypartial') |
      pointerfully      :  printf0('pointerfully') |
      recordkind        :  printf0('recordkind') |
      recordfully       :  printf0('recordfully') |
      typeconstfully    :  printf0('typeconstfully') |
      pointerfrompartial:  printf0('pointerfrompartial') |
      typefrompartial   :  printf0('typefrompartial') |
      partialfrompartial:  printf0('partialfrompartial') |
      partialtofully    :  printf0('partialtofully') |
      circulartodo      :  printf0('circulartodo') |
      circularpartial   :  printf0('circularpartial') |
      circularniltyped  :  printf0('circularniltyped')

      ELSE
         InternalError ('unknown rule')
      END
   END
END WriteRule ;


(*
   Body -
*)

PROCEDURE Body (sym: CARDINAL) ;
BEGIN
   IF bodyq(sym)
   THEN
      WatchRemoveList(sym, bodyt) ;
      bodyp(sym) ;
      (* bodyp(sym) might have replaced sym into the set *)
      IF NOT IsElementInSet(bodyl, sym)
      THEN
         noMoreWritten := FALSE ;
         oneResolved := TRUE
      END
   END
END Body ;


(*
   ForeachTryDeclare - while q(of one sym in l) is true
                          for each symbol in, l,
                          if q(sym)
                          then
                             p(sym)
                          end
                       end
*)

PROCEDURE ForeachTryDeclare (t: ListType; l: Set; r: Rule;
                             q: IsAction; p: WalkAction) : BOOLEAN ;
BEGIN
   IF recursionCaught
   THEN
      InternalError ('caught recursive cycle in ForeachTryDeclare')
   END ;
   bodyt := t ;
   bodyq := q ;
   bodyp := p ;
   bodyl := l ;
   bodyr := r ;
   recursionCaught := TRUE ;
   oneResolved := FALSE ;
   REPEAT
      noMoreWritten := TRUE ;
      ForeachElementInSetDo(l, Body)
   UNTIL noMoreWritten ;
   bodyr := norule ;
   recursionCaught := FALSE ;
   RETURN( oneResolved )
END ForeachTryDeclare ;


(*
   DeclaredOutandingTypes - writes out any types that have their
                            dependants solved.  It returns TRUE if
                            all outstanding types have been written.
*)

PROCEDURE DeclaredOutstandingTypes (ForceComplete: BOOLEAN) : BOOLEAN ;
VAR
   finished        : BOOLEAN ;
   d, a, p, f, n, b: CARDINAL ;
BEGIN
   d := 0 ;
   a := 0 ;
   p := 0 ;
   f := 0 ;
   n := 0 ;
   b := 0 ;
   finished := FALSE ;
   REPEAT
      IF FindSetNumbers (d, a, p, f, n, b) OR Progress
      THEN
         DebugSetNumbers
      END ;
      IF ForeachTryDeclare (todolist, ToDoList,
                            partialtype,
                            CanDeclareTypePartially,
                            DeclareTypePartially)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (todolist, ToDoList,
                               arraynil,
                               CanDeclareArrayAsNil,
                               DeclareArrayAsNil)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (todolist, ToDoList,
                               pointernilarray,
                               CanDeclarePointerToNilArray,
                               DeclarePointerToNilArray)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays,
                               arraypartial,
                               CanDeclareArrayPartially,
                               DeclareArrayPartially)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays,
                               pointerfully,
                               CanPromotePointerFully,
                               PromotePointerFully)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (heldbyalignment, HeldByAlignment,
                               recordkind,
                               CanDeclareRecordKind,
                               DeclareRecordKind)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (finishedalignment, FinishedAlignment,
                               recordfully,
                               CanDeclareRecord,
                               FinishDeclareRecord)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (todolist, ToDoList,
                               typeconstfully,
                               TypeConstDependantsFullyDeclared,
                               DeclareTypeConstFully)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (todolist, ToDoList,
                               (* partiallydeclared, PartiallyDeclared, *)
                               typefrompartial,
                               CanBeDeclaredViaPartialDependants,
                               DeclareTypeFromPartial)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared,
                               partialfrompartial,
                               CanBeDeclaredPartiallyViaPartialDependants,
                               DeclareTypePartially)
      THEN
         (* continue looping *)
      ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared,
                               partialtofully,
                               TypeConstDependantsFullyDeclared,
                               DeclareTypeConstFully)
      THEN
         (* continue looping *)
      ELSE
         (* nothing left to do (and constants are resolved elsewhere) *)
         finished := TRUE
      END
   UNTIL finished ;
   IF ForceComplete
   THEN
      IF ForeachTryDeclare (todolist, ToDoList,
                            circulartodo,
                            NotAllDependantsFullyDeclared,
                            EmitCircularDependancyError)
      THEN
      ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared,
                               circularpartial,
                               NotAllDependantsPartiallyDeclared,
                               EmitCircularDependancyError)
      THEN
      ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays,
                               circularniltyped,
                               NotAllDependantsPartiallyDeclared,
                               EmitCircularDependancyError)
      THEN
      END
   END ;
   RETURN NoOfElementsInSet (ToDoList) = 0
END DeclaredOutstandingTypes ;


(*
   CompleteDeclarationOf - returns the GCC Tree for, sym, if it can
                           be created from partially or fully declared
                           dependents.
*)

PROCEDURE CompleteDeclarationOf (sym: CARDINAL) : Tree ;
BEGIN
   IF IsArray(sym)
   THEN
      RETURN( DeclareArray(sym) )
   ELSIF IsProcType(sym)
   THEN
      RETURN( DeclareProcType(sym) )
   ELSIF IsRecordField(sym)
   THEN
      RETURN( DeclareRecordField(sym) )
   ELSIF IsPointer(sym)
   THEN
      RETURN( DeclarePointer(sym) )
   ELSE
      RETURN( NIL )
   END
END CompleteDeclarationOf ;


(*
   DeclareType - here a type has been created via TYPE foo = bar,
                 we must tell GCC about it.
*)

PROCEDURE DeclareType (sym: CARDINAL) : Tree ;
VAR
   t       : Tree ;
   location: location_t ;
BEGIN
   IF GetSType(sym)=NulSym
   THEN
      MetaError1('base type {%1Ua} not understood', sym) ;
      InternalError ('base type should have been declared')
   ELSE
      IF GetSymName(sym)=NulName
      THEN
         RETURN( Tree(Mod2Gcc(GetSType(sym))) )
      ELSE
         location := TokenToLocation(GetDeclaredMod(sym)) ;
         IF GccKnowsAbout(sym)
         THEN
            t := Mod2Gcc(sym)
         ELSE
            (* not partially declared therefore start it *)
            t := BuildStartType(location,
                                KeyToCharStar(GetFullSymName(sym)), Mod2Gcc(GetSType(sym)))
         END ;
         t := BuildEndType(location, t) ;  (* now finish it *)
         RETURN( t )
      END
   END
END DeclareType ;


(*
   DeclareIntegerConstant - declares an integer constant.
*)

(*
PROCEDURE DeclareIntegerConstant (sym: CARDINAL; value: INTEGER) ;
BEGIN
   PreAddModGcc(sym, BuildIntegerConstant(value)) ;
   WatchRemoveList(sym, todolist) ;
   WatchIncludeList(sym, fullydeclared)
END DeclareIntegerConstant ;
*)


(*
   DeclareIntegerFromTree - declares an integer constant from a Tree, value.
*)

PROCEDURE DeclareConstantFromTree (sym: CARDINAL; value: Tree) ;
BEGIN
   PreAddModGcc(sym, value) ;
   WatchRemoveList(sym, todolist) ;
   WatchIncludeList(sym, fullydeclared)
END DeclareConstantFromTree ;


(*
   DeclareCharConstant - declares a character constant.
*)

PROCEDURE DeclareCharConstant (sym: CARDINAL) ;
VAR
   location: location_t ;
BEGIN
   location := TokenToLocation(GetDeclaredMod(sym)) ;
   PreAddModGcc(sym, BuildCharConstant(location, KeyToCharStar(GetString(sym)))) ;
   WatchRemoveList(sym, todolist) ;
   WatchIncludeList(sym, fullydeclared)
END DeclareCharConstant ;


(*
   DeclareStringConstant - declares a string constant.
*)

PROCEDURE DeclareStringConstant (sym: CARDINAL) ;
VAR
   symtree : Tree ;
BEGIN
   IF IsConstStringM2nul (sym) OR IsConstStringCnul (sym)
   THEN
      (* in either case the string needs a nul terminator.  If the string
         is a C variant it will already have had any escape characters applied.
         The BuildCStringConstant only adds the nul terminator.  *)
      symtree := BuildCStringConstant (KeyToCharStar (GetString (sym)),
                                       GetStringLength (sym))
   ELSE
      symtree := BuildStringConstant (KeyToCharStar (GetString (sym)),
                                      GetStringLength (sym))
   END ;
   PreAddModGcc (sym, symtree) ;
   WatchRemoveList (sym, todolist) ;
   WatchIncludeList (sym, fullydeclared)
END DeclareStringConstant ;


(*
   PromoteToString - declare, sym, and then promote it to a string.
                     Note that if sym is a single character we do
                          *not* record it as a string
                          but as a char however we always
                          return a string constant.
*)

PROCEDURE PromoteToString (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
VAR
   size: CARDINAL ;
   ch  : CHAR ;
BEGIN
   DeclareConstant (tokenno, sym) ;
   IF IsConst (sym) AND (GetSType (sym) = Char)
   THEN
      PushValue (sym) ;
      ch := PopChar (tokenno) ;
      RETURN BuildCStringConstant (string (InitStringChar (ch)), 1)
   ELSE
      size := GetStringLength (sym) ;
      IF size > 1
      THEN
         (* will be a string anyway *)
         RETURN Tree (Mod2Gcc (sym))
      ELSE
         RETURN BuildStringConstant (KeyToCharStar (GetString (sym)),
                                     GetStringLength (sym))
      END
   END
END PromoteToString ;


(*
   WalkConstructor - walks all dependants of, sym.
*)

PROCEDURE WalkConstructor (sym: CARDINAL; p: WalkAction) ;
VAR
   type: CARDINAL ;
BEGIN
   type := GetSType(sym) ;
   IF type#NulSym
   THEN
      WalkDependants(type, p) ;
      WalkConstructorDependants(sym, p)
   END
END WalkConstructor ;


(*
   DeclareConstructor - declares a constructor.
*)

PROCEDURE DeclareConstructor (tokenno: CARDINAL; quad: CARDINAL; sym: CARDINAL) ;
BEGIN
   IF sym=NulSym
   THEN
      InternalError ('trying to declare the NulSym')
   END ;
   IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym))
   THEN
      WalkConstructor(sym, TraverseDependants) ;
      DeclareTypesConstantsProceduresInRange(quad, quad) ;
      Assert(IsConstructorDependants(sym, IsFullyDeclared)) ;
      PushValue(sym) ;
      DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
   END
END DeclareConstructor ;


(*
   TryDeclareConstructor - try and declare a constructor.  If, sym, is a
                           constructor try and declare it, if we cannot
                           then enter it into the to do list.
*)

PROCEDURE TryDeclareConstructor (tokenno: CARDINAL; sym: CARDINAL) ;
BEGIN
   IF sym#NulSym
   THEN
      IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym))
      THEN
         WalkConstructor(sym, TraverseDependants) ;
         IF NOT IsElementInSet(ToBeSolvedByQuads, sym)
         THEN
            TryEvaluateValue(sym) ;
            IF IsConstructorDependants(sym, IsFullyDeclared)
            THEN
               PushValue(sym) ;
               DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
            END
         END
      END
   END
END TryDeclareConstructor ;


(*
   WalkConst - walks all dependants of, sym.
*)

PROCEDURE WalkConst (sym: CARDINAL; p: WalkAction) ;
VAR
   type: CARDINAL ;
BEGIN
   Assert (IsConst (sym)) ;
   type := GetSType (sym) ;
   IF type # NulSym
   THEN
      p (type)
   END ;
   IF IsConstSet (sym) OR IsConstructor (sym)
   THEN
      WalkConstructor (sym, p)
   END
END WalkConst ;


(*
   IsConstDependants - returns TRUE if the symbol, sym,
                       q(dependants) all return TRUE.
*)

PROCEDURE IsConstDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   type: CARDINAL ;
BEGIN
   Assert (IsConst (sym)) ;
   type := GetSType (sym) ;
   IF type # NulSym
   THEN
      IF NOT q (type)
      THEN
         RETURN FALSE
      END
   END ;
   IF IsConstSet (sym) OR IsConstructor (sym)
   THEN
      RETURN IsConstructorDependants (sym, q)
   END ;
   RETURN IsValueSolved (sym)
END IsConstDependants ;


(*
   TryDeclareConstant - try and declare a constant.  If, sym, is a
                        constant try and declare it, if we cannot
                        then enter it into the to do list.
*)

PROCEDURE TryDeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ;
VAR
   type: CARDINAL ;
BEGIN
   TryDeclareConstructor(tokenno, sym) ;
   IF IsConst(sym)
   THEN
      TraverseDependants(sym) ;
      type := GetSType(sym) ;
      IF (type#NulSym) AND (NOT CompletelyResolved(type))
      THEN
         TraverseDependants(sym) ;
(*
         WatchIncludeList(sym, todolist) ;
         WatchIncludeList(type, todolist) ;
*)
         RETURN
      END ;
      IF IsConstructor(sym) AND (NOT IsConstructorConstant(sym))
      THEN
         TraverseDependants(sym) ;
(*
         WatchIncludeList(sym, todolist) ;
*)
         RETURN
      END ;
      IF (IsConstructor(sym) OR IsConstSet(sym)) AND (type=NulSym)
      THEN
(*
         WatchIncludeList(sym, todolist) ;
*)
         TraverseDependants(sym) ;
         RETURN
      END ;
      IF IsElementInSet(ToBeSolvedByQuads, sym)
      THEN
         (* we allow the above rules to be executed even if it is fully declared
            so to ensure that types of compiler builtin constants (BitsetSize
            etc) are fully declared.

            However at this point if, sym, is fully declared we return
         *)
         IF IsFullyDeclared(sym)
         THEN
            RETURN
         END ;
         TraverseDependants(sym) ;
(*
         WatchIncludeList(sym, todolist)
*)
      ELSE
         TryDeclareConst(tokenno, sym)
      END
   END
END TryDeclareConstant ;


(*
   DeclareConstant - checks to see whether, sym, is a constant and
                     declares the constant to gcc.
*)

PROCEDURE DeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ;
VAR
   type: CARDINAL ;
   t   : Tree ;
BEGIN
   IF IsConst(sym)
   THEN
      TraverseDependants(sym) ;
      type := GetSType(sym) ;
      Assert((type=NulSym) OR CompletelyResolved(type)) ;
      Assert((NOT IsConstructor(sym)) OR IsConstructorConstant(sym)) ;
      Assert((type#NulSym) OR (NOT (IsConstructor(sym) OR IsConstSet(sym)))) ;
      t := DeclareConst(tokenno, sym) ;
      Assert(t#NIL)
   END
END DeclareConstant ;


(*
   TryDeclareConst - try to declare a const to gcc.  If it cannot
                     declare the symbol it places it into the
                     todolist.
*)

PROCEDURE TryDeclareConst (tokenno: CARDINAL; sym: CARDINAL) ;
VAR
   type,
   size: CARDINAL ;
BEGIN
   IF NOT GccKnowsAbout(sym)
   THEN
      IF IsConstructor(sym) OR IsConstSet(sym)
      THEN
         WalkConstructorDependants(sym, TraverseDependants) ;
         TryEvaluateValue(sym) ;
         IF NOT IsConstructorDependants(sym, IsFullyDeclared)
         THEN
(*
            WatchIncludeList(sym, todolist) ;
*)
            TraverseDependants(sym) ;
            RETURN
         END ;
         IF NOT IsConstructorConstant(sym)
         THEN
            RETURN
         END
      END ;
      IF IsConstString(sym)
      THEN
         size := GetStringLength(sym) ;
         IF size=1
         THEN
            DeclareCharConstant(sym)
         ELSE
            DeclareStringConstant (sym)
         END
      ELSIF IsValueSolved(sym)
      THEN
         PushValue(sym) ;
         IF IsConstSet(sym)
         THEN
            DeclareConstantFromTree(sym, PopSetTree(tokenno))
         ELSIF IsConstructor(sym)
         THEN
            DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
         ELSIF IsRealType(GetDType(sym))
         THEN
            type := GetDType(sym) ;
            DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopRealTree(), TRUE))
         ELSIF IsComplexType(GetDType(sym))
         THEN
            type := GetDType(sym) ;
            DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopComplexTree(), TRUE))
         ELSE
            IF GetSType(sym)=NulSym
            THEN
               type := ZType
            ELSE
               type := GetDType(sym)
            END ;
            DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopIntegerTree(), TRUE))
         END
      ELSE
         TraverseDependants(sym)
      END
   END
END TryDeclareConst ;


(*
   DeclareConst - declares a const to gcc and returns a Tree.
*)

PROCEDURE DeclareConst (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
VAR
   type: CARDINAL ;
   size: CARDINAL ;
BEGIN
   IF GccKnowsAbout(sym)
   THEN
      RETURN( Mod2Gcc(sym) )
   END ;
   IF IsConstructor(sym) OR IsConstSet(sym)
   THEN
      EvaluateValue(sym)
   END ;
   IF IsConstString(sym)
   THEN
      size := GetStringLength(sym) ;
      IF size=1
      THEN
         DeclareCharConstant(sym)
      ELSE
         DeclareStringConstant (sym)
      END
   ELSIF IsValueSolved(sym)
   THEN
      PushValue(sym) ;
      IF IsConstSet(sym)
      THEN
         DeclareConstantFromTree(sym, PopSetTree(tokenno))
      ELSIF IsConstructor(sym)
      THEN
         DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
      ELSIF IsRealType(GetDType(sym))
      THEN
         type := GetDType(sym) ;
         DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopRealTree(), TRUE))
      ELSIF IsComplexType(GetDType(sym))
      THEN
         type := GetDType(sym) ;
         DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopComplexTree(), TRUE))
      ELSE
         IF GetSType(sym)=NulSym
         THEN
            type := ZType
         ELSE
            type := GetDType(sym)
         END ;
         DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopIntegerTree(), TRUE))
      END
   END ;
   IF GccKnowsAbout(sym)
   THEN
      RETURN( Mod2Gcc(sym) )
   ELSE
      RETURN( NIL )
   END
END DeclareConst ;


(*
   DeclareParameters -
*)

PROCEDURE DeclareParameters (sym: CARDINAL) ;
BEGIN
   DeclareUnboundedProcedureParameters(sym)
END DeclareParameters ;


VAR
   unboundedp: WalkAction ;


(*
   WalkFamilyOfUnbounded -
*)

PROCEDURE WalkFamilyOfUnbounded (oaf: CARDINAL <* unused *> ; dim: CARDINAL <* unused *> ; unbounded: CARDINAL) ;
BEGIN
   IF unbounded # NulSym
   THEN
      unboundedp (unbounded)
   END
END WalkFamilyOfUnbounded ;


(*
   WalkAssociatedUnbounded -
*)

PROCEDURE WalkAssociatedUnbounded (sym: CARDINAL; p: WalkAction) ;
VAR
   oaf: CARDINAL ;
   o  : WalkAction ;
BEGIN
   oaf := GetOAFamily(sym) ;
   o := unboundedp ;
   unboundedp := p ;
   ForeachOAFamily (oaf, WalkFamilyOfUnbounded) ;
   unboundedp := o
END WalkAssociatedUnbounded ;


(*
   WalkProcedureParameterDependants -
*)

(*
PROCEDURE WalkProcedureParameterDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   son,
   type,
   n, i: CARDINAL ;
BEGIN
   IF IsProcedure(sym)
   THEN
      n := NoOfParam(sym) ;
      i := n ;
      WHILE i>0 DO
         IF IsUnboundedParam(sym, i)
         THEN
            son := GetNthParam(sym, i)
         ELSE
            son := GetNth(sym, i) ;
         END ;
         type := GetSType(son) ;
         p(type) ;
         WalkDependants(type, p) ;
         DEC(i)
      END
   END
END WalkProcedureParameterDependants ;
*)


(*
   WalkDependants - walks through all dependants of, Sym,
                    calling, p, for each dependant.
*)

PROCEDURE WalkDependants (sym: CARDINAL; p: WalkAction) ;
BEGIN
   WalkAssociatedUnbounded(sym, p) ;
   IF IsComponent(sym)
   THEN
      WalkComponentDependants(sym, p)
   ELSIF IsEnumeration(sym)
   THEN
      WalkEnumerationDependants(sym, p)
   ELSIF IsSubrange(sym)
   THEN
      WalkSubrangeDependants(sym, p)
   ELSIF IsPointer(sym)
   THEN
      WalkPointerDependants(sym, p)
   ELSIF IsRecord(sym)
   THEN
      WalkRecordDependants(sym, p)
   ELSIF IsVarient(sym)
   THEN
      WalkVarientDependants(sym, p)
   ELSIF IsRecordField(sym)
   THEN
      WalkRecordFieldDependants(sym, p)
   ELSIF IsFieldVarient(sym)
   THEN
      WalkVarientFieldDependants(sym, p)
   ELSIF IsArray(sym)
   THEN
      WalkArrayDependants(sym, p)
   ELSIF IsProcType(sym)
   THEN
      WalkProcTypeDependants(sym, p)
   ELSIF IsUnbounded(sym)
   THEN
      WalkUnboundedDependants(sym, p)
   ELSIF IsSet(sym)
   THEN
      WalkSetDependants(sym, p)
   ELSIF IsType(sym)
   THEN
      WalkTypeDependants(sym, p)
   ELSIF IsConst(sym)
   THEN
      WalkConst(sym, p)
   ELSIF IsVar(sym)
   THEN
      WalkVarDependants(sym, p)
   ELSIF IsProcedure(sym)
   THEN
      WalkProcedureDependants(sym, p)
   END
END WalkDependants ;


(*
   TraverseDependantsInner -
*)

PROCEDURE TraverseDependantsInner (sym: WORD) ;
BEGIN
   IF (NOT IsElementInSet(FullyDeclared, sym)) AND
      (NOT IsElementInSet(ToDoList, sym))
   THEN
      WatchIncludeList(sym, todolist)
   END ;
   IF NOT IsElementInSet(VisitedList, sym)
   THEN
      IncludeElementIntoSet(VisitedList, sym) ;
      WalkDependants(sym, TraverseDependantsInner)
   END
END TraverseDependantsInner ;


(*
   TraverseDependants - walks, sym, dependants.  But it checks
                        to see that, sym, is not on the
                        FullyDeclared and not on the ToDoList.
*)

PROCEDURE TraverseDependants (sym: WORD) ;
BEGIN
   IF VisitedList=NIL
   THEN
      VisitedList := InitSet(1) ;
      TraverseDependantsInner(sym) ;
      VisitedList := KillSet(VisitedList)
   ELSE
      InternalError ('recursive call to TraverseDependants caught')
   END
END TraverseDependants ;


(*
   WalkTypeInfo - walks type, sym, and its dependants.
*)

PROCEDURE WalkTypeInfo (sym: WORD) ;
BEGIN
   IF IsVarient(sym)
   THEN
      InternalError ('why have we reached here?')
   ELSIF IsVar(sym)
   THEN
      WalkTypeInfo(GetSType(sym)) ;
      IF GetVarBackEndType(sym)#NulSym
      THEN
         WalkTypeInfo(GetVarBackEndType(sym))
      END
   ELSIF IsAModula2Type(sym)
   THEN
      TraverseDependants(sym)
   END
END WalkTypeInfo ;


(*
   DeclareUnboundedProcedureParameters -
*)

PROCEDURE DeclareUnboundedProcedureParameters (sym: WORD) ;
VAR
   son, type,
   p, i     : CARDINAL ;
   location : location_t ;
BEGIN
   IF IsProcedure(sym)
   THEN
      p := NoOfParam(sym) ;
      i := p ;
      WHILE i>0 DO
         IF IsUnboundedParam(sym, i)
         THEN
            son := GetNthParam(sym, i) ;
            type := GetSType(son) ;
            TraverseDependants(type) ;
            IF GccKnowsAbout(type)
            THEN
               location := TokenToLocation(GetDeclaredMod(type)) ;
               BuildTypeDeclaration(location, Mod2Gcc(type))
            END
         ELSE
            son := GetNth(sym, i) ;
            type := GetSType(son) ;
            TraverseDependants(type)
         END ;
         DEC(i)
      END
   END
END DeclareUnboundedProcedureParameters ;


(*
   WalkUnboundedProcedureParameters -
*)

PROCEDURE WalkUnboundedProcedureParameters (sym: WORD) ;
VAR
   son,
   type,
   p, i: CARDINAL ;
BEGIN
   IF IsProcedure(sym)
   THEN
      p := NoOfParam(sym) ;
      i := p ;
      WHILE i>0 DO
         IF IsUnboundedParam(sym, i)
         THEN
            son := GetNthParam(sym, i) ;
            type := GetSType(son) ;
            WalkTypeInfo(type) ;
(*
            type := GetUnboundedRecordType(type) ;
            Assert(IsRecord(type)) ;
            RecordNotPacked(type)      (* which is never packed.                   *)
*)
         ELSE
            son := GetNth(sym, i) ;
            type := GetSType(son) ;
            WalkTypeInfo(type)
         END ;
         DEC(i)
      END
   END
END WalkUnboundedProcedureParameters ;


(*
   WalkTypesInProcedure - walk all types in procedure, Sym.
*)

PROCEDURE WalkTypesInProcedure (sym: WORD) ;
BEGIN
   ForeachLocalSymDo(sym, TraverseDependants)
END WalkTypesInProcedure ;


(*
   WalkTypesInModule - declare all types in module, Sym, to GCC.
*)

PROCEDURE WalkTypesInModule (sym: WORD) ;
VAR
   n: Name ;
BEGIN
   IF Debugging
   THEN
      n := GetSymName(sym) ;
      printf1('Declaring types in MODULE %a\n', n)
   END ;
   ForeachLocalSymDo(sym, WalkTypeInfo) ;
   ForeachLocalSymDo(sym, WalkUnboundedProcedureParameters) ;
   ForeachInnerModuleDo(sym, WalkTypesInModule)
END WalkTypesInModule ;


(*
   IsRecordFieldDependants - returns TRUE if the record field
                             symbol, sym, p(dependants) all return TRUE.
*)

PROCEDURE IsRecordFieldDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   align: CARDINAL ;
   final: BOOLEAN ;
BEGIN
   final := TRUE ;
   IF NOT q(GetSType(sym))
   THEN
      final := FALSE
   END ;
   align := GetAlignment(sym) ;
   IF (align#NulSym) AND (NOT q(align))
   THEN
      final := FALSE
   END ;
   RETURN( final )
END IsRecordFieldDependants ;


(*
   GetModuleWhereDeclared - returns the module where, Sym, was created.
*)

PROCEDURE GetModuleWhereDeclared (sym: CARDINAL) : CARDINAL ;
VAR
   s: CARDINAL ;
BEGIN
   s := GetScope(sym) ;
   IF (s=NulSym) OR IsDefImp(s) OR
      (IsModule(s) AND (GetScope(s)=NulSym))
   THEN
      RETURN( s )
   ELSE
      RETURN( GetModuleWhereDeclared(s) )
   END
END GetModuleWhereDeclared ;


(*
   IsPseudoProcFunc - returns TRUE if Sym is a pseudo function or procedure.
*)

PROCEDURE IsPseudoProcFunc (Sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN(
          IsPseudoBaseProcedure(Sym) OR IsPseudoBaseFunction(Sym) OR
          IsPseudoSystemFunction(Sym)
         )
END IsPseudoProcFunc ;


(*
   IsProcedureGccNested - returns TRUE if procedure, sym, will be considered
                          as nested by GCC.
                          This will occur if either its outer defining scope
                          is a procedure or is a module which is inside a
                          procedure.
*)

PROCEDURE IsProcedureGccNested (sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN(
          IsProcedureNested(sym) OR
          (IsModule(GetScope(sym)) AND IsModuleWithinProcedure(GetScope(sym)))
         )
END IsProcedureGccNested ;


(*
   IsExternal -
*)

PROCEDURE IsExternal (sym: CARDINAL) : BOOLEAN ;
VAR
   mod: CARDINAL ;
BEGIN
   Assert (NOT IsDefImp (sym)) ;
   IF IsProcedure (sym) AND IsExtern (sym)
   THEN
     RETURN TRUE
   END ;
   mod := GetScope(sym) ;
   REPEAT
      IF mod=NulSym
      THEN
         RETURN( FALSE )
      ELSIF IsDefImp(mod)
      THEN
         RETURN( mod#GetMainModule() )
      END ;
      mod := GetScope(mod)
   UNTIL mod=NulSym ;
   RETURN( FALSE )
END IsExternal ;


(*
   IsExternalToWholeProgram - return TRUE if the symbol, sym, is external to the
                              sources that we have parsed.
*)

PROCEDURE IsExternalToWholeProgram (sym: CARDINAL) : BOOLEAN ;
VAR
   mod: CARDINAL ;
BEGIN
   mod := GetScope(sym) ;
   REPEAT
      IF mod=NulSym
      THEN
         RETURN( FALSE )
      ELSIF IsDefImp(mod)
      THEN
         (* return TRUE if we have no source file.  *)
         RETURN( GetModuleFile(mod)=NIL )
      END ;
      mod := GetScope(mod)
   UNTIL mod=NulSym ;
   RETURN( FALSE )
END IsExternalToWholeProgram ;


(*
   DeclareProcedureToGccWholeProgram -
*)

PROCEDURE DeclareProcedureToGccWholeProgram (Sym: CARDINAL) ;
VAR
   returnType,
   GccParam  : Tree ;
   scope,
   Son,
   p, i      : CARDINAL ;
   b, e      : CARDINAL ;
   begin, end,
   location  : location_t ;
BEGIN
   IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym))
   THEN
      BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ;
      p := NoOfParam(Sym) ;
      i := p ;
      WHILE i>0 DO
         (* note we dont use GetNthParam as we want the parameter that is seen by the procedure block
            remember that this is treated exactly the same as a variable, just its position on
            the activation record is special (ie a parameter)
         *)
         Son := GetNth(Sym, i) ;
         location := TokenToLocation(GetDeclaredMod(Son)) ;
         IF IsUnboundedParam(Sym, i)
         THEN
            GccParam := BuildParameterDeclaration(location,
                                                  KeyToCharStar(GetSymName(Son)),
                                                  Mod2Gcc(GetLType(Son)),
                                                  FALSE)
         ELSE
            GccParam := BuildParameterDeclaration(location,
                                                  KeyToCharStar(GetSymName(Son)),
                                                  Mod2Gcc(GetLType(Son)),
                                                  IsVarParam(Sym, i))
         END ;
         PreAddModGcc(Son, GccParam) ;
         WatchRemoveList(Son, todolist) ;
         WatchIncludeList(Son, fullydeclared) ;
         DEC(i)
      END ;
      GetProcedureBeginEnd(Sym, b, e) ;
      begin := TokenToLocation(b) ;
      end := TokenToLocation(e) ;
      scope := GetScope(Sym) ;
      PushBinding(scope) ;
      IF GetSType(Sym)=NulSym
      THEN
         returnType := NIL
      ELSE
         returnType := Mod2Gcc(GetSType(Sym))
      END ;
      PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end,
                                                    KeyToCharStar(GetFullSymName(Sym)),
                                                    returnType,
                                                    IsExternalToWholeProgram(Sym),
                                                    IsProcedureGccNested(Sym),
                                                    IsExported(GetModuleWhereDeclared(Sym), Sym),
                                                    IsProcedureNoReturn(Sym))) ;
      PopBinding(scope) ;
      WatchRemoveList(Sym, todolist) ;
      WatchIncludeList(Sym, fullydeclared)
   END
END DeclareProcedureToGccWholeProgram ;


(*
   DeclareProcedureToGccSeparateProgram -
*)

PROCEDURE DeclareProcedureToGccSeparateProgram (Sym: CARDINAL) ;
VAR
   returnType,
   GccParam  : Tree ;
   scope,
   Son,
   p, i      : CARDINAL ;
   b, e      : CARDINAL ;
   begin, end,
   location  : location_t ;
   tok       : CARDINAL ;
BEGIN
   tok := GetDeclaredMod(Sym) ;
   IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym)) AND
      (IsEffectivelyImported(GetMainModule(), Sym) OR
       (GetModuleWhereDeclared (Sym) = GetMainModule()) OR
       IsNeededAtRunTime (tok, Sym) OR
       IsImported (GetBaseModule (), Sym) OR
       IsExported(GetModuleWhereDeclared (Sym), Sym) OR
       IsExtern (Sym))
   THEN
      BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ;
      p := NoOfParam(Sym) ;
      i := p ;
      WHILE i>0 DO
         (* note we dont use GetNthParam as we want the parameter that is seen by
            the procedure block remember that this is treated exactly the same as
            a variable, just its position on the activation record is special (ie
            a parameter).  *)
         Son := GetNth(Sym, i) ;
         location := TokenToLocation(GetDeclaredMod(Son)) ;
         IF IsUnboundedParam(Sym, i)
         THEN
            GccParam := BuildParameterDeclaration(location,
                                                  KeyToCharStar(GetSymName(Son)),
                                                  Mod2Gcc(GetLType(Son)),
                                                  FALSE)
         ELSE
            GccParam := BuildParameterDeclaration(location,
                                                  KeyToCharStar(GetSymName(Son)),
                                                  Mod2Gcc(GetLType(Son)),
                                                  IsVarParam(Sym, i))
         END ;
         PreAddModGcc(Son, GccParam) ;
         WatchRemoveList(Son, todolist) ;
         WatchIncludeList(Son, fullydeclared) ;
         DEC(i)
      END ;
      GetProcedureBeginEnd(Sym, b, e) ;
      begin := TokenToLocation(b) ;
      end := TokenToLocation(e) ;
      scope := GetScope(Sym) ;
      PushBinding(scope) ;
      IF GetSType(Sym)=NulSym
      THEN
         returnType := NIL
      ELSE
         returnType := Mod2Gcc(GetSType(Sym))
      END ;
      PreAddModGcc (Sym, BuildEndFunctionDeclaration (begin, end,
                                                      KeyToCharStar (GetFullSymName (Sym)),
                                                      returnType,
                                                      IsExternal (Sym),  (* Extern relative to the main module.  *)
                                                      IsProcedureGccNested (Sym),
                                                      (* Exported from the module where it was declared.  *)
                                                      IsExported (GetModuleWhereDeclared (Sym), Sym) OR IsExtern (Sym),
                                                      IsProcedureNoReturn(Sym))) ;
      PopBinding(scope) ;
      WatchRemoveList(Sym, todolist) ;
      WatchIncludeList(Sym, fullydeclared)
   END
END DeclareProcedureToGccSeparateProgram ;


(*
   DeclareProcedureToGcc - traverses all parameters and interfaces to gm2gcc.
*)

PROCEDURE DeclareProcedureToGcc (sym: CARDINAL) ;
BEGIN
   IF sym # NulSym
   THEN
      IF WholeProgram
      THEN
         DeclareProcedureToGccWholeProgram (sym)
      ELSE
         DeclareProcedureToGccSeparateProgram (sym)
      END
   END
END DeclareProcedureToGcc ;


(*
   DeclareProcedure - declares procedure, sym, or all procedures inside
                      module sym.
*)

PROCEDURE DeclareProcedure (sym: WORD) ;
BEGIN
   IF IsProcedure(sym)
   THEN
      DeclareProcedureToGcc(sym)
   ELSIF IsModule(sym) OR IsDefImp(sym)
   THEN
      ForeachProcedureDo(sym, DeclareProcedure)
   ELSE
      InternalError ('expecting procedure')
   END
END DeclareProcedure ;


(*
   FoldConstants - a wrapper for ResolveConstantExpressions.
*)

PROCEDURE FoldConstants (start, end: CARDINAL) ;
BEGIN
   IF ResolveConstantExpressions(DeclareConstFully, start, end)
   THEN
   END
END FoldConstants ;


(*
   DeclareTypesConstantsProceduresInRange -
*)

PROCEDURE DeclareTypesConstantsProceduresInRange (start, end: CARDINAL) ;
VAR
   n, m: CARDINAL ;
BEGIN
   IF DisplayQuadruples
   THEN
      DisplayQuadRange(start, end)
   END ;
   REPEAT
      n := NoOfElementsInSet(ToDoList) ;
      WHILE ResolveConstantExpressions(DeclareConstFully, start, end) DO
      END ;
      (* we need to evaluate some constant expressions to resolve these types *)
      IF DeclaredOutstandingTypes (FALSE)
      THEN
      END ;
      m := NoOfElementsInSet(ToDoList)
   UNTIL (NOT ResolveConstantExpressions(DeclareConstFully, start, end)) AND
         (n=m)
END DeclareTypesConstantsProceduresInRange ;


(*
   SkipModuleScope - skips all module scopes for, scope.
                     It returns either NulSym or a procedure sym.
*)

PROCEDURE SkipModuleScope (scope: CARDINAL) : CARDINAL ;
BEGIN
   IF (scope=NulSym) OR IsProcedure(scope)
   THEN
      RETURN( scope )
   ELSE
      RETURN( SkipModuleScope(GetScope(scope)) )
   END
END SkipModuleScope ;


(*
   PushBinding -
*)

PROCEDURE PushBinding (scope: CARDINAL) ;
BEGIN
   scope := SkipModuleScope(scope) ;
   IF scope=NulSym
   THEN
      pushGlobalScope
   ELSE
      pushFunctionScope(Mod2Gcc(scope))
   END
END PushBinding ;


(*
   PopBinding -
*)

PROCEDURE PopBinding (scope: CARDINAL) ;
BEGIN
   scope := SkipModuleScope(scope) ;
   IF scope=NulSym
   THEN
      popGlobalScope
   ELSE
      Assert(IsProcedure(scope)) ;
      finishFunctionDecl(TokenToLocation(GetDeclaredMod(scope)), Mod2Gcc(scope)) ;
      Assert (popFunctionScope () # NIL)
   END
END PopBinding ;


(*
   DeclareTypesConstantsProcedures -
*)

PROCEDURE DeclareTypesConstantsProcedures (scope: CARDINAL) ;
VAR
   s, t: CARDINAL ;
   sb  : ScopeBlock ;
BEGIN
   sb := InitScopeBlock(scope) ;
   PushBinding(scope) ;
   REPEAT
      s := NoOfElementsInSet(ToDoList) ;
      (* ForeachLocalSymDo(scope, DeclareTypeInfo) ; *)
      ForeachScopeBlockDo(sb, DeclareTypesConstantsProceduresInRange) ;
      t := NoOfElementsInSet(ToDoList) ;
   UNTIL s=t ;
   PopBinding(scope) ;
   KillScopeBlock(sb)
END DeclareTypesConstantsProcedures ;


(*
   AssertAllTypesDeclared - asserts that all types for variables are declared in, scope.
*)

PROCEDURE AssertAllTypesDeclared (scope: CARDINAL) ;
VAR
   n, Var: CARDINAL ;
   failed: BOOLEAN ;
BEGIN
   failed := FALSE ;
   n := 1 ;
   Var := GetNth(scope, n) ;
   WHILE Var#NulSym DO
      IF NOT AllDependantsFullyDeclared(GetSType(Var))
      THEN
         mystop
      END ;
      IF NOT AllDependantsFullyDeclared(GetSType(Var))
      THEN
         EmitCircularDependancyError(GetSType(Var)) ;
         failed := TRUE
      END ;
      INC(n) ;
      Var := GetNth(scope, n)
   END ;
   IF failed
   THEN
      FlushErrors
   END
END AssertAllTypesDeclared ;


(*
   DeclareModuleInit - declare all the ctor related functions within
                       a module.
*)

PROCEDURE DeclareModuleInit (moduleSym: WORD) ;
VAR
   ctor, init, fini, dep: CARDINAL ;
BEGIN
   GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
   DeclareProcedureToGcc (ctor) ;
   DeclareProcedureToGcc (init) ;
   DeclareProcedureToGcc (fini) ;
   DeclareProcedureToGcc (dep)
END DeclareModuleInit ;


(*
   StartDeclareProcedureScope -
*)

PROCEDURE StartDeclareProcedureScope (scope: CARDINAL) ;
BEGIN
   WalkTypesInProcedure(scope) ;
   DeclareProcedure(scope) ;
   ForeachInnerModuleDo(scope, WalkTypesInModule) ;
   DeclareTypesConstantsProcedures(scope) ;
   ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
   DeclareLocalVariables(scope) ;
   ForeachInnerModuleDo(scope, DeclareModuleVariables) ;
   AssertAllTypesDeclared(scope) ;
   ForeachProcedureDo(scope, DeclareProcedure) ;
   ForeachInnerModuleDo(scope, StartDeclareScope)
END StartDeclareProcedureScope ;


(*
   StartDeclareModuleScopeSeparate -
*)

PROCEDURE StartDeclareModuleScopeSeparate (scope: CARDINAL) ;
BEGIN
   IF scope=GetMainModule()
   THEN
      ForeachModuleDo(WalkTypesInModule) ;     (* will populate the TYPE and CONST ToDo list  *)
      DeclareTypesConstantsProcedures(scope) ; (* will resolved TYPEs and CONSTs on the ToDo  *)
                                               (* lists.                                      *)
      ForeachModuleDo(DeclareProcedure) ;
      (*
         now that all types have been resolved it is safe to declare
         variables
      *)
      AssertAllTypesDeclared(scope) ;
      DeclareGlobalVariables(scope) ;
      ForeachImportedDo(scope, DeclareImportedVariables) ;
      (* now it is safe to declare all procedures *)
      ForeachProcedureDo(scope, DeclareProcedure) ;
      ForeachInnerModuleDo(scope, WalkTypesInModule) ;
      ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
      ForeachInnerModuleDo(scope, StartDeclareScope) ;
      DeclareModuleInit(scope)
   ELSE
      DeclareTypesConstantsProcedures(scope) ;
      AssertAllTypesDeclared(scope) ;
      ForeachProcedureDo(scope, DeclareProcedure) ;
      DeclareModuleInit(scope) ;
      ForeachInnerModuleDo(scope, StartDeclareScope)
   END
END StartDeclareModuleScopeSeparate ;


(*
   StartDeclareModuleScopeWholeProgram -
*)

PROCEDURE StartDeclareModuleScopeWholeProgram (scope: CARDINAL) ;
BEGIN
   IF IsSourceSeen(scope)
   THEN
      ForeachModuleDo(WalkTypesInModule) ;     (* will populate the TYPE and CONST ToDo list  *)
      DeclareTypesConstantsProcedures(scope) ; (* will resolved TYPEs and CONSTs on the ToDo  *)
                                               (* lists.                                      *)
      ForeachModuleDo(DeclareProcedure) ;
      ForeachModuleDo(DeclareModuleInit) ;
      (*
         now that all types have been resolved it is safe to declare
         variables
      *)
      AssertAllTypesDeclared(scope) ;
      DeclareGlobalVariablesWholeProgram(scope) ;
      ForeachImportedDo(scope, DeclareImportedVariablesWholeProgram) ;
      (* now it is safe to declare all procedures *)
      ForeachProcedureDo(scope, DeclareProcedure) ;
      ForeachInnerModuleDo(scope, WalkTypesInModule) ;
      ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
      ForeachInnerModuleDo(scope, StartDeclareScope) ;
      DeclareModuleInit(scope)
   ELSE
      DeclareTypesConstantsProcedures(scope) ;
      AssertAllTypesDeclared(scope) ;
      ForeachProcedureDo(scope, DeclareProcedure) ;
      DeclareModuleInit(scope) ;
      ForeachInnerModuleDo(scope, StartDeclareScope)
   END
END StartDeclareModuleScopeWholeProgram ;


(*
   StartDeclareModuleScope -
*)

PROCEDURE StartDeclareModuleScope (scope: CARDINAL) ;
BEGIN
   IF WholeProgram
   THEN
      StartDeclareModuleScopeWholeProgram(scope)
   ELSE
      StartDeclareModuleScopeSeparate(scope)
   END
END StartDeclareModuleScope ;


(*
   StartDeclareScope - declares types, variables associated with this scope.
*)

PROCEDURE StartDeclareScope (scope: CARDINAL) ;
VAR
   n: Name ;
BEGIN
   (* AddSymToWatch (1265) ;  *)
   (* AddSymToWatch (1157) ;  *)  (* watch goes here *)
   (* AddSymToWatch(TryFindSymbol('IOLink', 'DeviceId')) ; *)
   (* AddSymToWatch(819) ; *)
   (*
   AddSymToWatch(2125) ;  (* watch goes here *)
   DebugSets ;
    *)
   (*
   AddSymToWatch(2125) ;  (* watch goes here *)
   *)
   (*
   IncludeElementIntoSet(WatchList, 369) ;
   IncludeElementIntoSet(WatchList, 709) ;
   *)
   (*
   IncludeElementIntoSet(WatchList, 1006) ;
    *)
   (* AddSymToWatch(8) ; *)
   (* IncludeElementIntoSet(WatchList, 4188) ; *)
   (* AddSymToWatch(1420) ; *)
   (* AddSymToWatch(5889) ; *)
   (* IncludeElementIntoSet(WatchList, 717) ; *)
   (* IncludeElementIntoSet(WatchList, 829) ; *)
   (* IncludeElementIntoSet(WatchList, 2714) ; *)
   (* IncludeElementIntoSet(WatchList, 23222) ; *)
   (* IncludeElementIntoSet(WatchList, 1104) ; *)
   (* IncludeElementIntoSet(WatchList, 859) ; *)
   (* IncludeElementIntoSet(WatchList, 858) ; *)

   (* IncludeElementIntoSet(WatchList, 720) ; *)
   (* IncludeElementIntoSet(WatchList, 706) ; *)
   (* IncludeElementIntoSet(WatchList, 1948) ; *)
   (* IncludeElementIntoSet(WatchList, 865) ; *)

   IF Debugging
   THEN
      n := GetSymName (scope) ;
      printf1 ('declaring symbols in BLOCK %a\n', n)
   END ;
   IF IsProcedure (scope)
   THEN
      StartDeclareProcedureScope (scope)
   ELSE
      StartDeclareModuleScope (scope)
   END ;
   IF Debugging
   THEN
      n := GetSymName (scope) ;
      printf1('\nEND declaring symbols in BLOCK %a\n', n)
   END
END StartDeclareScope ;


(*
   EndDeclareScope -
*)

PROCEDURE EndDeclareScope ;
BEGIN
   (* no need to do anything *)
END EndDeclareScope ;


(*
   PreAddModGcc - adds a relationship between sym and t.
                  It also determines whether an unbounded
                  for sym is required and if so this is also
                  created.
*)

PROCEDURE PreAddModGcc (sym: CARDINAL; t: Tree) ;
BEGIN
   AddModGcc(sym, t)
END PreAddModGcc ;


(*
   DeclareDefaultType - declares a default type, sym, with, name.
*)

PROCEDURE DeclareDefaultType (sym: CARDINAL; name: ARRAY OF CHAR; gcctype: Tree) ;
VAR
   t        : Tree ;
   high, low: CARDINAL ;
   location : location_t ;
BEGIN
   (* DeclareDefaultType will declare a new identifier as a type of, gcctype, if it has not already been
      declared by gccgm2.c *)
   location := BuiltinsLocation () ;
   t := GetDefaultType(location, KeyToCharStar(MakeKey(name)), gcctype) ;
   AddModGcc(sym, t) ;
   IncludeElementIntoSet(FullyDeclared, sym) ;
   WalkAssociatedUnbounded(sym, TraverseDependants) ;
   (*
      this is very simplistic and assumes that the caller only uses Subranges, Sets and GCC types.
      We need to declare any constants with the types so that AllDependantsFullyDeclared works.
   *)
   IF IsSubrange(sym)
   THEN
      GetSubrange(sym, high, low) ;
      DeclareConstant(GetDeclaredMod(sym), high) ;
      DeclareConstant(GetDeclaredMod(sym), low)
   ELSIF IsSet(sym)
   THEN
      IF IsSubrange(GetSType(sym))
      THEN
         IF NOT GccKnowsAbout(GetSType(sym))
         THEN
            (* only true for internal types of course *)
            InternalError ('subrange type within the set type must be declared before the set type')
         END ;
         GetSubrange(GetSType(sym), high, low) ;
         DeclareConstant(GetDeclaredMod(sym), high) ;
         DeclareConstant(GetDeclaredMod(sym), low)
      ELSIF IsEnumeration(GetSType(sym))
      THEN
         IF NOT GccKnowsAbout(GetSType(sym))
         THEN
            (* only true for internal types of course *)
            InternalError ('enumeration type within the set type must be declared before the set type')
         END
      END
   END
END DeclareDefaultType ;


(*
   DeclareBoolean - declares the Boolean type together with true and false.
*)

PROCEDURE DeclareBoolean ;
BEGIN
   AddModGcc(Boolean, GetBooleanType()) ;
   AddModGcc(True, GetBooleanTrue()) ;
   AddModGcc(False, GetBooleanFalse()) ;
   IncludeElementIntoSet(FullyDeclared, Boolean) ;
   IncludeElementIntoSet(FullyDeclared, True) ;
   IncludeElementIntoSet(FullyDeclared, False) ;
   WalkAssociatedUnbounded(Boolean, TraverseDependants)
END DeclareBoolean ;


(*
   DeclareFixedSizedType - declares the GNU Modula-2 fixed types
                           (if the back end support such a type).
*)

PROCEDURE DeclareFixedSizedType (name: ARRAY OF CHAR; type: CARDINAL; t: Tree) ;
VAR
   location : location_t ;
   typetype,
   low, high: CARDINAL ;
BEGIN
   IF type#NulSym
   THEN
      IF IsSet(type) AND (NOT GccKnowsAbout(GetSType(type)))
      THEN
         typetype := GetSType(type) ;
         GetSubrange(typetype, high, low) ;
         DeclareConstant(GetDeclaredMod(type), high) ;
         DeclareConstant(GetDeclaredMod(type), low) ;
         location := TokenToLocation(GetDeclaredMod(typetype)) ;
         PreAddModGcc(typetype, BuildSubrangeType(location,
                                                  KeyToCharStar(GetFullSymName(typetype)),
                                                  Mod2Gcc(GetSType(typetype)),
                                                  Mod2Gcc(low), Mod2Gcc(high))) ;
         IncludeElementIntoSet(FullyDeclared, typetype) ;
         WalkAssociatedUnbounded(typetype, TraverseDependants)
      END ;
      (* gcc back end supports, type *)
      DeclareDefaultType(type, name, t)
   END
END DeclareFixedSizedType ;


(*
   DeclareDefaultSimpleTypes - declares the simple types.
*)

PROCEDURE DeclareDefaultSimpleTypes ;
BEGIN
   AddModGcc(ZType, GetM2ZType()) ;
   AddModGcc(RType, GetM2RType()) ;
   AddModGcc(CType, GetM2CType()) ;
   IncludeElementIntoSet(FullyDeclared, ZType) ;
   IncludeElementIntoSet(FullyDeclared, RType) ;
   IncludeElementIntoSet(FullyDeclared, CType) ;

   DeclareDefaultType(Cardinal    , "CARDINAL"    , GetM2CardinalType()) ;
   DeclareDefaultType(Integer     , "INTEGER"     , GetM2IntegerType()) ;
   DeclareDefaultType(Char        , "CHAR"        , GetM2CharType()) ;
   DeclareDefaultType(Loc         , "LOC"         , GetISOLocType()) ;

   IF Iso
   THEN
      DeclareDefaultType(Byte     , "BYTE"        , GetISOByteType()) ;
      DeclareDefaultType(Word     , "WORD"        , GetISOWordType())
   ELSE
      DeclareDefaultType(Byte     , "BYTE"        , GetByteType()) ;
      DeclareDefaultType(Word     , "WORD"        , GetWordType())
   END ;

   DeclareDefaultType(Proc        , "PROC"        , GetProcType()) ;
   DeclareDefaultType(Address     , "ADDRESS"     , GetPointerType()) ;
   DeclareDefaultType(LongInt     , "LONGINT"     , GetM2LongIntType()) ;
   DeclareDefaultType(LongCard    , "LONGCARD"    , GetM2LongCardType()) ;
   DeclareDefaultType(ShortInt    , "SHORTINT"    , GetM2ShortIntType()) ;
   DeclareDefaultType(ShortCard   , "SHORTCARD"   , GetM2ShortCardType()) ;
   DeclareDefaultType(ShortReal   , "SHORTREAL"   , GetM2ShortRealType()) ;
   DeclareDefaultType(Real        , "REAL"        , GetM2RealType()) ;
   DeclareDefaultType(LongReal    , "LONGREAL"    , GetM2LongRealType()) ;
   DeclareDefaultType(Bitnum      , "BITNUM"      , GetBitnumType()) ;
   DeclareDefaultType(Bitset      , "BITSET"      , GetBitsetType()) ;
   DeclareDefaultType(Complex     , "COMPLEX"     , GetM2ComplexType()) ;
   DeclareDefaultType(LongComplex , "LONGCOMPLEX" , GetM2LongComplexType()) ;
   DeclareDefaultType(ShortComplex, "SHORTCOMPLEX", GetM2ShortComplexType()) ;
   DeclareDefaultType(CSizeT      , "CSIZE_T"     , GetCSizeTType()) ;
   DeclareDefaultType(CSSizeT     , "CSSIZE_T"    , GetCSSizeTType()) ;

   DeclareBoolean ;

   DeclareFixedSizedType("INTEGER8"  , IntegerN(8)  , GetM2Integer8()) ;
   DeclareFixedSizedType("INTEGER16" , IntegerN(16) , GetM2Integer16()) ;
   DeclareFixedSizedType("INTEGER32" , IntegerN(32) , GetM2Integer32()) ;
   DeclareFixedSizedType("INTEGER64" , IntegerN(64) , GetM2Integer64()) ;
   DeclareFixedSizedType("CARDINAL8" , CardinalN(8) , GetM2Cardinal8()) ;
   DeclareFixedSizedType("CARDINAL16", CardinalN(16), GetM2Cardinal16()) ;
   DeclareFixedSizedType("CARDINAL32", CardinalN(32), GetM2Cardinal32()) ;
   DeclareFixedSizedType("CARDINAL64", CardinalN(64), GetM2Cardinal64()) ;
   DeclareFixedSizedType("WORD16"    , WordN(16)    , GetM2Word16()) ;
   DeclareFixedSizedType("WORD32"    , WordN(32)    , GetM2Word32()) ;
   DeclareFixedSizedType("WORD64"    , WordN(64)    , GetM2Word64()) ;
   DeclareFixedSizedType("BITSET8"   , SetN(8)      , GetM2Bitset8()) ;
   DeclareFixedSizedType("BITSET16"  , SetN(16)     , GetM2Bitset16()) ;
   DeclareFixedSizedType("BITSET32"  , SetN(32)     , GetM2Bitset32()) ;
   DeclareFixedSizedType("REAL32"    , RealN(32)    , GetM2Real32()) ;
   DeclareFixedSizedType("REAL64"    , RealN(64)    , GetM2Real64()) ;
   DeclareFixedSizedType("REAL96"    , RealN(96)    , GetM2Real96()) ;
   DeclareFixedSizedType("REAL128"   , RealN(128)   , GetM2Real128()) ;
   DeclareFixedSizedType("COMPLEX32" , ComplexN(32) , GetM2Complex32()) ;
   DeclareFixedSizedType("COMPLEX64" , ComplexN(64) , GetM2Complex64()) ;
   DeclareFixedSizedType("COMPLEX96" , ComplexN(96) , GetM2Complex96()) ;
   DeclareFixedSizedType("COMPLEX128", ComplexN(128), GetM2Complex128())
END DeclareDefaultSimpleTypes ;


(*
   DeclarePackedBoolean -
*)

PROCEDURE DeclarePackedBoolean ;
VAR
   e: CARDINAL ;
BEGIN
   e := GetPackedEquivalent(Boolean) ;
   AddModGcc(e, GetPackedBooleanType()) ;
   IncludeElementIntoSet(FullyDeclared, e)
END DeclarePackedBoolean ;


(*
   DeclarePackedDefaultSimpleTypes -
*)

PROCEDURE DeclarePackedDefaultSimpleTypes ;
BEGIN
   DeclarePackedBoolean
END DeclarePackedDefaultSimpleTypes ;


(*
   DeclareDefaultTypes - makes default types known to GCC
*)

PROCEDURE DeclareDefaultTypes ;
BEGIN
   IF NOT HaveInitDefaultTypes
   THEN
      HaveInitDefaultTypes := TRUE ;
      pushGlobalScope ;
      DeclareDefaultSimpleTypes ;
      DeclarePackedDefaultSimpleTypes ;
      popGlobalScope
   END
END DeclareDefaultTypes ;


(*
   DeclareDefaultConstants - make default constants known to GCC
*)

PROCEDURE DeclareDefaultConstants ;
BEGIN
   AddModGcc(Nil, GetPointerZero(BuiltinsLocation ())) ;
   IncludeElementIntoSet(FullyDeclared, Nil)
END DeclareDefaultConstants ;


(*
   FindContext - returns the scope where the symbol
                 should be created.

                 Symbols created in a module will
                 return the global context tree, but symbols created
                 in a module which is declared inside
                 a procedure will return the procedure Tree.
*)

PROCEDURE FindContext (sym: CARDINAL) : Tree ;
BEGIN
   sym := GetProcedureScope(sym) ;
   IF sym=NulSym
   THEN
      RETURN( GetGlobalContext() )
   ELSE
      RETURN( Mod2Gcc(sym) )
   END
END FindContext ;


(*
   IsEffectivelyImported - returns TRUE if symbol, Sym, was
                           effectively imported into ModSym.
*)

PROCEDURE IsEffectivelyImported (ModSym, sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN(
          IsImported(ModSym, sym) OR
          (IsImported(ModSym, GetModuleWhereDeclared(sym)) AND
           IsExported(GetModuleWhereDeclared(sym), sym))
         )
END IsEffectivelyImported ;


(*
   FindOuterModule - returns the out most module where, sym,
                     was declared.  It returns NulSym if the
                     symbol or the module was declared inside
                     a procedure.
*)

PROCEDURE FindOuterModule (sym: CARDINAL) : CARDINAL ;
BEGIN
   sym := GetScope(sym) ;
   WHILE (NOT IsDefImp(sym)) DO
      IF IsModule(sym)
      THEN
         IF GetScope(sym)=NulSym
         THEN
            RETURN( sym )
         ELSE
            sym := GetScope(sym)
         END
      ELSIF IsProcedure(sym)
      THEN
         sym := GetScope(sym)
      END
   END ;
   RETURN( sym )
END FindOuterModule ;


(*
   DoVariableDeclaration - create a corresponding gcc variable and add the association
                           between the front end symbol var and the gcc tree.
*)

PROCEDURE DoVariableDeclaration (var: CARDINAL; name: ADDRESS;
                                 isImported, isExported,
                                 isTemporary, isGlobal: BOOLEAN;
                                 scope: Tree) ;
VAR
   type    : Tree ;
   varType : CARDINAL ;
   location: location_t ;
BEGIN
   IF IsComponent (var)
   THEN
      RETURN
   END ;
   IF GetMode (var) = LeftValue
   THEN
      (*
        There are two issues to deal with:

        (i)   LeftValue is really a pointer to GetSType (var), which is built
              here.
        (ii)  Front end might have specified the back end use a particular
              data type, in which case we use the specified type.
              We do not add an extra pointer if this is the case.
      *)
      varType := SkipType (GetVarBackEndType (var)) ;
      IF varType=NulSym
      THEN
         (* We have not explicity told back end the type, so build it.  *)
         varType := GetSType (var) ;
         IF IsVariableAtAddress (var)
         THEN
            type := BuildConstPointerType (Mod2Gcc (varType))
         ELSE
            type := BuildPointerType (Mod2Gcc (varType))
         END
      ELSE
         (* We have been requested to use varType.  *)
         type := Mod2Gcc (varType)
      END ;
      Assert (AllDependantsFullyDeclared (varType))
   ELSE
      type := Mod2Gcc (GetDType (var))
   END ;
   location := TokenToLocation (GetDeclaredMod (var)) ;
   PreAddModGcc (var, DeclareKnownVariable (location,
                                            name, type,
                                            isExported, isImported, isTemporary,
                                            isGlobal, scope, NIL)) ;
   WatchRemoveList (var, todolist) ;
   WatchIncludeList (var, fullydeclared)
END DoVariableDeclaration ;


(*
   IsGlobal - is the variable not in a procedure scope.
*)

PROCEDURE IsGlobal (sym: CARDINAL) : BOOLEAN ;
VAR
   s: CARDINAL ;
BEGIN
   s := GetScope(sym) ;
   WHILE (s#NulSym) AND (NOT IsDefImp (s)) AND (NOT IsModule (s)) DO
      IF IsProcedure (s)
      THEN
         RETURN FALSE
      END ;
      s := GetScope (s)
   END ;
   RETURN TRUE
END IsGlobal ;


(*
   DeclareVariable - declares a global variable to GCC.
*)

PROCEDURE DeclareVariable (ModSym, variable: CARDINAL) ;
VAR
   scope: Tree ;
   decl : CARDINAL ;
BEGIN
   IF NOT GccKnowsAbout (variable)
   THEN
      scope := FindContext (ModSym) ;
      decl := FindOuterModule (variable) ;
      Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
      PushBinding (ModSym) ;
      DoVariableDeclaration (variable,
                             KeyToCharStar (GetFullSymName (variable)),
                             (* in Modula-2 we are allowed to import from ourselves, but we do not present this to GCC *)
                             IsEffectivelyImported(ModSym, variable) AND (GetMainModule () # decl),
                             IsExported(ModSym, variable),
                             IsTemporary (variable),
                             IsGlobal (variable),
                             scope) ;
      PopBinding (ModSym)
   END
END DeclareVariable ;


(*
   DeclareVariableWholeProgram - declares a global variable to GCC when using -fm2-whole-program.
*)

PROCEDURE DeclareVariableWholeProgram (mainModule, variable: CARDINAL) ;
VAR
   scope: Tree ;
   decl : CARDINAL ;
BEGIN
   IF NOT GccKnowsAbout (variable)
   THEN
      scope := FindContext (mainModule) ;
      decl := FindOuterModule (variable) ;
      Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
      PushBinding (mainModule) ;
      DoVariableDeclaration (variable,
                             KeyToCharStar (GetFullSymName (variable)),
                             (NOT IsSourceSeen (decl)) AND
                             IsEffectivelyImported (mainModule, variable) AND (GetMainModule () # decl),
                             IsExported (mainModule, variable),
                             IsTemporary (variable),
                             IsGlobal (variable),
                             scope) ;
      PopBinding (mainModule)
   END
END DeclareVariableWholeProgram ;


(*
   DeclareGlobalVariablesWholeProgram -
*)

PROCEDURE DeclareGlobalVariablesWholeProgram (ModSym: CARDINAL) ;
VAR
   n, Son: CARDINAL ;
BEGIN
   n := 1 ;
   Son := GetNth(ModSym, n) ;
   WHILE Son#NulSym DO
      DeclareVariableWholeProgram(ModSym, Son) ;
      INC(n) ;
      Son := GetNth(ModSym, n)
   END ;
   ForeachInnerModuleDo(ModSym, DeclareGlobalVariablesWholeProgram)
END DeclareGlobalVariablesWholeProgram ;


(*
   DeclareGlobalVariables - lists the Global variables for
                            Module ModSym together with their offset.
*)

PROCEDURE DeclareGlobalVariables (ModSym: CARDINAL) ;
VAR
   n, variable: CARDINAL ;
BEGIN
   n := 1 ;
   variable := GetNth (ModSym, n) ;
   WHILE variable # NulSym DO
      DeclareVariable (ModSym, variable) ;
      INC (n) ;
      variable := GetNth (ModSym, n)
   END ;
   ForeachInnerModuleDo (ModSym, DeclareGlobalVariables)
END DeclareGlobalVariables ;


(*
   DeclareImportedVariables - declares all imported variables to GM2.
*)

PROCEDURE DeclareImportedVariables (sym: WORD) ;
BEGIN
   IF IsVar (sym)
   THEN
      DeclareVariable (GetMainModule (), sym)
   ELSIF IsDefImp (sym)
   THEN
      ForeachExportedDo (sym, DeclareImportedVariables)
   END
END DeclareImportedVariables ;


(*
   DeclareImportedVariablesWholeProgram - declares all imported variables.
*)

PROCEDURE DeclareImportedVariablesWholeProgram (sym: WORD) ;
BEGIN
   IF IsVar (sym)
   THEN
      IF NOT IsSourceSeen (FindOuterModule (sym))
      THEN
         (* import is necessary, even for -fm2-whole-program as we
            cannot see the source.  *)
         DeclareVariableWholeProgram (GetMainModule (), sym)
      END
   ELSIF IsDefImp (sym)
   THEN
      ForeachExportedDo (sym, DeclareImportedVariablesWholeProgram)
   END
END DeclareImportedVariablesWholeProgram ;


(*
   DeclareLocalVariable - declare a local variable var.
*)

PROCEDURE DeclareLocalVariable (var: CARDINAL) ;
BEGIN
   Assert (AllDependantsFullyDeclared (var)) ;
   DoVariableDeclaration (var,
                          KeyToCharStar (GetFullSymName (var)),
                          FALSE,  (* local variables cannot be imported *)
                          FALSE,  (* or exported *)
                          IsTemporary (var),
                          FALSE,  (* and are not global *)
                          Mod2Gcc (GetScope (var)))
END DeclareLocalVariable ;


(*
   DeclareLocalVariables - declares Local variables for procedure.
*)

PROCEDURE DeclareLocalVariables (procedure: CARDINAL) ;
VAR
   i, var: CARDINAL ;
BEGIN
   i := NoOfParam (procedure) + 1 ;
   var := GetNth (procedure, i) ;
   WHILE var # NulSym DO
      Assert (procedure = GetScope (var)) ;
      DeclareLocalVariable (var) ;
      INC (i) ;
      var := GetNth (procedure, i)
   END
END DeclareLocalVariables ;


(*
   DeclareModuleVariables - declares Module variables for a module
                            which was declared inside a procedure.
*)

PROCEDURE DeclareModuleVariables (sym: CARDINAL) ;
VAR
   scope : Tree ;
   i, Var: CARDINAL ;
BEGIN
   i := 1 ;
   scope := Mod2Gcc (GetProcedureScope (sym)) ;
   Var := GetNth (sym, i) ;
   WHILE Var # NulSym DO
      Assert (AllDependantsFullyDeclared (GetSType (Var))) ;
      DoVariableDeclaration (Var,
                             KeyToCharStar (GetFullSymName (Var)),
                             FALSE,   (* inner module variables cannot be imported *)
                             FALSE,   (* or exported (as far as GCC is concerned)  *)
                             IsTemporary (Var),
                             FALSE,   (* and are not global *)
                             scope) ;
      INC (i) ;
      Var := GetNth (sym, i)
   END
END DeclareModuleVariables ;


(*
   DeclareFieldValue -
*)

PROCEDURE DeclareFieldValue (sym: CARDINAL; value: Tree; VAR list: Tree) : Tree ;
VAR
   location: location_t ;
BEGIN
   location := TokenToLocation(GetDeclaredMod(sym)) ;
   IF (GetModuleWhereDeclared(sym)=NulSym) OR
      (GetModuleWhereDeclared(sym)=GetMainModule())
   THEN
      RETURN( BuildEnumerator(location, KeyToCharStar(GetSymName(sym)), value, list) )
   ELSE
      RETURN( BuildEnumerator(location, KeyToCharStar(GetFullScopeAsmName(sym)), value, list) )
   END
END DeclareFieldValue ;


(*
   DeclareFieldEnumeration - declares an enumerator within the current enumeration type.
*)

PROCEDURE DeclareFieldEnumeration (sym: WORD) : Tree ;
VAR
   type    : CARDINAL ;
   field,
   enumlist: Tree ;
BEGIN
   (* add relationship between gccSym and sym *)
   type := GetSType (sym) ;
   enumlist := GetEnumList (type) ;
   PushValue (sym) ;
   field := DeclareFieldValue (sym, PopIntegerTree (), enumlist) ;
   PutEnumList (type, enumlist) ;
   RETURN field
END DeclareFieldEnumeration ;


(*
   DeclareEnumeration - declare an enumerated type.
*)

PROCEDURE DeclareEnumeration (sym: WORD) : Tree ;
VAR
   enumlist,
   gccenum : Tree ;
   location: location_t ;
BEGIN
   location := TokenToLocation (GetDeclaredMod (sym)) ;
   gccenum := BuildStartEnumeration (location, KeyToCharStar (GetFullSymName (sym)), FALSE) ;
   enumlist := GetEnumList (sym) ;
   RETURN BuildEndEnumeration (location, gccenum, enumlist)
END DeclareEnumeration ;


(*
   DeclareSubrange - declare a subrange type.
*)

PROCEDURE DeclareSubrange (sym: CARDINAL) : Tree ;
VAR
   type,
   gccsym   : Tree ;
   high, low: CARDINAL ;
   location: location_t ;
BEGIN
   location := TokenToLocation (GetDeclaredMod (sym)) ;
   GetSubrange (sym, high, low) ;
   (* type := BuildSmallestTypeRange (location, Mod2Gcc(low), Mod2Gcc(high)) ; *)
   type := Mod2Gcc (GetSType (sym)) ;
   gccsym := BuildSubrangeType (location,
                                KeyToCharStar (GetFullSymName(sym)),
                                type, Mod2Gcc (low), Mod2Gcc (high)) ;
   RETURN gccsym
END DeclareSubrange ;


(*
   IncludeGetNth -
*)

PROCEDURE IncludeGetNth (l: List; sym: CARDINAL) ;
VAR
   i: CARDINAL ;
BEGIN
   printf0(' ListOfSons [') ;
   i := 1 ;
   WHILE GetNth(sym, i)#NulSym DO
      IF i>1
      THEN
         printf0(', ') ;
      END ;
      IncludeItemIntoList(l, GetNth(sym, i)) ;
      PrintTerse(GetNth(sym, i)) ;
      INC(i)
   END ;
   printf0(']')
END IncludeGetNth ;


(*
   IncludeType -
*)

PROCEDURE IncludeType (l: List; sym: CARDINAL) ;
VAR
   t: CARDINAL ;
BEGIN
   t := GetSType(sym) ;
   IF t#NulSym
   THEN
      printf0(' type [') ;
      PrintTerse(t) ;
      IncludeItemIntoList(l, t) ;
      printf0(']') ;
      t := GetVarBackEndType(sym) ;
      IF t#NulSym
      THEN
         printf0(' gcc type [') ;
         PrintTerse(t) ;
         IncludeItemIntoList(l, t) ;
         printf0(']')
      END
   END
END IncludeType ;


(*
   IncludeSubscript -
*)

PROCEDURE IncludeSubscript (l: List; sym: CARDINAL) ;
VAR
   t: CARDINAL ;
BEGIN
   t := GetArraySubscript(sym) ;
   IF t#NulSym
   THEN
      printf0(' subrange [') ;
      PrintTerse(t) ;
      IncludeItemIntoList(l, t) ;
      printf0(']') ;
   END
END IncludeSubscript ;


(*
   PrintLocalSymbol -
*)

PROCEDURE PrintLocalSymbol (sym: CARDINAL) ;
BEGIN
   PrintTerse(sym) ; printf0(', ')
END PrintLocalSymbol ;


(*
   PrintLocalSymbols -
*)

PROCEDURE PrintLocalSymbols (sym: CARDINAL) ;
BEGIN
   printf0('Local Symbols {') ;
   ForeachLocalSymDo(sym, PrintLocalSymbol) ;
   printf0('}')
END PrintLocalSymbols ;


(*
   IncludeGetVarient -
*)

PROCEDURE IncludeGetVarient (l: List; sym: CARDINAL) ;
BEGIN
   IF GetVarient(sym)#NulSym
   THEN
      printf0(' Varient [') ;
      PrintTerse(GetVarient(sym)) ;
      printf0(']') ;
      IncludeItemIntoList(l, GetVarient(sym))
   END
END IncludeGetVarient ;


(*
   IncludeUnbounded - includes the record component of an unbounded type.
*)

PROCEDURE IncludeUnbounded (l: List; sym: CARDINAL) ;
BEGIN
   IF GetUnboundedRecordType(sym)#NulSym
   THEN
      IncludeItemIntoList(l, GetUnboundedRecordType(sym))
   END
END IncludeUnbounded ;


(*
   IncludePartialUnbounded - includes the type component of a partial unbounded symbol.
*)

PROCEDURE IncludePartialUnbounded (l: List; sym: CARDINAL) ;
BEGIN
   IF GetSType(sym)#NulSym
   THEN
      IncludeItemIntoList(l, GetSType(sym))
   END
END IncludePartialUnbounded ;


(*
   PrintDeclared - prints out where, sym, was declared.
*)

PROCEDURE PrintDeclared (sym: CARDINAL) ;
VAR
   filename: String ;
   lineno,
   tokenno : CARDINAL ;
BEGIN
   tokenno := GetDeclaredMod(sym) ;
   filename := FindFileNameFromToken(tokenno, 0) ;
   lineno := TokenToLineNo(tokenno, 0) ;
   printf2(" declared in %s:%d", filename, lineno)
END PrintDeclared ;


(*
   PrintAlignment -
*)

PROCEDURE PrintAlignment (sym: CARDINAL) ;
VAR
   align: CARDINAL ;
BEGIN
   IF IsRecord(sym) OR IsType(sym) OR IsRecordField(sym) OR IsPointer(sym) OR IsArray(sym)
   THEN
      align := GetAlignment(sym) ;
      IF align#NulSym
      THEN
         printf1(" aligned [%d]", align)
      END
   END
END PrintAlignment ;


(*
   IncludeGetParent -
*)

PROCEDURE IncludeGetParent (l: List; sym: CARDINAL) ;
BEGIN
   printf0(' Parent [') ;
   IncludeItemIntoList(l, GetParent(sym)) ;
   PrintTerse(GetParent(sym)) ;
   printf0(']')
END IncludeGetParent ;


(*
   PrintDecl -
*)

PROCEDURE PrintDecl (sym: CARDINAL) ;
BEGIN
   IF IsDeclaredPackedResolved(sym)
   THEN
      IF IsDeclaredPacked(sym)
      THEN
         printf0(' packed')
      ELSE
         printf0(' unpacked')
      END
   ELSE
      printf0(' unknown if packed')
   END
END PrintDecl ;


(*
   PrintScope - displays the scope and line number of declaration of symbol, sym.
*)

PROCEDURE PrintScope (sym: CARDINAL) ;
VAR
   name : Name ;
   scope,
   line : CARDINAL ;
BEGIN
   line := TokenToLineNo (GetDeclaredMod (sym), 0) ;
   scope := GetScope (sym) ;
   name := GetSymName (scope) ;
   printf3 (' scope %a:%d %d', name, line, scope)
END PrintScope ;


(*
   PrintProcedure -
*)

PROCEDURE PrintProcedure (sym: CARDINAL) ;
VAR
   n: Name ;
BEGIN
   n := GetSymName (sym) ;
   printf2('sym %d IsProcedure (%a)', sym, n);
   IF IsProcedureReachable(sym)
   THEN
      printf0(' IsProcedureReachable')
   END ;
   PrintScope (sym) ;
   IF IsExtern (sym)
   THEN
      printf0 (' extern')
   END ;
   IF IsPublic (sym)
   THEN
      printf0 (' public')
   END ;
   IF IsCtor (sym)
   THEN
      printf0 (' ctor')
   END ;
   PrintDeclared(sym)
END PrintProcedure ;


(*
   PrintVerboseFromList - prints the, i, th element in the list, l.
*)

PROCEDURE PrintVerboseFromList (l: List; i: CARDINAL) ;
VAR
   type,
   low,
   high,
   sym   : CARDINAL ;
   n, n2 : Name ;
BEGIN
   sym := GetItemFromList(l, i) ;
   n := GetSymName(sym) ;
   IF IsError(sym)
   THEN
      printf2('sym %d IsError (%a)', sym, n)
   ELSIF IsDefImp(sym)
   THEN
      printf2('sym %d IsDefImp (%a)', sym, n) ;
      IF IsDefinitionForC(sym)
      THEN
         printf0('and IsDefinitionForC')
      END ;
      IF IsHiddenTypeDeclared(sym)
      THEN
         printf0(' IsHiddenTypeDeclared')
      END ;
      ForeachProcedureDo (sym, PrintProcedure)
   ELSIF IsModule(sym)
   THEN
      printf2('sym %d IsModule (%a)', sym, n) ;
      IF IsModuleWithinProcedure(sym)
      THEN
         printf0(' and IsModuleWithinProcedure')
      END
   ELSIF IsInnerModule(sym)
   THEN
      printf2('sym %d IsInnerModule (%a)', sym, n)
   ELSIF IsUnknown(sym)
   THEN
      printf2('sym %d IsUnknown (%a)', sym, n)
   ELSIF IsType(sym)
   THEN
      printf2('sym %d IsType (%a)', sym, n) ;
      IncludeType(l, sym) ;
      PrintAlignment(sym)
   ELSIF IsProcedure(sym)
   THEN
      PrintProcedure (sym)
   ELSIF IsParameter(sym)
   THEN
      printf2('sym %d IsParameter (%a)', sym, n) ;
      IF GetParameterShadowVar(sym)=NulSym
      THEN
         printf0(' no shadow local variable')
      ELSE
         printf0(' shadow ') ;
         IncludeType(l, GetParameterShadowVar(sym))
         (* PrintVerboseFromList(l, GetParameterShadowVar(sym)) *)
      END ;
      IncludeType(l, sym)
   ELSIF IsPointer(sym)
   THEN
      printf2('sym %d IsPointer (%a)', sym, n) ;
      IncludeType(l, sym) ;
      PrintAlignment(sym)
   ELSIF IsRecord(sym)
   THEN
      printf2('sym %d IsRecord (%a)', sym, n) ;
      PrintLocalSymbols(sym) ;
      IncludeGetNth(l, sym) ;
      PrintAlignment(sym) ;
      PrintDecl(sym)
   ELSIF IsVarient(sym)
   THEN
      printf2('sym %d IsVarient (%a)', sym, n) ;
      PrintDecl(sym) ;
      IncludeGetNth(l, sym) ;
      IncludeGetVarient(l, sym) ;
      IncludeGetParent(l, sym)
   ELSIF IsFieldVarient(sym)
   THEN
      printf2('sym %d IsFieldVarient (%a)', sym, n) ;
      PrintDecl(sym) ;
      IncludeGetNth(l, sym) ;
      IncludeGetVarient(l, sym) ;
      IncludeGetParent(l, sym)
   ELSIF IsFieldEnumeration(sym)
   THEN
      printf2('sym %d IsFieldEnumeration (%a)', sym, n)
   ELSIF IsArray(sym)
   THEN
      printf2('sym %d IsArray (%a)', sym, n) ;
      IncludeSubscript(l, sym) ;
      IncludeType(l, sym) ;
      PrintAlignment(sym)
   ELSIF IsEnumeration(sym)
   THEN
      printf2('sym %d IsEnumeration (%a)', sym, n)
   ELSIF IsSet(sym)
   THEN
      printf2('sym %d IsSet (%a)', sym, n) ;
      IncludeType(l, sym)
   ELSIF IsUnbounded(sym)
   THEN
      printf2('sym %d IsUnbounded (%a)', sym, n) ;
      IncludeUnbounded(l, sym)
   ELSIF IsPartialUnbounded(sym)
   THEN
      printf2('sym %d IsPartialUnbounded (%a)', sym, n) ;
      IncludePartialUnbounded(l, sym)
   ELSIF IsRecordField(sym)
   THEN
      printf2('sym %d IsRecordField (%a)', sym, n) ;
      IF IsRecordFieldAVarientTag(sym)
      THEN
         printf0(' variant tag')
      END ;
      IncludeType(l, sym) ;
      IncludeGetVarient(l, sym) ;
      IncludeGetParent(l, sym) ;
      PrintAlignment(sym) ;
      PrintDecl(sym)
   ELSIF IsProcType(sym)
   THEN
      printf2('sym %d IsProcType (%a)', sym, n)
   ELSIF IsVar(sym)
   THEN
      printf2('sym %d IsVar (%a) declared in ', sym, n) ;
      PrintScope (sym) ;
      printf0 ('mode ') ;
      CASE GetMode(sym) OF

      LeftValue     : printf0('l ') |
      RightValue    : printf0('r ') |
      ImmediateValue: printf0('i ') |
      NoValue       : printf0('n ')

      END ;
      IF IsTemporary(sym)
      THEN
         printf0('temporary ')
      END ;
      IF IsComponent(sym)
      THEN
         printf0('component ')
      END ;
      IncludeType(l, sym)
   ELSIF IsConst(sym)
   THEN
      printf2('sym %d IsConst (%a)', sym, n) ;
      IF IsConstString(sym)
      THEN
         printf1('  also IsConstString (%a)', n) ;
         IF IsConstStringM2 (sym)
         THEN
            printf0(' a Modula-2 string')
         ELSIF IsConstStringC (sym)
         THEN
            printf0(' a C string')
         ELSIF IsConstStringM2nul (sym)
         THEN
            printf0(' a nul terminated Modula-2 string')
         ELSIF IsConstStringCnul (sym)
         THEN
            printf0(' a nul terminated C string')
         END
      ELSIF IsConstructor(sym)
      THEN
         printf0(' constant constructor ') ;
         IncludeType(l, sym)
      ELSIF IsConstSet(sym)
      THEN
         printf0(' constant constructor set ') ;
         IncludeType(l, sym)
      ELSE
         IncludeType(l, sym)
      END
   ELSIF IsConstructor(sym)
   THEN
      printf2('sym %d IsConstructor (non constant) (%a)', sym, n) ;
      IncludeType(l, sym)
   ELSIF IsConstLit(sym)
   THEN
      printf2('sym %d IsConstLit (%a)', sym, n)
   ELSIF IsDummy(sym)
   THEN
      printf2('sym %d IsDummy (%a)', sym, n)
   ELSIF IsTemporary(sym)
   THEN
      printf2('sym %d IsTemporary (%a)', sym, n)
   ELSIF IsVarAParam(sym)
   THEN
      printf2('sym %d IsVarAParam (%a)', sym, n)
   ELSIF IsSubscript(sym)
   THEN
      printf2('sym %d IsSubscript (%a)', sym, n)
   ELSIF IsSubrange(sym)
   THEN
      GetSubrange(sym, high, low) ;
      printf2('sym %d IsSubrange (%a)', sym, n) ;
      IF (low#NulSym) AND (high#NulSym)
      THEN
         type := GetSType(sym) ;
         IF type#NulSym
         THEN
            IncludeType(l, sym) ;
            n := GetSymName(type) ;
            printf1(' %a', n)
         END ;
         n := GetSymName(low) ;
         n2 := GetSymName(high) ;
         printf2('[%a..%a]', n, n2)
      END
   ELSIF IsProcedureVariable(sym)
   THEN
      printf2('sym %d IsProcedureVariable (%a)', sym, n)
   ELSIF IsProcedureNested(sym)
   THEN
      printf2('sym %d IsProcedureNested (%a)', sym, n)
   ELSIF IsAModula2Type(sym)
   THEN
      printf2('sym %d IsAModula2Type (%a)', sym, n)
   ELSIF IsObject(sym)
   THEN
      printf2('sym %d IsObject (%a)', sym, n)
   ELSIF IsTuple(sym)
   THEN
      printf2('sym %d IsTuple (%a)', sym, n) ;
      low := GetNth(sym, 1) ;
      high := GetNth(sym, 2) ;
      printf2('%d, %d\n', low, high)
   ELSIF IsGnuAsm(sym)
   THEN
      IF IsGnuAsmVolatile(sym)
      THEN
         printf2('sym %d IsGnuAsmVolatile (%a)', sym, n)
      ELSE
         printf2('sym %d IsGnuAsm (%a)', sym, n)
      END
   ELSIF IsComponent(sym)
   THEN
      printf2('sym %d IsComponent (%a) ', sym, n) ;
      i := 1 ;
      REPEAT
         type := GetNth(sym, i) ;
         IF type#NulSym
         THEN
            IncludeItemIntoList(l, type) ;
            n := GetSymName(type) ;
            printf2("[%a %d] ", n, type) ;
            INC(i)
         END ;
      UNTIL type=NulSym
   END ;

   IF IsHiddenType(sym)
   THEN
      printf0(' IsHiddenType')
   END ;
   printf0('\n')
END PrintVerboseFromList ;


(*
   PrintVerbose - prints limited information about a symbol.
*)

PROCEDURE PrintVerbose (sym: CARDINAL) ;
VAR
   l: List ;
   i: CARDINAL ;
BEGIN
   InitList (l) ;
   IncludeItemIntoList (l, sym) ;
   i := 1 ;
   WHILE i<=NoOfItemsInList (l) DO
      PrintVerboseFromList (l, i) ;
      INC (i)
   END ;
   KillList (l)
END PrintVerbose ;


(*
   PrintSym - prints limited information about a symbol.
              This procedure is externally visible.
*)

PROCEDURE PrintSym (sym: CARDINAL) ;
BEGIN
   printf1 ('information about symbol: %d\n', sym) ;
   printf0 ('==============================\n') ;
   PrintVerbose (sym)
END PrintSym ;


(* ********************************
(*
   PrintSymbol - prints limited information about a symbol.
*)

PROCEDURE PrintSymbol (sym: CARDINAL) ;
BEGIN
   PrintTerse(sym) ;
   printf0('\n')
END PrintSymbol ;
  ******************************************* *)

(*
   PrintTerse -
*)

PROCEDURE PrintTerse (sym: CARDINAL) ;
VAR
   n: Name ;
BEGIN
   n := GetSymName(sym) ;
   IF IsError(sym)
   THEN
      printf2('sym %d IsError (%a)', sym, n)
   ELSIF IsDefImp(sym)
   THEN
      printf2('sym %d IsDefImp (%a)', sym, n) ;
      IF IsDefinitionForC(sym)
      THEN
         printf0('and IsDefinitionForC')
      END ;
      IF IsHiddenTypeDeclared(sym)
      THEN
         printf0(' IsHiddenTypeDeclared')
      END
   ELSIF IsModule(sym)
   THEN
      printf2('sym %d IsModule (%a)', sym, n) ;
      IF IsModuleWithinProcedure(sym)
      THEN
         printf0(' and IsModuleWithinProcedure')
      END
   ELSIF IsInnerModule(sym)
   THEN
      printf2('sym %d IsInnerModule (%a)', sym, n)
   ELSIF IsUnknown(sym)
   THEN
      printf2('sym %d IsUnknown (%a)', sym, n)
   ELSIF IsType(sym)
   THEN
      printf2('sym %d IsType (%a)', sym, n)
   ELSIF IsProcedure(sym)
   THEN
      printf2('sym %d IsProcedure (%a)', sym, n);
      IF IsProcedureReachable(sym)
      THEN
         printf0(' and IsProcedureReachable')
      END
   ELSIF IsParameter(sym)
   THEN
      printf2('sym %d IsParameter (%a)', sym, n)
   ELSIF IsPointer(sym)
   THEN
      printf2('sym %d IsPointer (%a)', sym, n)
   ELSIF IsRecord(sym)
   THEN
      printf2('sym %d IsRecord (%a)', sym, n)
   ELSIF IsVarient(sym)
   THEN
      printf2('sym %d IsVarient (%a)', sym, n)
   ELSIF IsFieldVarient(sym)
   THEN
      printf2('sym %d IsFieldVarient (%a)', sym, n)
   ELSIF IsFieldEnumeration(sym)
   THEN
      printf2('sym %d IsFieldEnumeration (%a)', sym, n)
   ELSIF IsArray(sym)
   THEN
      printf2('sym %d IsArray (%a)', sym, n)
   ELSIF IsEnumeration(sym)
   THEN
      printf2('sym %d IsEnumeration (%a)', sym, n)
   ELSIF IsSet(sym)
   THEN
      printf2('sym %d IsSet (%a)', sym, n)
   ELSIF IsUnbounded(sym)
   THEN
      printf2('sym %d IsUnbounded (%a)', sym, n)
   ELSIF IsRecordField(sym)
   THEN
      printf2('sym %d IsRecordField (%a)', sym, n)
   ELSIF IsProcType(sym)
   THEN
      printf2('sym %d IsProcType (%a)', sym, n)
   ELSIF IsVar(sym)
   THEN
      printf2('sym %d IsVar (%a)', sym, n)
   ELSIF IsConstString(sym)
   THEN
      printf2('sym %d IsConstString (%a)', sym, n)
   ELSIF IsConst(sym)
   THEN
      printf2('sym %d IsConst (%a)', sym, n)
   ELSIF IsConstLit(sym)
   THEN
      printf2('sym %d IsConstLit (%a)', sym, n)
   ELSIF IsDummy(sym)
   THEN
      printf2('sym %d IsDummy (%a)', sym, n)
   ELSIF IsTemporary(sym)
   THEN
      printf2('sym %d IsTemporary (%a)', sym, n)
   ELSIF IsVarAParam(sym)
   THEN
      printf2('sym %d IsVarAParam (%a)', sym, n)
   ELSIF IsSubscript(sym)
   THEN
      printf2('sym %d IsSubscript (%a)', sym, n)
   ELSIF IsSubrange(sym)
   THEN
      printf2('sym %d IsSubrange (%a)', sym, n)
   ELSIF IsProcedureVariable(sym)
   THEN
      printf2('sym %d IsProcedureVariable (%a)', sym, n)
   ELSIF IsProcedureNested(sym)
   THEN
      printf2('sym %d IsProcedureNested (%a)', sym, n)
   ELSIF IsAModula2Type(sym)
   THEN
      printf2('sym %d IsAModula2Type (%a)', sym, n)
   ELSIF IsGnuAsmVolatile(sym)
   THEN
      printf2('sym %d IsGnuAsmVolatile (%a)', sym, n)
   END ;

   IF IsHiddenType(sym)
   THEN
      printf0(' IsHiddenType')
   END
END PrintTerse ;


(*
   CheckAlignment -
*)

PROCEDURE CheckAlignment (type: Tree; sym: CARDINAL) : Tree ;
VAR
   align: CARDINAL ;
BEGIN
   align := GetAlignment(sym) ;
   IF align#NulSym
   THEN
      PushInt(0) ;
      PushValue(align) ;
      IF NOT Equ(GetDeclaredMod(sym))
      THEN
         RETURN( SetAlignment(type, Mod2Gcc(GetAlignment(sym))) )
      END
   END ;
   RETURN( type )
END CheckAlignment ;


(*
   CheckPragma -
*)

PROCEDURE CheckPragma (type: Tree; sym: CARDINAL) : Tree ;
BEGIN
   IF IsDeclaredPacked (sym)
   THEN
      IF IsRecordField (sym) OR IsFieldVarient (sym)
      THEN
         type := SetDeclPacked (type)
      ELSIF IsRecord (sym) OR IsVarient (sym)
      THEN
         type := SetTypePacked (type)
      END
   END ;
   RETURN CheckAlignment (type, sym)
END CheckPragma ;


(*
   IsZero - returns TRUE if symbol, sym, is zero.
*)

PROCEDURE IsZero (sym: CARDINAL) : BOOLEAN ;
BEGIN
   PushIntegerTree(Mod2Gcc(sym)) ;
   PushInt(0) ;
   RETURN( Equ(GetDeclaredMod(sym)) )
END IsZero ;


(*
   SetFieldPacked - sets Varient, VarientField and RecordField symbols
                    as packed.
*)

PROCEDURE SetFieldPacked (field: CARDINAL) ;
BEGIN
   IF IsVarient(field) OR IsFieldVarient(field) OR IsRecordField(field)
   THEN
      PutDeclaredPacked(field, TRUE)
   END
END SetFieldPacked ;


(*
   RecordPacked - indicates that record, sym, and its fields
                  are all packed.
*)

PROCEDURE RecordPacked (sym: CARDINAL) ;
BEGIN
   PutDeclaredPacked(sym, TRUE) ;
   WalkRecordDependants(sym, SetFieldPacked)
END RecordPacked ;


(*
   SetFieldNotPacked - sets Varient, VarientField and RecordField symbols
                       as not packed.
*)

PROCEDURE SetFieldNotPacked (field: CARDINAL) ;
BEGIN
   IF IsVarient(field) OR IsFieldVarient(field) OR IsRecordField(field)
   THEN
      PutDeclaredPacked(field, FALSE)
   END
END SetFieldNotPacked ;


(*
   RecordNotPacked - indicates that record, sym, and its fields
                     are all not packed.
*)

PROCEDURE RecordNotPacked (sym: CARDINAL) ;
BEGIN
   PutDeclaredPacked(sym, FALSE) ;
   WalkRecordDependants(sym, SetFieldNotPacked)
END RecordNotPacked ;


(*
   DetermineIfRecordPacked -
*)

PROCEDURE DetermineIfRecordPacked (sym: CARDINAL) ;
VAR
   defaultAlignment: CARDINAL ;
BEGIN
   defaultAlignment := GetDefaultRecordFieldAlignment(sym) ;
   IF (defaultAlignment#NulSym) AND IsZero(defaultAlignment)
   THEN
      RecordPacked(sym)
   ELSE
      RecordNotPacked(sym)
   END
END DetermineIfRecordPacked ;


(*
   DeclarePackedSubrange -
*)

PROCEDURE DeclarePackedSubrange (equiv, sym: CARDINAL) ;
VAR
   type,
   gccsym   : Tree ;
   high, low: CARDINAL ;
   location : location_t ;
BEGIN
   location := TokenToLocation(GetDeclaredMod(sym)) ;
   GetSubrange(sym, high, low) ;
   type := BuildSmallestTypeRange(location, Mod2Gcc(low), Mod2Gcc(high)) ;
   gccsym := BuildSubrangeType(location, KeyToCharStar(GetFullSymName(sym)),
                               type, Mod2Gcc(low), Mod2Gcc(high)) ;
   AddModGcc(equiv, gccsym)
END DeclarePackedSubrange ;


(*
   DeclarePackedSet -
*)

PROCEDURE DeclarePackedSet (equiv, sym: CARDINAL) ;
VAR
   highLimit,
   range,
   gccsym   : Tree ;
   type,
   high, low: CARDINAL ;
   location: location_t ;
BEGIN
   location := TokenToLocation(GetDeclaredMod(sym)) ;
   Assert(IsSet(sym)) ;
   type := GetDType(sym) ;
   low := GetTypeMin(type) ;
   high := GetTypeMax(type) ;
   highLimit := BuildSub(location, Mod2Gcc(high), Mod2Gcc(low), FALSE) ;
   (* --fixme-- we need to check that low <= WORDLENGTH.  *)
   highLimit := BuildLSL(location, GetIntegerOne(location), highLimit, FALSE) ;
   range := BuildSmallestTypeRange(location, GetIntegerZero(location), highLimit) ;
   gccsym := BuildSubrangeType(location, KeyToCharStar(GetFullSymName(sym)),
                               range, GetIntegerZero(location), highLimit) ;
   AddModGcc(equiv, gccsym)
END DeclarePackedSet ;


(*
   DeclareFieldEnumeration - declares an enumerator within the current enumeration type.
*)

PROCEDURE DeclarePackedFieldEnumeration (sym: WORD) ;
VAR
   equiv,
   type    : CARDINAL ;
   field,
   enumlist: Tree ;
BEGIN
   (* add relationship between gccSym and sym *)
   type := GetSType (sym) ;
   equiv := GetPackedEquivalent (type) ;
   enumlist := GetEnumList (equiv) ;
   PushValue (sym) ;
   field := DeclareFieldValue (sym, PopIntegerTree(), enumlist) ;
   Assert (field # NIL) ;
   PutEnumList (equiv, enumlist)
END DeclarePackedFieldEnumeration ;


(*
   DeclarePackedEnumeration -
*)

PROCEDURE DeclarePackedEnumeration (equiv, sym: CARDINAL) ;
VAR
   enumlist,
   gccenum : Tree ;
   location: location_t ;
BEGIN
   location := TokenToLocation(GetDeclaredMod(sym)) ;
   gccenum := BuildStartEnumeration(location, KeyToCharStar(GetFullSymName(sym)), TRUE) ;
   ForeachLocalSymDo(sym, DeclarePackedFieldEnumeration) ;
   enumlist := GetEnumList(equiv) ;
   gccenum := BuildEndEnumeration(location, gccenum, enumlist) ;
   AddModGcc(equiv, gccenum)
END DeclarePackedEnumeration ;


(*
   DeclarePackedType -
*)

PROCEDURE DeclarePackedType (equiv, sym: CARDINAL) ;
VAR
   type: CARDINAL ;
BEGIN
   type := GetSType(sym) ;
   IF type=NulSym
   THEN
      IF sym=Boolean
      THEN
         AddModGcc(equiv, GetPackedBooleanType())
      ELSE
         AddModGcc(equiv, Mod2Gcc(sym))
      END
   ELSE
      DeclarePackedType(GetPackedEquivalent(type), type) ;
      AddModGcc(equiv, Mod2Gcc(GetPackedEquivalent(type)))
   END
END DeclarePackedType ;


(*
   doDeclareEquivalent -
*)

PROCEDURE doDeclareEquivalent (sym: CARDINAL; p: doDeclareProcedure) : Tree ;
VAR
   equiv: CARDINAL ;
BEGIN
   equiv := GetPackedEquivalent(sym) ;
   IF NOT GccKnowsAbout(equiv)
   THEN
      p(equiv, sym) ;
      IncludeElementIntoSet(FullyDeclared, equiv)
   END ;
   RETURN( Mod2Gcc(equiv) )
END doDeclareEquivalent ;


(*
   PossiblyPacked -
*)

PROCEDURE PossiblyPacked (sym: CARDINAL; isPacked: BOOLEAN) : Tree ;
BEGIN
   IF isPacked
   THEN
      IF IsSubrange(sym)
      THEN
         RETURN( doDeclareEquivalent(sym, DeclarePackedSubrange) )
      ELSIF IsType(sym)
      THEN
         RETURN( doDeclareEquivalent(sym, DeclarePackedType) )
      ELSIF IsEnumeration(sym)
      THEN
         RETURN( doDeclareEquivalent(sym, DeclarePackedEnumeration) )
      ELSIF IsSet(sym)
      THEN
         RETURN( doDeclareEquivalent(sym, DeclarePackedSet) )
      END
   END ;
   RETURN( Mod2Gcc(sym) )
END PossiblyPacked ;


(*
   GetPackedType - returns a possibly packed type for field.
*)

PROCEDURE GetPackedType (sym: CARDINAL) : Tree ;
BEGIN
   IF IsSubrange(sym)
   THEN
      RETURN( doDeclareEquivalent(sym, DeclarePackedSubrange) )
   ELSIF IsType(sym)
   THEN
      RETURN( doDeclareEquivalent(sym, DeclarePackedType) )
   ELSIF IsEnumeration(sym)
   THEN
      RETURN( doDeclareEquivalent(sym, DeclarePackedEnumeration) )
   END ;
   RETURN( Mod2Gcc(sym) )
END GetPackedType ;


(*
   MaybeAlignField - checks to see whether, field, is packed or aligned and it updates
                     the offsets if appropriate.
*)

PROCEDURE MaybeAlignField (field: CARDINAL; VAR byteOffset, bitOffset: Tree) : Tree ;
VAR
   f, ftype,
   nbits   : Tree ;
   location: location_t ;
BEGIN
   f := Mod2Gcc(field) ;
   IF IsDeclaredPacked(field)
   THEN
      location := TokenToLocation(GetDeclaredMod(field)) ;
      f := SetDeclPacked(f) ;
      ftype := GetPackedType(GetSType(field)) ;
      nbits := BuildTBitSize(location, ftype) ;
      f := SetRecordFieldOffset(f, byteOffset, bitOffset, ftype, nbits) ;
      bitOffset := BuildAdd(location, bitOffset, nbits, FALSE) ;
      RETURN( f )
   ELSE
      RETURN( CheckAlignment(f, field) )
   END
END MaybeAlignField ;


(*
   DeclareRecord - declares a record and its fields to gcc.
                   The final gcc record type is returned.
*)

PROCEDURE DeclareRecord (Sym: CARDINAL) : Tree ;
VAR
   Field     : CARDINAL ;
   i         : CARDINAL ;
   nbits,
   ftype,
   field,
   byteOffset,
   bitOffset,
   FieldList,
   RecordType: Tree ;
   location  : location_t ;
BEGIN
   i := 1 ;
   FieldList := Tree(NIL) ;
   RecordType := DoStartDeclaration(Sym, BuildStartRecord) ;
   location := TokenToLocation(GetDeclaredMod(Sym)) ;
   byteOffset := GetIntegerZero(location) ;
   bitOffset := GetIntegerZero(location) ;
   REPEAT
      Field := GetNth(Sym, i) ;
      IF Field#NulSym
      THEN
         IF IsRecordField(Field) AND IsRecordFieldAVarientTag(Field) AND (GetSymName(Field)=NulName)
         THEN
            (* do not include a nameless tag into the C struct *)
         ELSIF IsVarient(Field)
         THEN
            Field := Chained(Field) ;
            field := Mod2Gcc(Field) ;
            IF IsDeclaredPacked(Field)
            THEN
               location := TokenToLocation(GetDeclaredMod(Field)) ;
               field := SetDeclPacked(field) ;
               ftype := GetPackedType(GetSType(Field)) ;
               nbits := BuildTBitSize(location, ftype) ;
               field := SetRecordFieldOffset(field, byteOffset, bitOffset, ftype, nbits) ;
               bitOffset := BuildAdd(location, bitOffset, nbits, FALSE) ;
               byteOffset := BuildAdd(location, byteOffset,
                                      BuildDivTrunc(location, bitOffset, BuildIntegerConstant(8), FALSE),
                                      FALSE) ;
               bitOffset := BuildModTrunc(location, bitOffset, BuildIntegerConstant(8), FALSE)
            END ;
            FieldList := ChainOn(FieldList, field)
         ELSE
            IF Debugging
            THEN
               printf0('chaining ') ; PrintTerse(Field) ; printf0('\n')
            END ;
            FieldList := ChainOn(FieldList, MaybeAlignField(Chained(Field), byteOffset, bitOffset))
         END
      END ;
      INC(i)
   UNTIL Field=NulSym ;
   WatchRemoveList(Sym, partiallydeclared) ;
   WatchRemoveList(Sym, heldbyalignment) ;
   WatchRemoveList(Sym, finishedalignment) ;
   location := TokenToLocation(GetDeclaredMod(Sym)) ;
   RETURN( BuildEndRecord(location, RecordType, FieldList, IsDeclaredPacked(Sym)) )
END DeclareRecord ;


(*
   DeclareRecordField -
*)

PROCEDURE DeclareRecordField (sym: CARDINAL) : Tree ;
VAR
   field,
   GccFieldType: Tree ;
   location    : location_t ;
BEGIN
   location := TokenToLocation(GetDeclaredMod(sym)) ;
   GccFieldType := PossiblyPacked(GetSType(sym), IsDeclaredPacked(sym)) ;
   field := BuildFieldRecord(location, KeyToCharStar(GetFullSymName(sym)), GccFieldType) ;
   RETURN( field )
END DeclareRecordField ;


(*
   DeclareVarient - declares a record and its fields to gcc.
                    The final gcc record type is returned.
*)

PROCEDURE DeclareVarient (sym: CARDINAL) : Tree ;
VAR
   Field       : CARDINAL ;
   i           : CARDINAL ;
   byteOffset,
   bitOffset,
   FieldList,
   VarientType : Tree ;
   location    : location_t ;
BEGIN
   i := 1 ;
   FieldList := Tree(NIL) ;
   VarientType := DoStartDeclaration(sym, BuildStartVarient) ;
   location := TokenToLocation(GetDeclaredMod(sym)) ;
   byteOffset := GetIntegerZero(location) ;
   bitOffset := GetIntegerZero(location) ;
   WHILE GetNth(sym, i)#NulSym DO
      Field := GetNth(sym, i) ;
      IF IsRecordField(Field) AND IsRecordFieldAVarientTag(Field) AND (GetSymName(Field)=NulName)
      THEN
         (* do not include a nameless tag into the C struct *)
      ELSE
         IF Debugging
         THEN
            printf0('chaining ') ; PrintTerse(Field) ; printf0('\n')
         END ;
         FieldList := ChainOn(FieldList, MaybeAlignField(Chained(Field), byteOffset, bitOffset))
      END ;
      INC(i)
   END ;
   WatchRemoveList(sym, partiallydeclared) ;
   WatchRemoveList(sym, heldbyalignment) ;
   WatchRemoveList(sym, finishedalignment) ;
   VarientType := BuildEndVarient(location, VarientType, FieldList, IsDeclaredPacked(sym)) ;
   RETURN( VarientType )
END DeclareVarient ;


(*
   DeclareFieldVarient -
*)

PROCEDURE DeclareFieldVarient (sym: CARDINAL) : Tree ;
VAR
   i, f        : CARDINAL ;
   VarientList,
   VarientType,
   byteOffset,
   bitOffset,
   GccFieldType: Tree ;
   location    : location_t ;
BEGIN
   location := TokenToLocation(GetDeclaredMod(sym)) ;
   i := 1 ;
   VarientList := Tree(NIL) ;
   VarientType := DoStartDeclaration(sym, BuildStartFieldVarient) ;
   (* no need to store the [sym, RecordType] tuple as it is stored by DeclareRecord which calls us *)
   byteOffset := GetIntegerZero(location) ;
   bitOffset := GetIntegerZero(location) ;
   WHILE GetNth(sym, i)#NulSym DO
      f := GetNth(sym, i) ;
      IF IsFieldVarient(f) AND IsEmptyFieldVarient(f)
      THEN
         (* do not include empty varient fields (created via 'else end' in variant records *)
      ELSE
         IF Debugging
         THEN
            printf0('chaining ') ; PrintTerse(f) ; printf0('\n')
         END ;
         VarientList := ChainOn(VarientList, MaybeAlignField(Chained(f), byteOffset, bitOffset))
      END ;
      INC(i)
   END ;
   WatchRemoveList(sym, partiallydeclared) ;
   GccFieldType := BuildEndFieldVarient(location, VarientType, VarientList, IsDeclaredPacked(sym)) ;
   RETURN( GccFieldType )
END DeclareFieldVarient ;


(*
   DeclarePointer - declares a pointer type to gcc and returns the Tree.
*)

PROCEDURE DeclarePointer (sym: CARDINAL) : Tree ;
BEGIN
   RETURN( BuildPointerType(Mod2Gcc(GetSType(sym))) )
END DeclarePointer ;


(*
   DeclareUnbounded - builds an unbounded type and returns the gcc tree.
*)

PROCEDURE DeclareUnbounded (sym: CARDINAL) : Tree ;
VAR
   record: CARDINAL ;
BEGIN
   Assert(IsUnbounded(sym)) ;
   IF GccKnowsAbout(sym)
   THEN
      RETURN( Mod2Gcc(sym) )
   ELSE
      record := GetUnboundedRecordType(sym) ;
      Assert(IsRecord(record)) ;
      Assert(AllDependantsFullyDeclared(record)) ;
      IF (NOT GccKnowsAbout(record))
      THEN
         DeclareTypeConstFully(record) ;
         WatchRemoveList(record, todolist)
      END ;
      RETURN( Mod2Gcc(record) )
   END
END DeclareUnbounded ;


(*
   BuildIndex -
*)

PROCEDURE BuildIndex (tokenno: CARDINAL; array: CARDINAL) : Tree ;
VAR
   Subscript: CARDINAL ;
   Type,
   High, Low: CARDINAL ;
   n,
   low, high: Tree ;
   location : location_t ;
BEGIN
   location := TokenToLocation(tokenno) ;
   Subscript := GetArraySubscript (array) ;
   Assert (IsSubscript (Subscript)) ;
   Type := GetDType (Subscript) ;
   Low := GetTypeMin (Type) ;
   High := GetTypeMax (Type) ;
   DeclareConstant (tokenno, Low) ;
   DeclareConstant (tokenno, High) ;
   low := Mod2Gcc (Low) ;
   high := Mod2Gcc (High) ;
   IF ExceedsTypeRange (GetIntegerType (), low, high)
   THEN
      location := TokenToLocation (tokenno) ;
      n := BuildConvert (location, GetIntegerType (), BuildSub (location, high, low, FALSE), FALSE) ;
      IF TreeOverflow(n) OR ValueOutOfTypeRange (GetIntegerType (), n)
      THEN
         MetaError3('implementation restriction, array is too large {%1EDM}, the range {%2ad}..{%3ad} exceeds the integer range',
                    array, Low, High) ;
         RETURN BuildArrayIndexType (GetIntegerZero (location), GetIntegerZero (location))
      ELSE
         PutArrayLarge (array) ;
	 RETURN BuildArrayIndexType (GetIntegerZero (location), n)
      END
   ELSE
      low := BuildConvert (location, GetIntegerType (), low, FALSE) ;
      high := BuildConvert (location, GetIntegerType (), high, FALSE) ;
      RETURN BuildArrayIndexType (low, high)
   END
END BuildIndex ;


(*
   DeclareArray - declares an array to gcc and returns the gcc tree.
*)

PROCEDURE DeclareArray (Sym: CARDINAL) : Tree ;
VAR
   typeOfArray: CARDINAL ;
   ArrayType,
   GccArray,
   GccIndex   : Tree ;
   Subscript  : CARDINAL ;
   tokenno    : CARDINAL ;
   location   : location_t ;
BEGIN
   Assert(IsArray(Sym)) ;

   tokenno := GetDeclaredMod(Sym) ;
   location := TokenToLocation(tokenno) ;

   Subscript := GetArraySubscript(Sym) ;
   typeOfArray := GetDType(Sym) ;
   GccArray := Mod2Gcc(typeOfArray) ;
   GccIndex := BuildIndex(tokenno, Sym) ;

   IF GccKnowsAbout(Sym)
   THEN
      ArrayType := Mod2Gcc(Sym)
   ELSE
      ArrayType := BuildStartArrayType(GccIndex, GccArray, typeOfArray) ;
      PreAddModGcc(Sym, ArrayType)
   END ;

   PreAddModGcc(Subscript, GccArray) ;       (* we save the type of this array as the subscript *)
   PushIntegerTree(BuildSize(location, GccArray, FALSE)) ;  (* and the size of this array so far *)
   PopSize(Subscript) ;

   GccArray := BuildEndArrayType(ArrayType, GccArray, GccIndex, typeOfArray) ;
   Assert(GccArray=ArrayType) ;

   RETURN( GccArray )
END DeclareArray ;


(*
   DeclareProcType - declares a procedure type to gcc and returns the gcc type tree.
*)

PROCEDURE DeclareProcType (Sym: CARDINAL) : Tree ;
VAR
   i, p, Son,
   ReturnType: CARDINAL ;
   func,
   GccParam  : Tree ;
   location  : location_t ;
BEGIN
   ReturnType := GetSType(Sym) ;
   func := DoStartDeclaration(Sym, BuildStartFunctionType) ;
   InitFunctionTypeParameters ;
   p := NoOfParam(Sym) ;
   i := p ;
   WHILE i>0 DO
      Son := GetNthParam(Sym, i) ;
      location := TokenToLocation(GetDeclaredMod(Son)) ;
      GccParam := BuildProcTypeParameterDeclaration(location, Mod2Gcc(GetSType(Son)), IsVarParam(Sym, i)) ;
      PreAddModGcc(Son, GccParam) ;
      DEC(i)
   END ;
   IF ReturnType=NulSym
   THEN
      RETURN( BuildEndFunctionType(func, NIL, UsesVarArgs(Sym)) )
   ELSE
      RETURN( BuildEndFunctionType(func, Mod2Gcc(ReturnType), UsesVarArgs(Sym)) )
   END
END DeclareProcType ;


VAR
   MaxEnumerationField,
   MinEnumerationField: CARDINAL ;


(*
   FindMinMaxEnum - finds the minimum and maximum enumeration fields.
*)

PROCEDURE FindMinMaxEnum (field: WORD) ;
BEGIN
   IF MaxEnumerationField=NulSym
   THEN
      MaxEnumerationField := field
   ELSE
      PushValue(field) ;
      PushValue(MaxEnumerationField) ;
      IF Gre(GetDeclaredMod(field))
      THEN
         MaxEnumerationField := field
      END
   END ;
   IF MinEnumerationField=NulSym
   THEN
      MinEnumerationField := field
   ELSE
      PushValue(field) ;
      PushValue(MinEnumerationField) ;
      IF Less(GetDeclaredMod(field))
      THEN
         MinEnumerationField := field
      END
   END
END FindMinMaxEnum ;


(*
   GetTypeMin -
*)

PROCEDURE GetTypeMin (type: CARDINAL) : CARDINAL ;
VAR
   min, max: CARDINAL ;
BEGIN
   IF IsSubrange(type)
   THEN
      GetSubrange(type, max, min) ;
      RETURN( min )
   ELSIF IsSet(type)
   THEN
      RETURN( GetTypeMin(GetSType(type)) )
   ELSIF IsEnumeration(type)
   THEN
      MinEnumerationField := NulSym ;
      MaxEnumerationField := NulSym ;
      ForeachFieldEnumerationDo(type, FindMinMaxEnum) ;
      RETURN( MinEnumerationField )
   ELSIF IsBaseType(type)
   THEN
      GetBaseTypeMinMax(type, min, max) ;
      RETURN( min )
   ELSIF IsSystemType(type)
   THEN
      GetSystemTypeMinMax(type, min, max) ;
      RETURN( min )
   ELSIF GetSType(type)=NulSym
   THEN
      MetaError1('unable to obtain the MIN value for type {%1as}', type) ;
      RETURN NulSym
   ELSE
      RETURN( GetTypeMin(GetSType(type)) )
   END
END GetTypeMin ;


(*
   GetTypeMax -
*)

PROCEDURE GetTypeMax (type: CARDINAL) : CARDINAL ;
VAR
   min, max: CARDINAL ;
BEGIN
   IF IsSubrange(type)
   THEN
      GetSubrange(type, max, min) ;
      RETURN( max )
   ELSIF IsSet(type)
   THEN
      RETURN( GetTypeMax(GetSType(type)) )
   ELSIF IsEnumeration(type)
   THEN
      MinEnumerationField := NulSym ;
      MaxEnumerationField := NulSym ;
      ForeachFieldEnumerationDo(type, FindMinMaxEnum) ;
      RETURN( MaxEnumerationField )
   ELSIF IsBaseType(type)
   THEN
      GetBaseTypeMinMax(type, min, max) ;
      RETURN( max )
   ELSIF IsSystemType(type)
   THEN
      GetSystemTypeMinMax(type, min, max) ;
      RETURN( max )
   ELSIF GetSType(type)=NulSym
   THEN
      MetaError1('unable to obtain the MAX value for type {%1as}', type) ;
      RETURN NulSym
   ELSE
      RETURN( GetTypeMax(GetSType(type)) )
   END
END GetTypeMax ;


(*
   PushNoOfBits - pushes the integer value of the number of bits required
                  to maintain a set of type.
*)

PROCEDURE PushNoOfBits (type: CARDINAL; low, high: CARDINAL) ;
BEGIN
   PushValue(high) ;
   ConvertToType(type) ;
   PushValue(low) ;
   ConvertToType(type) ;
   Sub ;
   ConvertToType(Cardinal)
END PushNoOfBits ;


(*
   DeclareLargeSet - n is the name of the set.
                     type is the subrange type (or simple type)
                     low and high are the limits of the subrange.
*)

PROCEDURE DeclareLargeSet (n: Name; type: CARDINAL; low, high: CARDINAL) : Tree ;
VAR
   lowtree,
   hightree,
   BitsInSet,
   RecordType,
   GccField,
   FieldList : Tree ;
   bpw       : CARDINAL ;
   location  : location_t ;
BEGIN
   location   := TokenToLocation(GetDeclaredMod(type)) ;
   bpw        := GetBitsPerBitset() ;
   PushValue(low) ;
   lowtree    := PopIntegerTree() ;
   PushValue(high) ;
   hightree   := PopIntegerTree() ;
   FieldList  := Tree(NIL) ;
   RecordType := BuildStartRecord(location, KeyToCharStar(n)) ;  (* no problem with recursive types here *)
   PushNoOfBits(type, low, high) ;
   PushCard(1) ;
   Addn ;
   BitsInSet := PopIntegerTree() ;
   PushIntegerTree(BitsInSet) ;
   PushCard(0) ;
   WHILE Gre(GetDeclaredMod(type)) DO
      PushIntegerTree(BitsInSet) ;
      PushCard(bpw-1) ;
      IF GreEqu(GetDeclaredMod(type))
      THEN
         PushIntegerTree(lowtree) ;
         PushCard(bpw-1) ;
         Addn ;
         GccField := BuildFieldRecord(location, NIL, BuildSetType(location, NIL, Mod2Gcc(type), lowtree, PopIntegerTree(), FALSE)) ;
         PushIntegerTree(lowtree) ;
         PushCard(bpw) ;
         Addn ;
         lowtree := PopIntegerTree() ;
         PushIntegerTree(BitsInSet) ;
         PushCard(bpw) ;
         Sub ;
         BitsInSet := PopIntegerTree()
      ELSE
         (* printf2('range is %a..%a\n', GetSymName(low), GetSymName(high)) ; *)
         GccField := BuildFieldRecord(location, NIL, BuildSetType(location, NIL, Mod2Gcc(type), lowtree, hightree, FALSE)) ;
         PushCard(0) ;
         BitsInSet := PopIntegerTree()
      END ;
      FieldList := ChainOn(FieldList, GccField) ;
      PushIntegerTree(BitsInSet) ;
      PushCard(0)
   END ;
   RETURN( BuildEndRecord(location, RecordType, FieldList, FALSE) )
END DeclareLargeSet ;


(*
   DeclareLargeOrSmallSet - works out whether the set will exceed TSIZE(WORD). If it does
                            we manufacture a set using:

                            settype = RECORD
                                         w1: SET OF [...]
                                         w2: SET OF [...]
                                      END

                            We do this as GCC and GDB (stabs) only knows about WORD sized sets.
                            If the set will fit into a WORD then we call gccgm2 directly.
*)

PROCEDURE DeclareLargeOrSmallSet (sym: CARDINAL;
                                  n: Name; type: CARDINAL; low, high: CARDINAL) : Tree ;
VAR
   location: location_t ;
   packed  : BOOLEAN ;
BEGIN
   PushNoOfBits(type, low, high) ;
   PushCard(GetBitsPerBitset()) ;
   packed := IsSetPacked (sym) ;
   IF Less(GetDeclaredMod(type))
   THEN
      location := TokenToLocation(GetDeclaredMod(sym)) ;
      (* small set *)
      (* PutSetSmall(sym) ; *)
      RETURN BuildSetType (location, KeyToCharStar(n),
                           Mod2Gcc(type), Mod2Gcc(low), Mod2Gcc(high), packed)
   ELSE
      (* PutSetLarge(sym) ; *)
      RETURN DeclareLargeSet (n, type, low, high)   (* --fixme-- finish packed here as well.  *)
   END
END DeclareLargeOrSmallSet ;


(*
   DeclareSet - declares a set type to gcc and returns a Tree.
*)

PROCEDURE DeclareSet (sym: CARDINAL) : Tree ;
VAR
   gccsym   : Tree ;
   type,
   high, low: CARDINAL ;
BEGIN
   type := GetDType(sym) ;
   IF IsSubrange(type)
   THEN
      GetSubrange(type, high, low) ;
      gccsym := DeclareLargeOrSmallSet(sym, GetFullSymName(sym), GetSType(type), low, high)
   ELSE
      gccsym := DeclareLargeOrSmallSet(sym, GetFullSymName(sym), type, GetTypeMin(type), GetTypeMax(type))
   END ;
   RETURN( gccsym )
END DeclareSet ;


(*
   CheckResolveSubrange - checks to see whether we can determine
                          the subrange type.  We are able to do
                          this once low, high and the type are known.
*)

PROCEDURE CheckResolveSubrange (sym: CARDINAL) ;
VAR
   size, high, low, type: CARDINAL ;
BEGIN
   GetSubrange(sym, high, low) ;
   type := GetSType(sym) ;
   IF type=NulSym
   THEN
      IF GccKnowsAbout(low) AND GccKnowsAbout(high)
      THEN
         IF IsConstString(low)
         THEN
            size := GetStringLength(low) ;
            IF size=1
            THEN
               PutSubrange(sym, low, high, Char)
            ELSE
               MetaError1('cannot have a subrange of a string type {%1Uad}',
                          sym)
            END
         ELSIF IsFieldEnumeration(low)
         THEN
            IF GetSType(low)=GetSType(high)
            THEN
               PutSubrange(sym, low, high, GetSType(low))
            ELSE
               MetaError1('subrange limits must be of the same type {%1Uad}', sym)
            END
         ELSIF IsValueSolved(low)
         THEN
            IF GetSType(low)=LongReal
            THEN
               MetaError1('cannot have a subrange of a SHORTREAL, REAL or LONGREAL type {%1Uad}', sym)
            ELSE
               PutSubrange(sym, low, high, MixTypes(GetSType(low), GetSType(high), GetDeclaredMod(sym)))
            END
         END
      END
   END
END CheckResolveSubrange ;


(*
   TypeConstFullyDeclared - all, sym, dependents are declared, so create and
                            return the GCC Tree equivalent.
*)

PROCEDURE TypeConstFullyDeclared (sym: CARDINAL) : Tree ;
VAR
   t: Tree ;
   n: Name ;
BEGIN
   IF IsEnumeration(sym)
   THEN
      t := DeclareEnumeration(sym)
   ELSIF IsFieldEnumeration(sym)
   THEN
      t := DeclareFieldEnumeration(sym)
   ELSIF IsSubrange(sym)
   THEN
      t := DeclareSubrange(sym)
   ELSIF IsRecord(sym)
   THEN
      t := CheckPragma(DeclareRecord(sym), sym)
   ELSIF IsRecordField(sym)
   THEN
      t := CheckPragma(DeclareRecordField(sym), sym)
   ELSIF IsFieldVarient(sym)
   THEN
      t := DeclareFieldVarient(sym)
   ELSIF IsVarient(sym)
   THEN
      t := DeclareVarient(sym)
   ELSIF IsPointer(sym)
   THEN
      t := CheckAlignment(DeclarePointer(sym), sym)
   ELSIF IsUnbounded(sym)
   THEN
      t := DeclareUnbounded(sym)
   ELSIF IsArray(sym)
   THEN
      t := CheckAlignment(DeclareArray(sym), sym)
   ELSIF IsProcType(sym)
   THEN
      t := DeclareProcType(sym)
   ELSIF IsSet(sym)
   THEN
      t := DeclareSet(sym)
   ELSIF IsConst(sym)
   THEN
      IF IsConstructor(sym)
      THEN
         PushValue(sym) ;
         ChangeToConstructor(GetDeclaredMod(sym), GetSType(sym)) ;
         PopValue(sym) ;
         EvaluateValue(sym) ;
         PutConstructorSolved(sym) ;
      ELSIF IsConstSet(sym)
      THEN
         EvaluateValue(sym)
      END ;
      IF NOT IsValueSolved(sym)
      THEN
         RETURN( NIL )
      END ;
      t := DeclareConst(GetDeclaredMod(sym), sym) ;
      Assert(t#NIL)
   ELSIF IsConstructor(sym)
   THEN
      (* not yet known as a constant *)
      RETURN( NIL )
   ELSE
      t := DeclareType(sym) ;
      IF IsType(sym)
      THEN
         t := CheckAlignment(t, sym)
      END
   END ;
   IF GetSymName(sym)#NulName
   THEN
      IF Debugging
      THEN
         n := GetSymName(sym) ;
         printf1('declaring type %a\n', n)
      END ;
      t := RememberType(t)
   END ;
   RETURN( t )
END TypeConstFullyDeclared ;


(*
   IsBaseType - returns true if a type, Sym, is a base type and
                we use predefined GDB information to represent this
                type.
*)

PROCEDURE IsBaseType (Sym: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( (Sym=Cardinal) OR (Sym=Integer) OR
           (Sym=Char) OR (Sym=Proc) )
END IsBaseType ;


(*
   IsFieldEnumerationDependants - sets enumDeps to FALSE if action(Sym)
                                  is also FALSE.
*)

PROCEDURE IsFieldEnumerationDependants (Sym: WORD) ;
BEGIN
   IF NOT action(Sym)
   THEN
      enumDeps := FALSE
   END
END IsFieldEnumerationDependants ;


(*
   IsEnumerationDependants - returns true if the enumeration
                             p(dependants) all return true.
*)

PROCEDURE IsEnumerationDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
BEGIN
   action := q ;
   enumDeps := TRUE ;
   ForeachFieldEnumerationDo(sym, IsFieldEnumerationDependants) ;
   RETURN( enumDeps )
END IsEnumerationDependants ;


(*
   WalkEnumerationDependants - returns walks all dependants of Sym.
*)

PROCEDURE WalkEnumerationDependants (sym: CARDINAL; p: WalkAction) ;
BEGIN
   ForeachFieldEnumerationDo(sym, p)
END WalkEnumerationDependants ;


(*
   WalkSubrangeDependants - calls p(dependants) for each dependant of, sym.
*)

PROCEDURE WalkSubrangeDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   type,
   high, low: CARDINAL ;
BEGIN
   GetSubrange(sym, high, low) ;
   CheckResolveSubrange(sym) ;
   type := GetSType(sym) ;
   IF type#NulSym
   THEN
      p(type)
   END ;
   (* low and high are not types but constants and they are resolved by M2GenGCC *)
   p(low) ;
   p(high)
END WalkSubrangeDependants ;


(*
   IsSubrangeDependants - returns TRUE if the subrange
                          q(dependants) all return TRUE.
*)

PROCEDURE IsSubrangeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   result   : BOOLEAN ;
   type,
   high, low: CARDINAL ;
BEGIN
   GetSubrange(sym, high, low) ;
   (* low and high are not types but constants and they are resolved by M2GenGCC *)
   CheckResolveSubrange(sym) ;
   result := TRUE ;
   type := GetSType(sym) ;
   IF (type=NulSym) OR (NOT q(type))
   THEN
      result := FALSE
   END ;
   IF NOT q(low)
   THEN
      result := FALSE
   END ;
   IF NOT q(high)
   THEN
      result := FALSE
   END ;
   RETURN( result )
END IsSubrangeDependants ;


(*
   WalkComponentDependants -
*)

PROCEDURE WalkComponentDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   i   : CARDINAL ;
   type: CARDINAL ;
BEGIN
   (* need to walk record and field *)
   i := 1 ;
   REPEAT
      type := GetNth(sym, i) ;
      IF type#NulSym
      THEN
         IF IsVar(type)
         THEN
            p(GetSType(type))
         ELSE
            p(type)
         END ;
         INC(i)
      END
   UNTIL type=NulSym
END WalkComponentDependants ;


(*
   IsComponentDependants -
*)

PROCEDURE IsComponentDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   type  : CARDINAL ;
   i     : CARDINAL ;
   result: BOOLEAN ;
BEGIN
   (* need to check record is completely resolved *)
   result := TRUE ;
   i := 1 ;
   REPEAT
      type := GetNth(sym, i) ;
      IF type#NulSym
      THEN
         IF IsVar(type)
         THEN
            type := GetSType(type)
         END ;
         IF NOT q(type)
         THEN
            result := FALSE
         END ;
         INC(i)
      END
   UNTIL type=NulSym ;
   RETURN( result )
END IsComponentDependants ;


(*
   WalkVarDependants - walks all dependants of sym.
*)

PROCEDURE WalkVarDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   type: CARDINAL ;
BEGIN
   p(GetSType(sym)) ;
   IF IsComponent(sym)
   THEN
      WalkComponentDependants(sym, p)
   END ;
   type := GetVarBackEndType(sym) ;
   IF type#NulSym
   THEN
      p(type)
   END
END WalkVarDependants ;


(*
   IsVarDependants - returns TRUE if the pointer symbol, sym,
                     p(dependants) all return TRUE.
*)

PROCEDURE IsVarDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   type  : CARDINAL ;
   result: BOOLEAN ;
BEGIN
   result := TRUE ;
   IF NOT q(GetSType(sym))
   THEN
      result := FALSE
   END ;
   IF IsComponent(sym)
   THEN
      IF NOT IsComponentDependants(sym, q)
      THEN
         result := FALSE
      END
   END ;
   type := GetVarBackEndType(sym) ;
   IF type#NulSym
   THEN
      IF NOT q(type)
      THEN
         result := FALSE
      END
   END ;
   RETURN( result )
END IsVarDependants ;


(*
   WalkPointerDependants - walks all dependants of sym.
*)

PROCEDURE WalkPointerDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   align: CARDINAL ;
BEGIN
   p(GetSType(sym)) ;
   align := GetAlignment(sym) ;
   IF align#NulSym
   THEN
      p(align)
   END
END WalkPointerDependants ;


(*
   IsPointerDependants - returns TRUE if the pointer symbol, sym,
      	       	         p(dependants) all return TRUE.
*)

PROCEDURE IsPointerDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   align: CARDINAL ;
   final: BOOLEAN ;
BEGIN
   final := TRUE ;
   IF NOT q(GetSType(sym))
   THEN
      final := FALSE
   END ;
   align := GetAlignment (sym) ;
   IF final AND (align # NulSym)
   THEN
      IF NOT q(align)
      THEN
         final := FALSE
      END
   END ;
   RETURN final
END IsPointerDependants ;


(*
   IsRecordAlignment -
*)

PROCEDURE IsRecordAlignment (sym: CARDINAL; q: IsAction) : BOOLEAN ;
BEGIN
   IF GetDefaultRecordFieldAlignment(sym)#NulSym
   THEN
      IF NOT q(GetDefaultRecordFieldAlignment(sym))
      THEN
         RETURN( FALSE )
      END
   END ;
   RETURN( TRUE )
END IsRecordAlignment ;


(*
   IsRecordDependants - returns TRUE if the symbol, sym,
                        q(dependants) all return TRUE.
*)

PROCEDURE IsRecordDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   result: BOOLEAN ;
   i     : CARDINAL ;
   field : CARDINAL ;
BEGIN
   result := IsRecordAlignment(sym, q) ;
   i := 1 ;
   REPEAT
      field := GetNth(sym, i) ;
      IF field#NulSym
      THEN
         IF IsRecordField(field)
         THEN
            IF (NOT IsRecordFieldAVarientTag(field)) OR (GetSymName(field)#NulName)
            THEN
               IF NOT q(field)
               THEN
                  result := FALSE
               END
            END
         ELSIF IsVarient(field)
         THEN
            IF NOT q(field)
            THEN
               result := FALSE
      	    END
      	 ELSIF IsFieldVarient(field)
      	 THEN
            InternalError ('should not see a field varient')
         ELSE
            InternalError ('unknown symbol in record')
      	 END
      END ;
      INC(i)
   UNTIL field=NulSym ;
   RETURN( result )
END IsRecordDependants ;


(*
   WalkRecordAlignment - walks the alignment constant associated with
                         record, sym.
*)

PROCEDURE WalkRecordAlignment (sym: CARDINAL; p: WalkAction) ;
BEGIN
   IF GetDefaultRecordFieldAlignment(sym)#NulSym
   THEN
      p(GetDefaultRecordFieldAlignment(sym))
   END
END WalkRecordAlignment ;


(*
   WalkRecordDependants - walks symbol, sym, dependants.  It only
                          walks the fields if the alignment is
                          unused or fully declared.
*)

PROCEDURE WalkRecordDependants (sym: CARDINAL; p: WalkAction) ;
BEGIN
   WalkRecordAlignment(sym, p) ;
   WalkRecordDependants2(sym, p)
END WalkRecordDependants ;


(*
   WalkRecordFieldDependants -
*)

PROCEDURE WalkRecordFieldDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   v    : CARDINAL ;
   align: CARDINAL ;
BEGIN
   Assert(IsRecordField(sym)) ;
   p(GetSType(sym)) ;
   v := GetVarient(sym) ;
   IF v#NulSym
   THEN
      p(v)
   END ;
   align := GetAlignment(sym) ;
   IF align#NulSym
   THEN
      p(align)
   END
END WalkRecordFieldDependants ;


(*
   WalkVarient -
*)

(*
PROCEDURE WalkVarient (sym: CARDINAL; p: WalkAction) ;
VAR
   v    : CARDINAL ;
   var,
   align: CARDINAL ;
BEGIN
   p(sym) ;
   v := GetVarient(sym) ;
   IF v#NulSym
   THEN
      p(v)
   END ;
   var := GetRecordOfVarient(sym) ;
   align := GetDefaultRecordFieldAlignment(var) ;
   IF align#NulSym
   THEN
      p(align)
   END
END WalkVarient ;
*)


(*
   WalkRecordDependants2 - walks the fields of record, sym, calling
                           p on every dependant.
*)

PROCEDURE WalkRecordDependants2 (sym: CARDINAL; p: WalkAction) ;
VAR
   i    : CARDINAL ;
   Field: CARDINAL ;
BEGIN
   i := 1 ;
   WHILE GetNth(sym, i)#NulSym DO
      Field := GetNth(sym, i) ;
      p(Field) ;
      IF IsRecordField(Field)
      THEN
         WalkRecordFieldDependants(Field, p)
      ELSIF IsVarient(Field)
      THEN
         WalkVarientDependants(Field, p)
      ELSIF IsFieldVarient(Field)
      THEN
         InternalError ('should not see a field varient')
      ELSE
         InternalError ('unknown symbol in record')
      END ;
      INC(i)
   END
END WalkRecordDependants2 ;


(*
   IsVarientAlignment -
*)

PROCEDURE IsVarientAlignment (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   align: CARDINAL ;
BEGIN
   sym := GetRecordOfVarient(sym) ;
   align := GetDefaultRecordFieldAlignment(sym) ;
   IF (align#NulSym) AND (NOT q(align))
   THEN
      RETURN( FALSE )
   END ;
   RETURN( TRUE )
END IsVarientAlignment ;


(*
   IsVarientDependants - returns TRUE if the symbol, sym,
                         q(dependants) all return TRUE.
*)

PROCEDURE IsVarientDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   result: BOOLEAN ;
   i     : CARDINAL ;
   Field : CARDINAL ;
BEGIN
   result := IsVarientAlignment(sym, q) ;
   i := 1 ;
   WHILE GetNth(sym, i)#NulSym DO
      Field := GetNth(sym, i) ;
      Assert(IsFieldVarient(Field)) ;
      IF NOT q(Field)
      THEN
         result := FALSE
      END ;
      INC(i)
   END ;
   RETURN( result )
END IsVarientDependants ;


(*
   WalkVarientAlignment -
*)

PROCEDURE WalkVarientAlignment (sym: CARDINAL; p: WalkAction) ;
VAR
   align: CARDINAL ;
BEGIN
   sym := GetRecordOfVarient(sym) ;
   align := GetDefaultRecordFieldAlignment(sym) ;
   IF align#NulSym
   THEN
      p(align)
   END
END WalkVarientAlignment ;


(*
   WalkVarientDependants - walks symbol, sym, dependants.
*)

PROCEDURE WalkVarientDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   i    : CARDINAL ;
   v,
   Field: CARDINAL ;
BEGIN
   WalkVarientAlignment(sym, p) ;
   IF GetSType(sym)#NulSym
   THEN
      p(GetSType(sym))
   END ;
   v := GetVarient(sym) ;
   IF v#NulSym
   THEN
      p(v)
   END ;
   i := 1 ;
   WHILE GetNth(sym, i)#NulSym DO
      Field := GetNth(sym, i) ;
      Assert(IsFieldVarient(Field)) ;  (* field varients do _not_ have a type *)
      p(Field) ;
      WalkVarientFieldDependants(Field, p) ;
      INC(i)
   END
END WalkVarientDependants ;


(*
   IsVarientFieldDependants - returns TRUE if the symbol, sym,
                              q(dependants) all return TRUE.
*)

PROCEDURE IsVarientFieldDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   i     : CARDINAL ;
   type,
   Field : CARDINAL ;
   result: BOOLEAN ;
BEGIN
   i := 1 ;
   result := IsVarientAlignment(sym, q) ;
   WHILE GetNth(sym, i)#NulSym DO
      Field := GetNth(sym, i) ;
      IF NOT q(Field)
      THEN
         result := FALSE
      END ;
      type := GetSType(Field) ;
      IF type#NulSym
      THEN
         IF NOT q(type)
         THEN
            result := FALSE
         END
      END ;
      INC(i)
   END ;
   RETURN( result )
END IsVarientFieldDependants ;


(*
   WalkVarientFieldDependants -
*)

PROCEDURE WalkVarientFieldDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   i    : CARDINAL ;
   type,
   Field: CARDINAL ;
BEGIN
   WalkVarientAlignment(sym, p) ;
   i := 1 ;
   WHILE GetNth(sym, i)#NulSym DO
      Field := GetNth(sym, i) ;
      p(Field) ;
      type := GetSType(Field) ;
      IF type#NulSym
      THEN
         p(type)
      END ;
      INC(i)
   END
END WalkVarientFieldDependants ;


(*
   IsArrayDependants - returns TRUE if the symbol, sym,
      	       	       q(dependants) all return TRUE.

*)

PROCEDURE IsArrayDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   result   : BOOLEAN ;
   align    : CARDINAL ;
   subscript: CARDINAL ;
   high, low: CARDINAL ;
   type     : CARDINAL ;
BEGIN
   result := TRUE ;
   Assert(IsArray(sym)) ;
   type := GetSType(sym) ;

   IF NOT q(type)
   THEN
      result := FALSE
   END ;
   subscript := GetArraySubscript(sym) ;
   IF subscript#NulSym
   THEN
      Assert(IsSubscript(subscript)) ;
      type := GetSType(subscript) ;
      IF NOT q(type)
      THEN
         result := FALSE
      END ;
      type := SkipType(type) ;
      (* the array might be declared as ARRAY type OF foo *)
      low  := GetTypeMin(type) ;
      high := GetTypeMax(type) ;
      IF NOT q(low)
      THEN
         result := FALSE
      END ;
      IF NOT q(high)
      THEN
         result := FALSE
      END ;
      align := GetAlignment(sym) ;
      IF (align#NulSym) AND (NOT q(align))
      THEN
         result := FALSE
      END
   END ;
   RETURN( result )
END IsArrayDependants ;


(*
   WalkArrayDependants - walks symbol, sym, dependants.
*)

PROCEDURE WalkArrayDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   align    : CARDINAL ;
   subscript: CARDINAL ;
   high, low: CARDINAL ;
   type     : CARDINAL ;
BEGIN
   Assert(IsArray(sym)) ;
   type := GetSType(sym) ;
   p(type) ;
   subscript := GetArraySubscript(sym) ;
   IF subscript#NulSym
   THEN
      Assert(IsSubscript(subscript)) ;
      type := GetSType(subscript) ;
      p(type) ;
      type := SkipType(type) ;
      (* the array might be declared as ARRAY type OF foo *)
      low  := GetTypeMin(type) ;
      high := GetTypeMax(type) ;
      p(low) ;
      p(high) ;
      align := GetAlignment (sym) ;
      IF align#NulSym
      THEN
         p(align)
      END
   END
END WalkArrayDependants ;


(*
   IsSetDependants - returns TRUE if the symbol, sym,
                     q(dependants) all return TRUE.
*)

PROCEDURE IsSetDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   result         : BOOLEAN ;
   type, low, high: CARDINAL ;
BEGIN
   result := TRUE ;
   Assert(IsSet(sym)) ;

   type := GetDType(sym) ;
   IF NOT q(type)
   THEN
      result := FALSE
   END ;
   low  := GetTypeMin(type) ;
   high := GetTypeMax(type) ;
   IF NOT q(low)
   THEN
      result := FALSE
   END ;
   IF NOT q(high)
   THEN
      result := FALSE
   END ;
   RETURN( result )
END IsSetDependants ;


(*
   WalkSetDependants - walks dependants, sym.
*)

PROCEDURE WalkSetDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   type, low, high: CARDINAL ;
BEGIN
   Assert(IsSet(sym)) ;

   type := GetDType(sym) ;
   p(type) ;
   low  := GetTypeMin(type) ;
   p(low) ;
   high := GetTypeMax(type) ;
   p(high)
END WalkSetDependants ;


(*
   IsProcTypeDependants -
*)

PROCEDURE IsProcTypeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   i, p, son : CARDINAL ;
   ParamType,
   ReturnType: CARDINAL ;
   result    : BOOLEAN ;
BEGIN
   result := TRUE ;
   Assert(IsProcType(sym)) ;
   i := 1 ;
   ReturnType := GetSType(sym) ;
   p := NoOfParam(sym) ;
   WHILE i<=p DO
      son := GetNthParam(sym, i) ;
      ParamType := GetSType(son) ;
      IF NOT q(ParamType)
      THEN
         result := FALSE
      END ;
      INC(i)
   END ;
   IF (ReturnType=NulSym) OR q(ReturnType)
   THEN
      RETURN( result )
   ELSE
      RETURN( FALSE )
   END
END IsProcTypeDependants ;


(*
   WalkProcTypeDependants - walks dependants, sym.
*)

PROCEDURE WalkProcTypeDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   i, n, son : CARDINAL ;
   ParamType,
   ReturnType: CARDINAL ;
BEGIN
   Assert(IsProcType(sym)) ;
   i := 1 ;
   ReturnType := GetSType(sym) ;
   n := NoOfParam(sym) ;
   WHILE i<=n DO
      son := GetNthParam(sym, i) ;
      ParamType := GetSType(son) ;
      p(ParamType) ;
      INC(i)
   END ;
   IF ReturnType#NulSym
   THEN
      p(ReturnType)
   END
END WalkProcTypeDependants ;


(*
   IsProcedureDependants -
*)

PROCEDURE IsProcedureDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   i, son    : CARDINAL ;
   type,
   ReturnType: CARDINAL ;
   result    : BOOLEAN ;
BEGIN
   result := TRUE ;
   Assert(IsProcedure(sym)) ;
   i := 1 ;
   ReturnType := GetSType(sym) ;
   WHILE GetNth(sym, i)#NulSym DO
      son := GetNth(sym, i) ;
      type := GetSType(son) ;
      IF NOT q(type)
      THEN
         result := FALSE
      END ;
      INC(i)
   END ;
   IF (ReturnType=NulSym) OR q(ReturnType)
   THEN
      RETURN( result )
   ELSE
      RETURN( FALSE )
   END
END IsProcedureDependants ;


(*
   WalkProcedureDependants - walks dependants, sym.
*)

PROCEDURE WalkProcedureDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   i, son    : CARDINAL ;
   type,
   ReturnType: CARDINAL ;
BEGIN
   Assert(IsProcedure(sym)) ;
   i := 1 ;
   ReturnType := GetSType(sym) ;
   WHILE GetNth(sym, i)#NulSym DO
      son := GetNth(sym, i) ;
      type := GetSType(son) ;
      p(type) ;
      INC(i)
   END ;
   IF ReturnType#NulSym
   THEN
      p(ReturnType)
   END
END WalkProcedureDependants ;


(*
   IsUnboundedDependants - returns TRUE if the symbol, sym,
                           q(dependants) all return TRUE.
*)

PROCEDURE IsUnboundedDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   result: BOOLEAN ;
BEGIN
   result := TRUE ;
   IF NOT q(GetUnboundedRecordType(sym))
   THEN
      result := FALSE
   END ;
   IF NOT q(Cardinal)
   THEN
      result := FALSE
   END ;
   IF NOT q(GetSType(sym))
   THEN
      result := FALSE
   END ;
   RETURN( result )
END IsUnboundedDependants ;


(*
   WalkUnboundedDependants - walks the dependants of, sym.
*)

PROCEDURE WalkUnboundedDependants (sym: CARDINAL; p: WalkAction) ;
BEGIN
   p(GetUnboundedRecordType(sym)) ;
   p(Cardinal) ;
   p(GetSType(sym))
END WalkUnboundedDependants ;


(*
   IsTypeDependants - returns TRUE if all q(dependants) return
                      TRUE.
*)

PROCEDURE IsTypeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
VAR
   align: CARDINAL ;
   type : CARDINAL ;
   final: BOOLEAN ;
BEGIN
   type := GetSType(sym) ;
   final := TRUE ;
   IF (type#NulSym) AND (NOT q(type))
   THEN
      final := FALSE
   END ;
   align := GetAlignment(sym) ;
   IF (align#NulSym) AND (NOT q(align))
   THEN
      final := FALSE
   END ;
   RETURN( final )
END IsTypeDependants ;


(*
   WalkTypeDependants - walks all dependants of, sym.
*)

PROCEDURE WalkTypeDependants (sym: CARDINAL; p: WalkAction) ;
VAR
   align: CARDINAL ;
   type : CARDINAL ;
BEGIN
   type := GetSType(sym) ;
   IF type#NulSym
   THEN
      p(type)
   END ;
   align := GetAlignment(sym) ;
   IF align#NulSym
   THEN
      p(align)
   END
END WalkTypeDependants ;


(*
   PoisonSymbols - poisons all gcc symbols from procedure, sym.
                   A debugging aid.
*)

PROCEDURE PoisonSymbols (sym: CARDINAL) ;
BEGIN
   IF IsProcedure(sym)
   THEN
      ForeachLocalSymDo(sym, Poison)
   END
END PoisonSymbols ;


(*
   ConstantKnownAndUsed -
*)

PROCEDURE ConstantKnownAndUsed (sym: CARDINAL; t: Tree) ;
BEGIN
   DeclareConstantFromTree(sym, RememberConstant(t))
END ConstantKnownAndUsed ;


(*
   InitDeclarations - initializes default types and the source filename.
*)

PROCEDURE InitDeclarations ;
BEGIN
   DeclareDefaultTypes ;
   DeclareDefaultConstants
END InitDeclarations ;


BEGIN
   ToDoList := InitSet(1) ;
   FullyDeclared := InitSet(1) ;
   PartiallyDeclared := InitSet(1) ;
   NilTypedArrays := InitSet(1) ;
   HeldByAlignment := InitSet(1) ;
   FinishedAlignment := InitSet(1) ;
   ToBeSolvedByQuads := InitSet(1) ;
   ChainedList := InitSet(1) ;
   WatchList := InitSet(1) ;
   VisitedList := NIL ;
   EnumerationIndex := InitIndex(1) ;
   IncludeElementIntoSet(WatchList, 8) ;
   HaveInitDefaultTypes := FALSE ;
   recursionCaught := FALSE
END M2GCCDeclare.