path: root/gcc/m2/gm2-compiler/P1SymBuild.mod

(* P1SymBuild.mod pass 1 symbol creation.

Copyright (C) 2001-2025 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 P1SymBuild ;


FROM ASCII IMPORT nul ;
FROM NameKey IMPORT Name, WriteKey, MakeKey, KeyToCharStar, NulName ;
FROM M2Debug IMPORT Assert, WriteDebug ;
FROM M2LexBuf IMPORT GetFileName, GetTokenNo, UnknownTokenNo ;

FROM M2MetaError IMPORT MetaErrorString2, MetaError0, MetaError1,
                        MetaError2, MetaErrorT0, MetaErrorT1, MetaErrorT2 ;

FROM DynamicStrings IMPORT String, Slice, InitString, KillString, EqualCharStar, RIndex, Mark, ConCat ;
FROM M2Printf IMPORT printf0, printf1, printf2 ;
FROM M2Options IMPORT Iso, GetEnableForward ;

FROM M2Reserved IMPORT ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
                       NulTok, VarTok, ArrayTok, BuiltinTok, InlineTok ;

FROM FifoQueue IMPORT PutEnumerationIntoFifoQueue ;
FROM P0SymBuild IMPORT EnterBlock, LeaveBlock ;

FROM SymbolTable IMPORT NulSym,
                        ModeOfAddr,
                        AppendModuleOnImportStatement,
                        AppendModuleImportStatement,
                        MakeImportStatement, MakeImport,

                        StartScope, EndScope, PseudoScope,
                        GetScope, GetCurrentScope,
                        IsDeclaredIn,
                        SetCurrentModule, SetFileModule,
                        MakeInnerModule,
                        MakeEnumeration, MakeSubrange,
                        MakeVar, MakeType, PutType,
                        MakeHiddenType,
                        PutMode,
                        PutFieldEnumeration, PutSubrange, PutVar,
                        IsDefImp, IsModule, IsInnerModule, IsType,
                        GetCurrentModule,
                        AddSymToModuleScope,
                        AddNameToImportList,
                        GetSym, RequestSym, IsUnknown, RenameSym,
                        GetFromOuterModule,
                        GetExported, IsExported,
                        GetLocalSym,
                        PutImported, PutIncludedByDefinition,
                        PutExported, PutExportQualified, PutExportUnQualified,
                        TryMoveUndeclaredSymToInnerModule,
                        PutDefinitionForC,
                        IsDefinitionForC,
                        PutDoesNeedExportList, PutDoesNotNeedExportList,
                        DoesNotNeedExportList,
                        MakeProcedure,
                        IsProcedure, IsConstString,
                        MakePointer, PutPointer,
                        MakeRecord, PutFieldRecord,
                        MakeArray,
                        MakeSubscript, PutSubscript,
                        PutArray, GetType, IsArray,
                        IsProcType, MakeProcType,
                        PutProcedureBuiltin, PutProcedureInline,
                        GetSymName,
                        ResolveImports, PutDeclared,
                        ProcedureKind,
                        PutProcedureDeclaredTok, GetProcedureDeclaredTok,
                        PutProcedureDefined, GetProcedureDefined,
                        MakeError, MakeErrorS,
                        DisplayTrees ;

FROM M2Batch IMPORT MakeDefinitionSource,
                    MakeImplementationSource,
                    MakeProgramSource,
                    LookupModule, LookupOuterModule ;

FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, OperandT, PopN, OperandTok,
                    PopTtok, PushTtok, PushTFtok, PopTFtok ;

FROM M2Comp IMPORT CompilingDefinitionModule,
                   CompilingImplementationModule,
                   CompilingProgramModule ;

CONST
   Debugging = FALSE ;

VAR
   importStatementCount: CARDINAL ;


(*
   StartBuildDefinitionModule - Creates a definition module and starts
                                a new scope.

                                he Stack is expected:

                                Entry                 Exit

                         Ptr ->
                                +------------+
                                | NameStart  |                       <- Ptr
                                |------------|        +------------+
                                | NulName/"C"|        | NameStart  |
                                |------------|        |------------|
*)

PROCEDURE P1StartBuildDefinitionModule ;
VAR
   name     : Name ;
   language,
   ModuleSym: CARDINAL ;
BEGIN
   importStatementCount := 0 ;
   PopT(name) ;
   (* CheckFileName(name, 'definition') ; *)
   ModuleSym := MakeDefinitionSource(GetTokenNo(), name) ;
   PutDoesNotNeedExportList(ModuleSym) ;
   SetCurrentModule(ModuleSym) ;
   SetFileModule(ModuleSym) ;
   StartScope(ModuleSym) ;
   Assert(IsDefImp(ModuleSym)) ;
   Assert(CompilingDefinitionModule()) ;
   PopT(language) ;
   IF (language#NulSym) AND IsConstString(language)
   THEN
      IF GetSymName(language)=MakeKey('C')
      THEN
         PutDefinitionForC(ModuleSym)
      ELSIF GetSymName(language)=NulName
      THEN
         MetaError0 ('{%E}currently a non modula-2 definition module can only be declared as DEFINITION FOR {%k"C"}')
      ELSE
         MetaError1 ('unknown definition module language {%1Ea}, currently a non modula-2 definition module can only be declared as DEFINITION FOR {%k"C"}', language)
      END
   END ;
   PushT(name) ;
   EnterBlock(name)
END P1StartBuildDefinitionModule ;


(*
   EndBuildDefinitionModule - Destroys the definition module scope and
                              checks for correct name.

                              The Stack is expected:

                              Entry                 Exit

                       Ptr ->
                              +------------+        +-----------+
                              | NameEnd    |        |           |
                              |------------|        |-----------|
                              | NameStart  |        |           | <- Ptr
                              |------------|        |-----------|
*)

PROCEDURE P1EndBuildDefinitionModule ;
VAR
   start    : CARDINAL ;
   NameStart,
   NameEnd  : Name ;
BEGIN
   Assert(CompilingDefinitionModule()) ;
   EndScope ;
   PopTtok(NameStart, start) ;
   PopT(NameEnd) ;
   IF Debugging
   THEN
      printf0('pass 1: ') ;
      DisplayTrees(GetCurrentModule())
   END ;
   IF NameStart#NameEnd
   THEN
      MetaError1 ('inconsistent definition module name {%1Wa}', MakeError (start, NameStart))
   END ;
   LeaveBlock
END P1EndBuildDefinitionModule ;


(*
   StartBuildImplementationModule - Creates an implementation module and starts
                                    a new scope.

                                    The Stack is expected:

                                    Entry                 Exit

                             Ptr ->                                     <- Ptr
                                    +------------+        +-----------+
                                    | NameStart  |        | NameStart |
                                    |------------|        |-----------|

*)

PROCEDURE P1StartBuildImplementationModule ;
VAR
   tok      : CARDINAL ;
   name     : Name ;
   ModuleSym: CARDINAL ;
BEGIN
   importStatementCount := 0 ;
   PopTtok (name, tok) ;
   (* CheckFileName(name, 'implementation') ; *)
   ModuleSym := MakeImplementationSource (tok, name) ;
   SetCurrentModule (ModuleSym) ;
   SetFileModule (ModuleSym) ;
   StartScope (ModuleSym) ;
   IF NOT IsDefImp (ModuleSym)
   THEN
      MetaError1 ('cannot find corresponding definition module for {%1Ea}', ModuleSym)
   END ;
   Assert (CompilingImplementationModule()) ;
   PushTtok (name, tok) ;
   EnterBlock (name)
END P1StartBuildImplementationModule ;


(*
   EndBuildImplementationModule - Destroys the implementation module scope and
                                  checks for correct name.

                                  The Stack is expected:

                                  Entry                 Exit

                           Ptr ->
                                  +------------+        +-----------+
                                  | NameEnd    |        |           |
                                  |------------|        |-----------|
                                  | NameStart  |        |           | <- Ptr
                                  |------------|        |-----------|
*)

PROCEDURE P1EndBuildImplementationModule ;
VAR
   start, end: CARDINAL ;
   NameStart,
   NameEnd   : Name ;
BEGIN
   ResolveImports ;
   Assert(CompilingImplementationModule()) ;
   EndScope ;
   PopTtok(NameStart, start) ;
   PopTtok(NameEnd, end) ;
   IF NameStart#NameEnd
   THEN
      MetaErrorT1 (end,
                   'inconsistent implementation module name {%1Wa}', MakeError (start, NameStart))
   END ;
   LeaveBlock
END P1EndBuildImplementationModule ;


(*
   StartBuildProgramModule - Creates a program module and starts
                             a new scope.

                             The Stack is expected:

                             Entry                 Exit

                      Ptr ->                                     <- Ptr
                             +------------+        +-----------+
                             | NameStart  |        | NameStart |
                             |------------|        |-----------|

*)

PROCEDURE P1StartBuildProgramModule ;
VAR
   tok      : CARDINAL ;
   name     : Name ;
   ModuleSym: CARDINAL ;
BEGIN
   importStatementCount := 0 ;
   PopTtok(name, tok) ;
   (* CheckFileName(name, 'main') ; *)
   ModuleSym := MakeProgramSource(tok, name) ;
   SetCurrentModule(ModuleSym) ;
   SetFileModule(ModuleSym) ;
   StartScope(ModuleSym) ;
   IF (NOT CompilingProgramModule()) OR IsDefImp(ModuleSym)
   THEN
      MetaErrorT1 (tok,
                   'module {%1Ea} has a corresponding DEFINITION MODULE but no IMPLEMENTATION keyword in the main module', ModuleSym)
   END ;
   PushTtok(name, tok) ;
   EnterBlock(name)
END P1StartBuildProgramModule ;


(*
   EndBuildProgramModule - Destroys the program module scope and
                           checks for correct name.

                           The Stack is expected:

                           Entry                 Exit

                    Ptr ->
                           +------------+        +-----------+
                           | NameEnd    |        |           |
                           |------------|        |-----------|
                           | NameStart  |        |           | <- Ptr
                           |------------|        |-----------|
*)

PROCEDURE P1EndBuildProgramModule ;
VAR
   start,
   end      : CARDINAL ;
   NameStart,
   NameEnd  : Name ;
BEGIN
   ResolveImports ;
   Assert(CompilingProgramModule()) ;
   EndScope ;
   PopTtok(NameStart, start) ;
   PopTtok(NameEnd, end) ;
   IF Debugging
   THEN
      printf0('pass 1: ') ;
      DisplayTrees(GetCurrentModule())
   END ;
   IF NameStart#NameEnd
   THEN
      MetaErrorT1 (end,
                   'inconsistent program module name {%1Wa}', MakeError (start, NameStart))
   END ;
   LeaveBlock
END P1EndBuildProgramModule ;


(*
   StartBuildInnerModule - Creates an Inner module and starts
                           a new scope.

                           The Stack is expected:

                           Entry                 Exit

                    Ptr ->                                     <- Ptr
                           +------------+        +-----------+
                           | NameStart  |        | NameStart |
                           |------------|        |-----------|

*)

PROCEDURE StartBuildInnerModule ;
VAR
   tok      : CARDINAL ;
   name     : Name ;
   ModuleSym: CARDINAL ;
BEGIN
   PopTtok(name, tok) ;
   ModuleSym := GetSym(name) ;
   Assert(ModuleSym#NulSym) ;
   StartScope(ModuleSym) ;
   Assert(NOT IsDefImp(ModuleSym)) ;
   PushTtok(name, tok) ;
   EnterBlock(name)
END StartBuildInnerModule ;


(*
   EndBuildInnerModule - Destroys the Inner module scope and
                         checks for correct name.

                         The Stack is expected:

                         Entry                 Exit

                  Ptr ->
                         +------------+        +-----------+
                         | NameEnd    |        |           |
                         |------------|        |-----------|
                         | NameStart  |        |           | <- Ptr
                         |------------|        |-----------|
*)

PROCEDURE EndBuildInnerModule ;
VAR
   start, end: CARDINAL ;
   NameStart,
   NameEnd   : Name ;
BEGIN
   EndScope ;
   PopTtok(NameStart, start) ;
   PopTtok(NameEnd, end) ;
   IF NameStart#NameEnd
   THEN
      MetaErrorT1 (end,
                   'inconsistent inner module name {%1Wa}', MakeError (start, NameStart))
   END ;
   LeaveBlock
END EndBuildInnerModule ;


(*
   BuildImportOuterModule - Builds imported identifiers into an outer module
                            from a definition module.

                            The Stack is expected:

                            Entry           OR    Entry

                     Ptr ->                Ptr ->
                            +------------+        +-----------+
                            | #          |        | #         |
                            |------------|        |-----------|
                            | Id1        |        | Id1       |
                            |------------|        |-----------|
                            .            .        .           .
                            .            .        .           .
                            .            .        .           .
                            |------------|        |-----------|
                            | Id#        |        | Id#       |
                            |------------|        |-----------|
                            | ImportTok  |        | Ident     |
                            |------------|        |-----------|

                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;


                            Exit

                            All above stack discarded
*)

PROCEDURE BuildImportOuterModule (definition: BOOLEAN) ;
VAR
   Sym, ModSym,
   i, n       : CARDINAL ;
BEGIN
   PopT(n) ;       (* n   = # of the Ident List *)
   IF OperandT(n+1)=ImportTok
   THEN
      (* Ident list contains Module Names *)
      i := 1 ;
      WHILE i<=n DO
         ModSym := LookupModule(OperandTok(n+1-i),
                                OperandT(n+1-i)) ;
         PutImported(ModSym) ;
         IF definition
         THEN
            PutIncludedByDefinition(ModSym)
         END ;
         INC(i)
      END
   ELSE
      (* Ident List contains list of objects *)
      ModSym := LookupModule(OperandTok(n+1),
                             OperandT(n+1)) ;
      i := 1 ;
      WHILE i<=n DO
(*
         WriteString('Importing ') ; WriteKey(Operand(j)) ; WriteString(' from ') ; WriteKey(GetSymName(ModSym)) ; WriteLn ;
*)
         Sym := GetExported (OperandTok (n+1-i),
                             ModSym, OperandT (n+1-i)) ;
         PutImported (Sym) ;
         INC (i)
      END
   END ;
   PopN (n+1)   (* clear stack *)
END BuildImportOuterModule ;


(*
   BuildExportOuterModule - Builds exported identifiers from an outer module
                            to the outside world of library modules.

                            The Stack is expected:

                            Entry           OR    Entry

                     Ptr ->                Ptr ->
                            +------------+        +--------------+
                            | #          |        | #            |
                            |------------|        |--------------|
                            | Id1        |        | Id1          |
                            |------------|        |--------------|
                            .            .        .              .
                            .            .        .              .
                            .            .        .              .
                            |------------|        |--------------|
                            | Id#        |        | Id#          |
                            |------------|        |--------------|
                            | ExportTok  |        | QualifiedTok |
                            |------------|        |--------------|

                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;

                            Error Condition


                            Exit

                            All above stack discarded
*)

PROCEDURE BuildExportOuterModule ;
VAR
   i, n: CARDINAL ;
BEGIN
   PopT (n) ;       (* n   = # of the Ident List *)
   IF (OperandT(n+1)=QualifiedTok) AND CompilingDefinitionModule()
   THEN
      PutDoesNeedExportList(GetCurrentModule()) ;
      (* Ident List contains list of export qualified objects *)
      i := 1 ;
      WHILE i<=n DO
         PutExportQualified (OperandTok (i), OperandT (i)) ;
         INC (i)
      END
   ELSIF (OperandT(n+1)=UnQualifiedTok) AND CompilingDefinitionModule()
   THEN
      PutDoesNeedExportList(GetCurrentModule()) ;
      (* Ident List contains list of export unqualified objects *)
      i := 1 ;
      WHILE i<=n DO
         PutExportUnQualified (OperandTok (i), OperandT(i)) ;
         INC (i)
      END
   ELSIF CompilingDefinitionModule()
   THEN
      MetaError0 ('the {%EkEXPORT} must be either {%kQUALIFIED} or {%kUNQUALIFIED} in a definition module')
   ELSE
      MetaError0 ('{%E}only allowed inter module exports in a definition module')
   END ;
   PopN (n+1)  (* clear stack *)
END BuildExportOuterModule ;


(*
   CheckExplicitExported - checks to see whether we are compiling
                           a definition module and whether the ident
                           is implicitly export qualified or unqualified.


                                  The Stack is expected:

                                  Entry                 Exit

                           Ptr ->                Ptr ->
                                  +------------+        +-----------+
                                  | Identname  |        | Identname |
                                  |------------|        |-----------|

*)

PROCEDURE CheckExplicitExported ;
BEGIN
   IF CompilingDefinitionModule() AND DoesNotNeedExportList(GetCurrentModule())
   THEN
      (* printf1('exporting identifier %a\n', OperandT(1)) ; *)
      PutExportQualified (OperandTok (1), OperandT(1))
   END
END CheckExplicitExported ;


(*
   BuildImportInnerModule - Builds imported identifiers into an inner module
                            from the last level of module.

                            The Stack is expected:

                            Entry           OR    Entry

                     Ptr ->                Ptr ->
                            +------------+        +-----------+
                            | #          |        | #         |
                            |------------|        |-----------|
                            | Id1        |        | Id1       |
                            |------------|        |-----------|
                            .            .        .           .
                            .            .        .           .
                            .            .        .           .
                            |------------|        |-----------|
                            | Id#        |        | Id#       |
                            |------------|        |-----------|
                            | ImportTok  |        | Ident     |
                            |------------|        |-----------|

                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;

                            Exit

                            All above stack discarded
*)

PROCEDURE BuildImportInnerModule ;
VAR
   Sym, ModSym,
   i, n       : CARDINAL ;
BEGIN
   PopT (n) ;       (* n   = # of the Ident List *)
   IF OperandT (n+1) = ImportTok
   THEN
      (* Ident List contains list of objects *)
      i := 1 ;
      WHILE i<=n DO
         AddNameToImportList (OperandT (i)) ;
         INC (i)
      END
   ELSE
      (* Ident List contains list of objects *)
      ModSym := LookupOuterModule (OperandTok(n+1),
                                   OperandT(n+1)) ;
      i := 1 ;
      WHILE i<=n DO
         Sym := GetExported (OperandTok (n+1-i), ModSym, OperandT (n+1-i)) ;
         PutImported (Sym) ;
         INC (i)
      END
   END ;
   PopN (n+1)    (* clear stack *)
END BuildImportInnerModule ;


(*
   BuildExportInnerModule - Builds exported identifiers from an inner module
                            to the next layer module.

                            The Stack is expected:

                            Entry           OR    Entry

                     Ptr ->                Ptr ->
                            +------------+        +--------------+
                            | #          |        | #            |
                            |------------|        |--------------|
                            | Id1        |        | Id1          |
                            |------------|        |--------------|
                            .            .        .              .
                            .            .        .              .
                            .            .        .              .
                            |------------|        |--------------|
                            | Id#        |        | Id#          |
                            |------------|        |--------------|
                            | ExportTok  |        | QualifiedTok |
                            |------------|        |--------------|

                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;


                            Exit


                            All above stack discarded
*)

PROCEDURE BuildExportInnerModule ;
VAR
   tok    : CARDINAL ;
   PrevMod,
   Sym,
   i, n   : CARDINAL ;
BEGIN
   PopT (n) ;       (* n   = # of the Ident List *)
   IF OperandT (n+1) = ExportTok
   THEN
      (* Ident List contains list of objects *)
      i := 1 ;
      PrevMod := GetScope (GetCurrentScope ()) ;
      WHILE i<=n DO
         tok := OperandTok (i) ;
         IF (PrevMod#NulSym) AND (IsModule(PrevMod) OR IsDefImp(PrevMod))
         THEN
            Sym := GetLocalSym (PrevMod, OperandT(i)) ;
            IF Sym=NulSym
            THEN
               Sym := TryMoveUndeclaredSymToInnerModule (PrevMod, GetCurrentScope (), OperandT (i)) ;
               IF Sym=NulSym
               THEN
                  Sym := RequestSym (tok, OperandT(i)) ;
                  PutExported (Sym)
               END
            ELSE
               (* use Sym which has already been created in outer scope *)
               AddSymToModuleScope (GetCurrentScope (), Sym)
            END
         ELSE
            Sym := RequestSym (tok, OperandT(i)) ;
            PutExported (Sym)
         END ;
         INC (i)
      END
   ELSE
      MetaError0 ('{%EkQUALIFIED} not allowed in an inner module')
   END ;
   PopN(n+1)    (* clear stack *)
END BuildExportInnerModule ;


(*
   StartBuildEnumeration - Builds an Enumeration type Type.


                           Stack

                           Entry                 Exit

                    Ptr ->
                           +------------+
                           | #          |
                           |------------|
                           | en 1       |
                           |------------|
                           | en 2       |
                           |------------|
                           .            .
                           .            .
                           .            .                       <- Ptr
                           |------------|        +------------+
                           | en #       |        | Type       |
                           |------------|        |------------|
                           | Name       |        | Name       |
                           |------------|        |------------|
*)

PROCEDURE StartBuildEnumeration ;
VAR
   name : Name ;
   n, i,
   Type : CARDINAL ;
   tokno: CARDINAL ;
BEGIN
   PopT(n) ;      (* No := # *)
   name := OperandT(n+1) ;
   tokno := OperandTok(n+1) ;
   Type := MakeEnumeration(tokno, name) ;
   i := 1 ;
   WHILE i<=n DO
      PutFieldEnumeration(OperandTok(n-i+1), Type, OperandT(n-i+1)) ;
      INC(i)
   END ;
   PutEnumerationIntoFifoQueue(Type) ;  (* store enumeration away for pass 2 *)
   PopN(n+1) ;
   PushTtok(name, tokno) ;
   PushTtok(Type, tokno)
END StartBuildEnumeration ;


(*
   EndBuildEnumeration - completes the construction of the enumeration type.


                         Stack

                         Entry                 Exit

                  Ptr ->
                         +------------+
                         | Type       |                          <- Ptr
                         |------------|        +---------------+
                         | Name       |        | Type  | Name  |
                         |------------|        |---------------|

                                               Empty
*)

PROCEDURE EndBuildEnumeration ;
VAR
   tokno : CARDINAL ;
   Sym,
   Type  : CARDINAL ;
   n1, n2,
   name  : Name ;
BEGIN
   (*
      Two cases

      - the type name the same as Name, or the name is nul. - do nothing.
      - when type with a name that is different to Name. In which case
        we create a new type.
   *)
   PopTtok(Type, tokno) ;
   PopT(name) ;

   IF Debugging
   THEN
      n1 := GetSymName(GetCurrentModule()) ;
      printf2('inside module %a declaring type name %a\n',
              n1, name) ;
      IF (NOT IsUnknown(Type))
      THEN
         n1 := GetSymName(GetScope(Type)) ;
         n2 := GetSymName(Type) ;
         printf2('type was created inside scope %a as name %a\n',
                 n1, n2)
      END
   END ;
   IF (name=NulName) OR (GetSymName(Type)=name)
   THEN
      (*
         Typically the declaration that causes this case is:

         VAR
            a: (blue, green, red) ;
             ^
             |
             +---- type has no name.

         in which case the constructed from StartBuildEnumeration is complete
      *)
      PushTFtok(Type, name, tokno)
   ELSE
      (* in this case we are seeing:

         TYPE
            name = (blue, green, red)

         so we construct the type name and define it to have the previously
         created enumeration type
      *)
      Sym := MakeType(tokno, name) ;
      PutType(Sym, Type) ;
      PushTFtok(Sym, name, tokno)
   END
END EndBuildEnumeration ;


(*
   BuildHiddenType - Builds a Hidden Type.


                     Stack

                     Entry                 Exit

              Ptr ->
                     +------------+
                     | Name       |                          <- Ptr
                     |------------|        Empty
*)

PROCEDURE BuildHiddenType ;
VAR
   name : Name ;
   tokno: CARDINAL ;
BEGIN
   PopTtok (name, tokno) ;
   (* WriteString('Hidden type encountered: ') ; *)
   (* WriteKey(Name) ; WriteLn ; *)
   Assert (MakeHiddenType (tokno, name) # NulSym)
END BuildHiddenType ;


(*
   StartBuildProcedure - Builds a Procedure.

                         The Stack:

                         Entry                 Exit

                  Ptr ->                                      <- Ptr
                         +------------+        +------------+
                         | Name       |        | ProcSym    |
                         |------------|        |------------|
                         | inlinetok  |        |            |
                         | or         |        |            |
                         | builtintok |        |            |
                         | or name or |        | Name       |
                         | NulTok     |        |            |
                         |------------|        |------------|
*)

PROCEDURE StartBuildProcedure ;
VAR
   tokno   : CARDINAL ;
   builtin,
   name    : Name ;
   ProcSym : CARDINAL ;
BEGIN
   PopTtok (name, tokno) ;
   PopT (builtin) ; (* was this procedure defined as a builtin?        *)
   PushTtok (name, tokno) ;   (* Name saved for the EndBuildProcedure name check *)
   ProcSym := RequestSym (tokno, name) ;
   IF IsUnknown (ProcSym)
   THEN
      (* A procedure may be created in a definition or implementation module, remember
         that an implementation module maybe compiled before the corresponding
         definition module.

         The procedure can also be created during a forward declaration.
         We record the forward declaration as the token of creation and adjust this
         later when we see the proper procedure declaration.  Likwwise when the forward
         keyword is seen we assign the procedure forward token location.  *)
      ProcSym := MakeProcedure (tokno, name)
   ELSIF IsProcedure (ProcSym)
   THEN
      (* Declared in the other module or it could have been declared by a forward decl,
         we overwrite the declaration to tokno.  The forward location is assigned in
         EndBuildForward.  *)
      PutDeclared (tokno, ProcSym)
   ELSE
      MetaError1 ('expecting a procedure name and symbol {%1Ea} has been declared as a {%1d}', ProcSym) ;
      PushT (ProcSym) ;
      RETURN
   END ;
   IF builtin#NulTok
   THEN
      IF builtin=BuiltinTok
      THEN
         PutProcedureBuiltin (ProcSym, name)
      ELSIF builtin=InlineTok
      THEN
         PutProcedureInline (ProcSym)
      ELSE
         PutProcedureBuiltin (ProcSym, builtin)
      END
   END ;
   PushTtok (ProcSym, tokno) ;
   StartScope (ProcSym) ;
   IF CompilingDefinitionModule ()
   THEN
      IF GetProcedureDefined (ProcSym, DefProcedure)
      THEN
         MetaErrorT1 (GetProcedureDeclaredTok (ProcSym, DefProcedure),
                      'first declaration of procedure {%1Ea} in the definition module', ProcSym) ;
         MetaErrorT1 (tokno,
                      'duplicate declaration of procedure {%1Ea} in the definition module', ProcSym)
      ELSE
         PutProcedureDeclaredTok (ProcSym, DefProcedure, tokno) ;
         PutProcedureDefined (ProcSym, DefProcedure)
      END
   ELSE
      EnterBlock (name)
   END
END StartBuildProcedure ;


(*
   EndBuildProcedure - Ends building a Procedure.
                       It checks the start procedure name matches the end
                       procedure name.

                       The Stack:

                       (Procedure Not Defined in definition module)

                       Entry                 Exit

                Ptr ->
                       +------------+
                       | NameEnd    |
                       |------------|
                       | ProcSym    |
                       |------------|
                       | NameStart  |
                       |------------|
                                             Empty
*)

PROCEDURE EndBuildProcedure ;
VAR
   tok,
   start, end: CARDINAL ;
   ProcSym   : CARDINAL ;
   NameEnd,
   NameStart : Name ;
BEGIN
   PopTtok(NameEnd, end) ;
   PopTtok(ProcSym, tok) ;
   PopTtok(NameStart, start) ;
   IF NameEnd # NameStart
   THEN
      IF end # UnknownTokenNo
      THEN
         MetaErrorT1 (end,
                      'procedure name at end does not match name at beginning {%1EDa}', ProcSym)
      ELSIF start # UnknownTokenNo
      THEN
         MetaErrorT2 (start,
                      'procedure name at end {%1EDa} does not match name at beginning {%2a}',
                      MakeError (end, NameEnd), ProcSym)
      ELSE
         MetaError1 ('procedure name at end does not match name at beginning {%1EDa}', ProcSym)
      END
   END ;
   EndScope ;
   IF GetProcedureDefined (ProcSym, ProperProcedure)
   THEN
      MetaErrorT1 (GetProcedureDeclaredTok (ProcSym, ProperProcedure),
                   'first proper declaration of procedure {%1Ea}', ProcSym) ;
      MetaErrorT1 (tok, 'procedure {%1Ea} has already been declared', ProcSym)
   ELSE
      PutProcedureDeclaredTok (ProcSym, ProperProcedure, tok) ;
      PutProcedureDefined (ProcSym, ProperProcedure)
   END ;
   Assert (NOT CompilingDefinitionModule()) ;
   LeaveBlock
END EndBuildProcedure ;


(*
   EndBuildForward - Ends building a forward procedure declaration.

                     The Stack:

                     (This procedure is not defined in definition module)

                     Entry                 Exit

              Ptr ->
                     +------------+
                     | ProcSym    |
                     |------------|
                     | NameStart  |
                     |------------|
                                           Empty
*)

PROCEDURE EndBuildForward (forwardPos: CARDINAL) ;
VAR
   ProcSym: CARDINAL ;
   tok    : CARDINAL ;
BEGIN
   ProcSym := OperandT (1) ;
   tok := OperandTok (1) ;
   IF NOT GetEnableForward ()
   THEN
      MetaErrorT0 (forwardPos,
                   'forward declaration has not been enabled, use -fiso or -fenable-forward to enable forward procedure declarations')
   END ;
   IF GetProcedureDefined (ProcSym, ForwardProcedure)
   THEN
      MetaErrorT1 (GetProcedureDeclaredTok (ProcSym, ForwardProcedure),
                   'first forward declaration of {%1Ea}', ProcSym) ;
      MetaErrorT1 (tok, 'forward declaration of procedure {%1Ea} has already occurred', ProcSym)
   ELSE
      PutProcedureDeclaredTok (ProcSym, ForwardProcedure, tok) ;
      PutProcedureDefined (ProcSym, ForwardProcedure)
   END ;
   PopN (2) ;
   EndScope ;
   Assert (NOT CompilingDefinitionModule ()) ;
   LeaveBlock
END EndBuildForward ;


(*
   BuildProcedureHeading - Builds a procedure heading for the definition
                           module procedures.

                           Operation only performed if compiling a
                           definition module.

                           The Stack:

                           Entry                       Exit

                    Ptr ->
                           +------------+
                           | ProcSym    |
                           |------------|
                           | NameStart  |
                           |------------|
                                                       Empty

*)

PROCEDURE BuildProcedureHeading ;
VAR
   ProcSym  : CARDINAL ;
   NameStart: Name ;
BEGIN
   IF CompilingDefinitionModule()
   THEN
      PopT(ProcSym) ;
      PopT(NameStart) ;
      EndScope
   END
END BuildProcedureHeading ;


(*
   BuildNulName - Pushes a NulName onto the top of the stack.
                  The Stack:


                  Entry                    Exit

                                                          <- Ptr
                  Empty                    +------------+
                                           | NulName    |
                                           |------------|
*)

PROCEDURE BuildNulName ;
BEGIN
   PushT(NulName)
END BuildNulName ;


(*
   BuildTypeEnd - Pops the type Type and Name.
                  The Stack:


                  Entry                    Exit


           Ptr ->
                  +-------------+
                  | Type | Name |          Empty
                  |-------------|
*)

PROCEDURE BuildTypeEnd ;
VAR
   Type: CARDINAL ;
   name: Name ;
BEGIN
   PopTF (Type, name)
END BuildTypeEnd ;


(*
   BuildImportStatement - create a new import statement in the current module.
                          It ignores local modules.

                          The quadruple stack is not used.
*)

PROCEDURE BuildImportStatement (tok: CARDINAL) ;
VAR
   scope: CARDINAL ;
BEGIN
   scope := GetCurrentScope () ;
   IF IsDefImp (scope) OR (IsModule (scope) AND (NOT IsInnerModule (scope)))
   THEN
      IF CompilingDefinitionModule () AND (NOT IsDefImp (scope))
      THEN
         MetaError1 ('module scope should be a definition module rather than {%1EDa}', scope)
      ELSE
         INC (importStatementCount) ;
         AppendModuleImportStatement (scope, MakeImportStatement (tok, importStatementCount))
      END
   END
END BuildImportStatement ;


(*
   AddImportToImportStatement - the top of stack is expected to be a module name.
                                This is looked up from the module universe and
                                wrapped in an import symbol and placed into the
                                current import statement.

                                The quadruple stack is unchanged.

                                Entry                      Exit


                         Ptr ->                                                   <- Ptr
                                +---------------------+    +---------------------+
                                | ImportedModuleName  |    | ImportedModuleName  |
                                |---------------------|    |---------------------|
*)

PROCEDURE AddImportToImportStatement (qualified: BOOLEAN) ;
VAR
   scope: CARDINAL ;
BEGIN
   scope := GetCurrentScope () ;
   IF IsDefImp (scope) OR (IsModule (scope) AND (NOT IsInnerModule (scope)))
   THEN
      IF CompilingDefinitionModule () AND (NOT IsDefImp (scope))
      THEN
         MetaError1 ('module scope should be a definition module rather than {%1EDa}', scope) ;
      ELSE
         AppendModuleOnImportStatement (scope, MakeImport (OperandTok (1),
                                                           LookupModule (OperandTok (1), OperandT (1)),
                                                           importStatementCount, qualified))
      END
   END
END AddImportToImportStatement ;


END P1SymBuild.