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

(* P3SymBuild.mod pass 3 symbol creation.

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 P3SymBuild ;


FROM NameKey IMPORT Name, WriteKey, NulName ;
FROM StrIO IMPORT WriteString, WriteLn ;
FROM NumberIO IMPORT WriteCard ;
FROM M2Debug IMPORT Assert, WriteDebug ;
FROM M2Error IMPORT WriteFormat0, WriteFormat1, WriteFormat2, FlushErrors, InternalError ;
FROM M2LexBuf IMPORT GetTokenNo ;

FROM SymbolTable IMPORT NulSym, ModeOfAddr,
                        StartScope, EndScope, GetScope, GetCurrentScope,
                        GetModuleScope,
                        SetCurrentModule, GetCurrentModule, SetFileModule,
                        GetExported, IsExported, IsImplicityExported,
                        IsDefImp, IsModule, IsImported, IsIncludedByDefinition,
                        RequestSym,
                        IsProcedure, PutOptArgInit,
                        IsFieldEnumeration, GetType,
                        CheckForUnknownInModule,
                        GetFromOuterModule,
                        GetMode, PutVariableAtAddress, ModeOfAddr, SkipType,
                        IsSet, PutConstSet,
                        IsConst, IsConstructor, PutConst, PutConstructor,
                        PopValue, PushValue,
                        MakeTemporary, PutVar,
                        PutSubrange,
                        GetSymName ;

FROM M2Batch IMPORT MakeDefinitionSource,
                    MakeImplementationSource,
                    MakeProgramSource,
                    LookupOuterModule ;

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

FROM M2Comp IMPORT CompilingDefinitionModule,
                   CompilingImplementationModule,
                   CompilingProgramModule ;

FROM FifoQueue IMPORT GetSubrangeFromFifoQueue ;
FROM M2Reserved IMPORT NulTok, ImportTok ;
IMPORT M2Error ;


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

                                The Stack is expected:

                                Entry                 Exit

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

*)

PROCEDURE P3StartBuildDefModule ;
VAR
   tok      : CARDINAL ;
   name     : Name ;
   ModuleSym: CARDINAL ;
BEGIN
   PopTtok (name, tok) ;
   ModuleSym := MakeDefinitionSource (tok, name) ;
   SetCurrentModule (ModuleSym) ;
   SetFileModule (ModuleSym) ;
   StartScope (ModuleSym) ;
   Assert (IsDefImp (ModuleSym)) ;
   Assert (CompilingDefinitionModule ()) ;
   PushT (name) ;
   M2Error.EnterDefinitionScope (name)
END P3StartBuildDefModule ;


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

                              The Stack is expected:

                              Entry                 Exit

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

PROCEDURE P3EndBuildDefModule ;
VAR
   NameStart,
   NameEnd  : CARDINAL ;
BEGIN
   Assert(CompilingDefinitionModule()) ;
   CheckForUnknownInModule ;
   EndScope ;
   PopT(NameEnd) ;
   PopT(NameStart) ;
   IF NameStart#NameEnd
   THEN
      WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)',
                   NameStart, NameEnd)
   END ;
   M2Error.LeaveErrorScope
END P3EndBuildDefModule ;


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

                                    The Stack is expected:

                                    Entry                 Exit

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

*)

PROCEDURE P3StartBuildImpModule ;
VAR
   tok      : CARDINAL ;
   name     : Name ;
   ModuleSym: CARDINAL ;
BEGIN
   PopTtok (name, tok) ;
   ModuleSym := MakeImplementationSource (tok, name) ;
   SetCurrentModule (ModuleSym) ;
   SetFileModule (ModuleSym) ;
   StartScope (ModuleSym) ;
   Assert (IsDefImp(ModuleSym)) ;
   Assert (CompilingImplementationModule()) ;
   PushT (name) ;
   M2Error.EnterImplementationScope (name)
END P3StartBuildImpModule ;


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

                                  The Stack is expected:

                                  Entry                 Exit

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

PROCEDURE P3EndBuildImpModule ;
VAR
   NameStart,
   NameEnd  : Name ;
BEGIN
   Assert(CompilingImplementationModule()) ;
   CheckForUnknownInModule ;
   EndScope ;
   PopT(NameEnd) ;
   PopT(NameStart) ;
   IF NameStart#NameEnd
   THEN
      (* we dont issue an error based around incorrect module names as this is done in P1 and P2.
         If we get here then something has gone wrong with our error recovery in P3, so we bail out.
      *)
      WriteFormat0('too many errors in pass 3') ;
      FlushErrors
   END ;
   M2Error.LeaveErrorScope
