[thirdparty/gcc.git] / gcc / m2 / gm2-compiler / P3SymBuild.mod

(* P3SymBuild.mod pass 3 symbol creation.

Copyright (C) 2001-2024 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.
Commit	Line	Data
1eee94d3 GM	1	(* P3SymBuild.mod pass 3 symbol creation.
1eee94d3 GM	2
a945c346	3	Copyright (C) 2001-2024 Free Software Foundation, Inc.
1eee94d3 GM	4	Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
	5
	6	This file is part of GNU Modula-2.
	7
	8	GNU Modula-2 is free software; you can redistribute it and/or modify
	9	it under the terms of the GNU General Public License as published by
	10	the Free Software Foundation; either version 3, or (at your option)
	11	any later version.
	12
	13	GNU Modula-2 is distributed in the hope that it will be useful, but
	14	WITHOUT ANY WARRANTY; without even the implied warranty of
	15	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	16	General Public License for more details.
	17
	18	You should have received a copy of the GNU General Public License
	19	along with GNU Modula-2; see the file COPYING3. If not see
	20	<http://www.gnu.org/licenses/>. *)
	21
	22	IMPLEMENTATION MODULE P3SymBuild ;
	23
	24
	25	FROM NameKey IMPORT Name, WriteKey, NulName ;
	26	FROM StrIO IMPORT WriteString, WriteLn ;
	27	FROM NumberIO IMPORT WriteCard ;
	28	FROM M2Debug IMPORT Assert, WriteDebug ;
	29	FROM M2Error IMPORT WriteFormat0, WriteFormat1, WriteFormat2, FlushErrors, InternalError ;
	30	FROM M2LexBuf IMPORT GetTokenNo ;
	31
	32	FROM SymbolTable IMPORT NulSym, ModeOfAddr,
	33	StartScope, EndScope, GetScope, GetCurrentScope,
	34	GetModuleScope,
	35	SetCurrentModule, GetCurrentModule, SetFileModule,
	36	GetExported, IsExported, IsImplicityExported,
	37	IsDefImp, IsModule, IsImported, IsIncludedByDefinition,
	38	RequestSym,
	39	IsProcedure, PutOptArgInit,
	40	IsFieldEnumeration, GetType,
	41	CheckForUnknownInModule,
	42	GetFromOuterModule,
	43	GetMode, PutVariableAtAddress, ModeOfAddr, SkipType,
	44	IsSet, PutConstSet,
	45	IsConst, IsConstructor, PutConst, PutConstructor,
	46	PopValue, PushValue,
	47	MakeTemporary, PutVar,
	48	PutSubrange,
	49	GetSymName ;
	50
	51	FROM M2Batch IMPORT MakeDefinitionSource,
	52	MakeImplementationSource,
	53	MakeProgramSource,
	54	LookupOuterModule ;
	55
	56	FROM M2Quads IMPORT PushT, PopT, OperandT, PopN, PopTF, PushTF,
	57	PopTtok, PopTFtok, PushTtok, PushTFtok, OperandTok ;
	58
	59	FROM M2Comp IMPORT CompilingDefinitionModule,
	60	CompilingImplementationModule,
	61	CompilingProgramModule ;
	62
	63	FROM FifoQueue IMPORT GetSubrangeFromFifoQueue ;
	64	FROM M2Reserved IMPORT NulTok, ImportTok ;
	65	IMPORT M2Error ;
	66
	67
68	(*
69	StartBuildDefinitionModule - Creates a definition module and starts
70	a new scope.
71
72	The Stack is expected:
73
74	Entry Exit
75
76	Ptr -> <- Ptr
77	+------------+ +-----------+
78	\| NameStart \| \| NameStart \|
79	\|------------\| \|-----------\|
80
81	*)
82
83	PROCEDURE P3StartBuildDefModule ;
84	VAR
85	tok : CARDINAL ;
86	name : Name ;
87	ModuleSym: CARDINAL ;
88	BEGIN
89	PopTtok (name, tok) ;
90	ModuleSym := MakeDefinitionSource (tok, name) ;
91	SetCurrentModule (ModuleSym) ;
92	SetFileModule (ModuleSym) ;
93	StartScope (ModuleSym) ;
94	Assert (IsDefImp (ModuleSym)) ;
95	Assert (CompilingDefinitionModule ()) ;
96	PushT (name) ;
97	M2Error.EnterDefinitionScope (name)
98	END P3StartBuildDefModule ;
99
100
101	(*
102	EndBuildDefinitionModule - Destroys the definition module scope and
103	checks for correct name.
104
105	The Stack is expected:
106
107	Entry Exit
108
109	Ptr ->
110	+------------+ +-----------+
111	\| NameEnd \| \| \|
112	\|------------\| \|-----------\|
113	\| NameStart \| \| \| <- Ptr
114	\|------------\| \|-----------\|
115	*)
116
117	PROCEDURE P3EndBuildDefModule ;
118	VAR
119	NameStart,
120	NameEnd : CARDINAL ;
121	BEGIN
122	Assert(CompilingDefinitionModule()) ;
123	CheckForUnknownInModule ;
124	EndScope ;
125	PopT(NameEnd) ;
126	PopT(NameStart) ;
127	IF NameStart#NameEnd
128	THEN
129	WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)',
130	NameStart, NameEnd)
131	END ;
132	M2Error.LeaveErrorScope
133	END P3EndBuildDefModule ;
134
135
136	(*
137	StartBuildImplementationModule - Creates an implementation module and starts
138	a new scope.
139
140	The Stack is expected:
141
142	Entry Exit
143
144	Ptr -> <- Ptr
145	+------------+ +-----------+
146	\| NameStart \| \| NameStart \|
147	\|------------\| \|-----------\|
148
149	*)
150
151	PROCEDURE P3StartBuildImpModule ;
152	VAR
153	tok : CARDINAL ;
154	name : Name ;
155	ModuleSym: CARDINAL ;
156	BEGIN
157	PopTtok (name, tok) ;
158	ModuleSym := MakeImplementationSource (tok, name) ;
159	SetCurrentModule (ModuleSym) ;
160	SetFileModule (ModuleSym) ;
161	StartScope (ModuleSym) ;
162	Assert (IsDefImp(ModuleSym)) ;
163	Assert (CompilingImplementationModule()) ;
164	PushT (name) ;
165	M2Error.EnterImplementationScope (name)
166	END P3StartBuildImpModule ;
167
168
169	(*
170	EndBuildImplementationModule - Destroys the implementation module scope and
171	checks for correct name.
172
173	The Stack is expected:
174
175	Entry Exit
176
177	Ptr ->
178	+------------+ +-----------+
179	\| NameEnd \| \| \|
180	\|------------\| \|-----------\|
181	\| NameStart \| \| \| <- Ptr
182	\|------------\| \|-----------\|
183	*)
184
185	PROCEDURE P3EndBuildImpModule ;
186	VAR
187	NameStart,
188	NameEnd : Name ;
189	BEGIN
190	Assert(CompilingImplementationModule()) ;
191	CheckForUnknownInModule ;
192	EndScope ;
193	PopT(NameEnd) ;
194	PopT(NameStart) ;
195	IF NameStart#NameEnd
196	THEN
197	(* we dont issue an error based around incorrect module names as this is done in P1 and P2.
198	If we get here then something has gone wrong with our error recovery in P3, so we bail out.
199	*)
200	WriteFormat0('too many errors in pass 3') ;
201	FlushErrors
202	END ;
203	M2Error.LeaveErrorScope
204	END P3EndBuildImpModule ;
205
206
207	(*
208	StartBuildProgramModule - Creates a program module and starts
209	a new scope.
210
211	The Stack is expected:
212
213	Entry Exit
214
215	Ptr -> <- Ptr
216	+------------+ +-----------+
217	\| NameStart \| \| NameStart \|
218	\|------------\| \|-----------\|
219
220	*)
221
222	PROCEDURE P3StartBuildProgModule ;
223	VAR
224	tok : CARDINAL ;
225	name : Name ;
226	ModuleSym: CARDINAL ;
227	BEGIN
228	(* WriteString('StartBuildProgramModule') ; WriteLn ; *)
229	PopTtok(name, tok) ;
230	ModuleSym := MakeProgramSource(tok, name) ;
231	SetCurrentModule(ModuleSym) ;
232	SetFileModule(ModuleSym) ;
233	(* WriteString('MODULE - ') ; WriteKey(GetSymName(ModuleSym)) ; WriteLn ; *)
234	StartScope(ModuleSym) ;
235	Assert(CompilingProgramModule()) ;
236	Assert(NOT IsDefImp(ModuleSym)) ;
237	PushT(name) ;
238	M2Error.EnterProgramScope (name)
239	END P3StartBuildProgModule ;
240
241
242	(*
243	EndBuildProgramModule - Destroys the program module scope and
244	checks for correct name.
245
246	The Stack is expected:
247
248	Entry Exit
249
250	Ptr ->
251	+------------+ +-----------+
252	\| NameEnd \| \| \|
253	\|------------\| \|-----------\|
254	\| NameStart \| \| \| <- Ptr
255	\|------------\| \|-----------\|
256	*)
257
258	PROCEDURE P3EndBuildProgModule ;
259	VAR
260	NameStart,
261	NameEnd : Name ;
262	BEGIN
263	Assert(CompilingProgramModule()) ;
264	CheckForUnknownInModule ;
265	EndScope ;
266	PopT(NameEnd) ;
267	PopT(NameStart) ;
268	IF NameStart#NameEnd
269	THEN
270	(* we dont issue an error based around incorrect module names this would be done in P1 and P2.
271	If we get here then something has gone wrong with our error recovery in P3, so we bail out.
272	*)
273	WriteFormat0('too many errors in pass 3') ;
274	FlushErrors
275	END ;
276	M2Error.LeaveErrorScope
277	END P3EndBuildProgModule ;
278
279
280	(*
281	StartBuildInnerModule - Creates an Inner module and starts
282	a new scope.
283
284	The Stack is expected:
285
286	Entry Exit
287
288	Ptr -> <- Ptr
289	+------------+ +-----------+
290	\| NameStart \| \| NameStart \|
291	\|------------\| \|-----------\|
292
293	*)
294
295	PROCEDURE StartBuildInnerModule ;
296	VAR
297	name : Name ;
298	tok : CARDINAL ;
299	ModuleSym: CARDINAL ;
300	BEGIN
301	PopTtok (name, tok) ;
302	ModuleSym := RequestSym (tok, name) ;
303	Assert(IsModule(ModuleSym)) ;
304	StartScope(ModuleSym) ;
305	Assert(NOT IsDefImp(ModuleSym)) ;
306	SetCurrentModule(ModuleSym) ;
307	PushT(name) ;
308	M2Error.EnterModuleScope (name)
309	END StartBuildInnerModule ;
310
311
312	(*
313	EndBuildInnerModule - Destroys the Inner module scope and
314	checks for correct name.
315
316	The Stack is expected:
317
318	Entry Exit
319
320	Ptr ->
321	+------------+ +-----------+
322	\| NameEnd \| \| \|
323	\|------------\| \|-----------\|
324	\| NameStart \| \| \| <- Ptr
325	\|------------\| \|-----------\|
326	*)
327
328	PROCEDURE EndBuildInnerModule ;
329	VAR
330	NameStart,
331	NameEnd : Name ;
332	BEGIN
333	CheckForUnknownInModule ;
334	EndScope ;
335	PopT(NameEnd) ;
336	PopT(NameStart) ;
337	IF NameStart#NameEnd
338	THEN
339	(* we dont issue an error based around incorrect module names this would be done in P1 and P2.
340	If we get here then something has gone wrong with our error recovery in P3, so we bail out.
341	*)
342	WriteFormat0('too many errors in pass 3') ;
343	FlushErrors
344	END ;
345	SetCurrentModule(GetModuleScope(GetCurrentModule())) ;
346	M2Error.LeaveErrorScope
347	END EndBuildInnerModule ;
348
349
350	(*
351	CheckImportListOuterModule - checks to see that all identifiers are
352	exported from the definition module.
353
354	The Stack is expected:
355
356	Entry OR Entry
357
358	Ptr -> Ptr ->
359	+------------+ +-----------+
360	\| # \| \| # \|
361	\|------------\| \|-----------\|
362	\| Id1 \| \| Id1 \|
363	\|------------\| \|-----------\|
364	. . . .
365	. . . .
366	. . . .
367	\|------------\| \|-----------\|
368	\| Id# \| \| Id# \|
369	\|------------\| \|-----------\|
370	\| ImportTok \| \| Ident \|
371	\|------------\| \|-----------\|
372
373	IMPORT Id1, .. Id# ; FROM Ident IMPORT Id1 .. Id# ;
374
375
376	Error Condition
377	Exit
378
379	All above stack discarded
380	*)
381
382	PROCEDURE CheckImportListOuterModule ;
383	VAR
384	n1, n2 : Name ;
385	tok : CARDINAL ;
386	ModSym,
387	i, n : CARDINAL ;
388	BEGIN
389	PopT(n) ; (* n = # of the Ident List *)
390	IF OperandT(n+1)#ImportTok
391	THEN
392	(* Ident List contains list of objects *)
393	ModSym := LookupOuterModule(OperandTok(n+1), OperandT(n+1)) ;
394	i := 1 ;
395	WHILE i<=n DO
396	tok := OperandTok (i) ;
397	IF (NOT IsExported(ModSym, RequestSym (tok, OperandT (i)))) AND
398	(NOT IsImplicityExported(ModSym, RequestSym (tok, OperandT(i))))
399	THEN
400	n1 := OperandT(n+1) ;
401	n2 := OperandT(i) ;
402	WriteFormat2 ('symbol %a is not exported from definition or inner module %a', n2, n1)
403	END ;
404	INC(i)
405	END
406	END ;
407	PopN(n+1) (* clear stack *)
408	END CheckImportListOuterModule ;
409
410
411	(*
412	CheckCanBeImported - checks to see that it is legal to import, Sym, from, ModSym.
413	*)
414
415	PROCEDURE CheckCanBeImported (ModSym, Sym: CARDINAL) ;
416	VAR
417	n1, n2: Name ;
418	BEGIN
419	IF IsDefImp(ModSym)
420	THEN
421	IF IsExported(ModSym, Sym)
422	THEN
423	(* great all done *)
424	RETURN
425	ELSE
426	IF IsImplicityExported(ModSym, Sym)
427	THEN
428	(* this is also legal *)
429	RETURN
430	ELSIF IsDefImp(Sym) AND IsIncludedByDefinition(ModSym, Sym)
431	THEN
432	(* this is also legal (for a definition module) *)
433	RETURN
434	END ;
435	n1 := GetSymName(ModSym) ;
436	n2 := GetSymName(Sym) ;
437	WriteFormat2('symbol %a is not exported from definition module %a', n2, n1)
438	END
439	END
440	END CheckCanBeImported ;
441
442
443	(*
444	StartBuildProcedure - Builds a Procedure.
445
446	The Stack:
447
448	Entry Exit
449
450	<- Ptr
451	+------------+
452	Ptr -> \| ProcSym \|
453	+------------+ \|------------\|
454	\| Name \| \| Name \|
455	\|------------\| \|------------\|
456	*)
457
458	PROCEDURE StartBuildProcedure ;
459	VAR
460	tok : CARDINAL ;
461	name : Name ;
462	ProcSym : CARDINAL ;
463	BEGIN
464	PopTtok (name, tok) ;
465	PushTtok (name, tok) ; (* Name saved for the EndBuildProcedure name check *)
466	ProcSym := RequestSym (tok, name) ;
467	Assert (IsProcedure (ProcSym)) ;
468	PushTtok (ProcSym, tok) ;
469	StartScope (ProcSym) ;
470	M2Error.EnterProcedureScope (name)
471	END StartBuildProcedure ;
472
473
474	(*
475	EndBuildProcedure - Ends building a Procedure.
476	It checks the start procedure name matches the end
477	procedure name.
478
479	The Stack:
480
481	(Procedure Not Defined in definition module)
482
483	Entry Exit
484
485	Ptr ->
486	+------------+
487	\| NameEnd \|
488	\|------------\|
489	\| ProcSym \|
490	\|------------\|
491	\| NameStart \|
492	\|------------\|
493	Empty
494	*)
495
496	PROCEDURE EndBuildProcedure ;
497	VAR
498	ProcSym : CARDINAL ;
499	NameEnd,
500	NameStart: Name ;
501	BEGIN
502	PopT(NameEnd) ;
503	PopT(ProcSym) ;
504	PopT(NameStart) ;
505	IF NameEnd#NameStart
506	THEN
507	(* we dont issue an error based around incorrect module names this would be done in P1 and P2.
508	If we get here then something has gone wrong with our error recovery in P3, so we bail out.
509	*)
510	WriteFormat0('too many errors in pass 3') ;
511	FlushErrors
512	END ;
513	EndScope ;
514	M2Error.LeaveErrorScope
515	END EndBuildProcedure ;
516
517
518	(*
519	BuildProcedureHeading - Builds a procedure heading for the definition
520	module procedures.
521
522	Operation only performed if compiling a
523	definition module.
524
525	The Stack:
526
527	Entry Exit
528
529	Ptr ->
530	+------------+
531	\| ProcSym \|
532	\|------------\|
533	\| NameStart \|
534	\|------------\|
535	Empty
536
537	*)
538
539	PROCEDURE BuildProcedureHeading ;
540	VAR
541	ProcSym : CARDINAL ;
542	NameStart: Name ;
543	BEGIN
544	IF CompilingDefinitionModule()
545	THEN
546	PopT(ProcSym) ;
547	PopT(NameStart) ;
548	EndScope
549	END
550	END BuildProcedureHeading ;
551
552
553	(*
554	BuildSubrange - Builds a Subrange type Symbol.
555
556
557	Stack
558
559	Entry Exit
560
561	Ptr ->
562	+------------+
563	\| High \|
564	\|------------\|
565	\| Low \| <- Ptr
566	\|------------\|
567	*)
568
569	PROCEDURE BuildSubrange ;
570	VAR
571	Base,
572	Type,
573	Low,
574	High: CARDINAL ;
575	BEGIN
576	PopT(High) ;
577	PopT(Low) ;
578	GetSubrangeFromFifoQueue(Type) ; (* Collect subrange type from pass 2 and fill in *)
579	(* bounds. *)
580	GetSubrangeFromFifoQueue(Base) ; (* Get base of subrange (maybe NulSym) *)
581	(*
582	WriteString('Subrange type name is: ') ; WriteKey(GetSymName(Type)) ; WriteLn ;
583	WriteString('Subrange High is: ') ; WriteKey(GetSymName(High)) ;
584	WriteString(' Low is: ') ; WriteKey(GetSymName(Low)) ; WriteLn ;
585	*)
586	PutSubrange(Type, Low, High, Base) (* if Base is NulSym then it is *)
587	(* worked out later in M2GCCDeclare *)
588	END BuildSubrange ;
589
590
591	(*
592	BuildNulName - Pushes a NulKey onto the top of the stack.
593	The Stack:
594
595
596	Entry Exit
597
598	<- Ptr
599	Empty +------------+
600	\| NulKey \|
601	\|------------\|
602	*)
603
604	PROCEDURE BuildNulName ;
605	BEGIN
606	PushT(NulName)
607	END BuildNulName ;
608
609
610	(*
611	BuildConst - builds a constant.
612	Stack
613
614	Entry Exit
615
616	Ptr -> <- Ptr
617	+------------+ +------------+
618	\| Name \| \| Sym \|
619	\|------------+ \|------------\|
620	*)
621
622	PROCEDURE BuildConst ;
623	VAR
624	name: Name ;
625	tok : CARDINAL ;
626	Sym : CARDINAL ;
627	BEGIN
628	PopTtok (name, tok) ;
629	Sym := RequestSym (tok, name) ;
630	PushTtok (Sym, tok)
631	END BuildConst ;
632
633
634	(*
635	BuildVarAtAddress - updates the symbol table entry of, variable sym, to be declared
636	at address, address.
637
638	Stack
639
640	Entry Exit
641
642	Ptr ->
643	+--------------+
644	\| Expr \| EType \| <- Ptr
645	\|--------------+ +--------------+
646	\| name \| SType \| \| name \| SType \|
647	\|--------------+ \|--------------\|
648	*)
649
650	PROCEDURE BuildVarAtAddress ;
651	VAR
652	nametok : CARDINAL ;
653	name : Name ;
654	Sym, SType,
655	Exp, EType: CARDINAL ;
656	BEGIN
657	PopTF(Exp, EType) ;
658	PopTFtok (name, SType, nametok) ;
659	PushTF(name, SType) ;
660	Sym := RequestSym (nametok, name) ;
661	IF GetMode(Sym)=LeftValue
662	THEN
663	PutVariableAtAddress(Sym, Exp)
664	ELSE
665	InternalError ('expecting lvalue for this variable which is declared at an explicit address')
666	END
667	END BuildVarAtAddress ;
668
669
670	(*
671	BuildOptArgInitializer - assigns the constant value symbol, const, to be the
672	initial value of the optional parameter should it be
673	absent.
674
675	Ptr ->
676	+------------+
677	\| const \|
678	\|------------\| <- Ptr
679	*)
680
681	PROCEDURE BuildOptArgInitializer ;
682	VAR
683	const: CARDINAL ;
684	BEGIN
685	PopT(const) ;
686	PutOptArgInit(GetCurrentScope(), const)
687	END BuildOptArgInitializer ;
688
689
690	END P3SymBuild.