END P3EndBuildImpModule ;


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

                             The Stack is expected:

                             Entry                 Exit

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

*)

PROCEDURE P3StartBuildProgModule ;
VAR
   tok      : CARDINAL ;
   name     : Name ;
   ModuleSym: CARDINAL ;
BEGIN
   (* WriteString('StartBuildProgramModule') ; WriteLn ; *)
   PopTtok(name, tok) ;
   ModuleSym := MakeProgramSource(tok, name) ;
   SetCurrentModule(ModuleSym) ;
   SetFileModule(ModuleSym) ;
   (* WriteString('MODULE - ') ; WriteKey(GetSymName(ModuleSym)) ; WriteLn ; *)
   StartScope(ModuleSym) ;
   Assert(CompilingProgramModule()) ;
   Assert(NOT IsDefImp(ModuleSym)) ;
   PushT(name) ;
   M2Error.EnterProgramScope (name)
END P3StartBuildProgModule ;


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

                           The Stack is expected:

                           Entry                 Exit

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

PROCEDURE P3EndBuildProgModule ;
VAR
   NameStart,
   NameEnd  : Name ;
BEGIN
   Assert(CompilingProgramModule()) ;
   CheckForUnknownInModule ;
   EndScope ;
   PopT(NameEnd) ;
   PopT(NameStart) ;
   IF NameStart#NameEnd
   THEN
      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
         If we get here then something has gone wrong with our error recovery in P3, so we bail out.
      *)
      WriteFormat0('too many errors in pass 3') ;
      FlushErrors
   END ;
   M2Error.LeaveErrorScope
END P3EndBuildProgModule ;


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

                           The Stack is expected:

                           Entry                 Exit

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

*)

PROCEDURE StartBuildInnerModule ;
VAR
   name     : Name ;
   tok      : CARDINAL ;
   ModuleSym: CARDINAL ;
BEGIN
   PopTtok (name, tok) ;
   ModuleSym := RequestSym (tok, name) ;
   Assert(IsModule(ModuleSym)) ;
   StartScope(ModuleSym) ;
   Assert(NOT IsDefImp(ModuleSym)) ;
   SetCurrentModule(ModuleSym) ;
   PushT(name) ;
   M2Error.EnterModuleScope (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
   NameStart,
   NameEnd  : Name ;
BEGIN
   CheckForUnknownInModule ;
   EndScope ;
   PopT(NameEnd) ;
   PopT(NameStart) ;
   IF NameStart#NameEnd
   THEN
      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
         If we get here then something has gone wrong with our error recovery in P3, so we bail out.
      *)
      WriteFormat0('too many errors in pass 3') ;
      FlushErrors
   END ;
   SetCurrentModule(GetModuleScope(GetCurrentModule())) ;
   M2Error.LeaveErrorScope
END EndBuildInnerModule ;


(*
   CheckImportListOuterModule - checks to see that all identifiers are
                                exported from the 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# ;


                                                      Error Condition
                                Exit

                                All above stack discarded
*)

PROCEDURE CheckImportListOuterModule ;
VAR
   n1, n2     : Name ;
   tok        : CARDINAL ;
   ModSym,
   i, n       : CARDINAL ;
BEGIN
   PopT(n) ;       (* n   = # of the Ident List *)
   IF OperandT(n+1)#ImportTok
   THEN
      (* Ident List contains list of objects *)
      ModSym := LookupOuterModule(OperandTok(n+1), OperandT(n+1)) ;
      i := 1 ;
      WHILE i<=n DO
         tok := OperandTok (i) ;
         IF (NOT IsExported(ModSym, RequestSym (tok, OperandT (i)))) AND
            (NOT IsImplicityExported(ModSym, RequestSym (tok, OperandT(i))))
         THEN
            n1 := OperandT(n+1) ;
            n2 := OperandT(i) ;
            WriteFormat2 ('symbol %a is not exported from definition or inner module %a', n2, n1)
         END ;
         INC(i)
      END
   END ;
   PopN(n+1)   (* clear stack *)
END CheckImportListOuterModule ;


(*
   CheckCanBeImported - checks to see that it is legal to import, Sym, from, ModSym.
*)

PROCEDURE CheckCanBeImported (ModSym, Sym: CARDINAL) ;
VAR
   n1, n2: Name ;
BEGIN
   IF IsDefImp(ModSym)
   THEN
      IF IsExported(ModSym, Sym)
      THEN
         (* great all done *)
         RETURN
      ELSE
         IF IsImplicityExported(ModSym, Sym)
         THEN
            (* this is also legal *)
            RETURN
         ELSIF IsDefImp(Sym) AND IsIncludedByDefinition(ModSym, Sym)
         THEN
            (* this is also legal (for a definition module) *)
            RETURN
         END ;
         n1 := GetSymName(ModSym) ;
         n2 := GetSymName(Sym) ;
         WriteFormat2('symbol %a is not exported from definition module %a', n2, n1)
      END
   END
END CheckCanBeImported ;


(*
   StartBuildProcedure - Builds a Procedure.

                         The Stack:

                         Entry                 Exit

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

PROCEDURE StartBuildProcedure ;
VAR
   tok     : CARDINAL ;
   name    : Name ;
   ProcSym : CARDINAL ;
BEGIN
   PopTtok (name, tok) ;
   PushTtok (name, tok) ;  (* Name saved for the EndBuildProcedure name check *)
   ProcSym := RequestSym (tok, name) ;
   Assert (IsProcedure (ProcSym)) ;
   PushTtok (ProcSym, tok) ;
   StartScope (ProcSym) ;
   M2Error.EnterProcedureScope (name)
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
   ProcSym  : CARDINAL ;
   NameEnd,
   NameStart: Name ;
BEGIN
   PopT(NameEnd) ;
   PopT(ProcSym) ;
   PopT(NameStart) ;
   IF NameEnd#NameStart
   THEN
      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
         If we get here then something has gone wrong with our error recovery in P3, so we bail out.
      *)
      WriteFormat0('too many errors in pass 3') ;
      FlushErrors
   END ;
   EndScope ;
   M2Error.LeaveErrorScope
END EndBuildProcedure ;


(*
   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 ;


(*
   BuildSubrange - Builds a Subrange type Symbol.


                      Stack

                      Entry                 Exit

               Ptr ->
                      +------------+
                      | High       |
                      |------------|
                      | Low        |                       <- Ptr
                      |------------|
*)

PROCEDURE BuildSubrange ;
VAR
   Base,
   Type,
   Low,
   High: CARDINAL ;
BEGIN
   PopT(High) ;
   PopT(Low) ;
   GetSubrangeFromFifoQueue(Type) ;  (* Collect subrange type from pass 2 and fill in *)
                                     (* bounds.                                       *)
   GetSubrangeFromFifoQueue(Base) ;  (* Get base of subrange (maybe NulSym)           *)
(*
   WriteString('Subrange type name is: ') ; WriteKey(GetSymName(Type)) ; WriteLn ;
   WriteString('Subrange High is: ') ; WriteKey(GetSymName(High)) ;
   WriteString(' Low is: ') ; WriteKey(GetSymName(Low)) ; WriteLn ;
*)
   PutSubrange(Type, Low, High, Base)   (* if Base is NulSym then it is       *)
                                        (* worked out later in M2GCCDeclare   *)
END BuildSubrange ;


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


                  Entry                    Exit

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

PROCEDURE BuildNulName ;
BEGIN
   PushT(NulName)
END BuildNulName ;


(*
   BuildConst - builds a constant.
                Stack

                Entry                 Exit

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

PROCEDURE BuildConst ;
VAR
   name: Name ;
   tok : CARDINAL ;
   Sym : CARDINAL ;
BEGIN
   PopTtok (name, tok) ;
   Sym := RequestSym (tok, name) ;
   PushTtok (Sym, tok)
END BuildConst ;


(*
   BuildVarAtAddress - updates the symbol table entry of, variable sym, to be declared
                       at address, address.

                       Stack

                       Entry                 Exit

                Ptr ->
                       +--------------+
                       | Expr | EType |                         <- Ptr
                       |--------------+        +--------------+
                       | name | SType |        | name | SType |
                       |--------------+        |--------------|
*)

PROCEDURE BuildVarAtAddress ;
VAR
   nametok   : CARDINAL ;
   name      : Name ;
   Sym, SType,
   Exp, EType: CARDINAL ;
BEGIN
   PopTF(Exp, EType) ;
   PopTFtok (name, SType, nametok) ;
   PushTF(name, SType) ;
   Sym := RequestSym (nametok, name) ;
   IF GetMode(Sym)=LeftValue
   THEN
      PutVariableAtAddress(Sym, Exp)
   ELSE
      InternalError ('expecting lvalue for this variable which is declared at an explicit address')
   END
END BuildVarAtAddress ;


(*
   BuildOptArgInitializer - assigns the constant value symbol, const, to be the
                            initial value of the optional parameter should it be
                            absent.

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

PROCEDURE BuildOptArgInitializer ;
VAR
   const: CARDINAL ;
BEGIN
   PopT(const) ;
   PutOptArgInit(GetCurrentScope(), const)
END BuildOptArgInitializer ;


END P3SymBuild.