1 (* P0SymBuild.mod pass 0 symbol creation.
3 Copyright (C) 2011-2023 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
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)
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.
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/>. *)
22 IMPLEMENTATION MODULE P0SymBuild ;
24 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
25 FROM M2Printf IMPORT printf0, printf1, printf2 ;
26 FROM Lists IMPORT List, InitList, KillList, IncludeItemIntoList, RemoveItemFromList, NoOfItemsInList, GetItemFromList, IsItemInList ;
27 FROM Indexing IMPORT Index, InitIndex, HighIndice, LowIndice, GetIndice, RemoveIndiceFromIndex, IncludeIndiceIntoIndex ;
28 FROM M2Batch IMPORT MakeDefinitionSource, MakeProgramSource, MakeImplementationSource ;
29 FROM SymbolTable IMPORT NulSym, MakeInnerModule, SetCurrentModule, SetFileModule, MakeError, PutDefinitionForC ;
30 FROM NameKey IMPORT Name, NulName ;
31 FROM M2Quads IMPORT PushT, PushTF, PopT, PopTF, PopN, OperandT, PopTtok, PushTtok, OperandTok ;
32 FROM M2Reserved IMPORT ImportTok ;
33 FROM M2Debug IMPORT Assert ;
34 FROM M2MetaError IMPORT MetaErrorT1, MetaErrorT2, MetaError1, MetaError2 ;
35 FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ;
43 Kind = (module, program, defimp, inner, procedure, universe, unknown) ;
45 BlockInfoPtr = POINTER TO RECORD
50 token : CARDINAL ; (* where the block starts. *)
51 LocalModules : List ; (* locally declared modules at the current level *)
52 ImportedModules: Index ; (* current list of imports for the scanned module *)
55 toNext, (* next in same level *)
56 toUp, (* return to outer level *)
57 toDown : BlockInfoPtr ; (* first of the inner level *)
60 ModuleDesc = POINTER TO RECORD
61 name: Name ; (* Name of the module. *)
62 tok : CARDINAL ; (* Location where the module ident was first seen. *)
67 curBP : BlockInfoPtr ;
75 PROCEDURE nSpaces (n: CARDINAL) ;
88 PROCEDURE DisplayB (b: BlockInfoPtr) ;
92 program : printf1 ("MODULE %a ;\n", b^.name) |
93 defimp : printf1 ("DEFIMP %a ;\n", b^.name) |
94 inner : printf1 ("INNER MODULE %a ;\n", b^.name) |
95 procedure: printf1 ("PROCEDURE %a ;\n", b^.name)
107 PROCEDURE DisplayBlock (b: BlockInfoPtr; l: CARDINAL) ;
116 DisplayBlock (a, l) ;
121 printf1 ("END %a\n", b^.name)
126 pc - an interactive debugging aid callable from gdb.
145 printf0 ("Universe of Modula-2 modules\n") ;
148 b := headBP^.toDown ;
150 DisplayBlock (b, 0) ;
158 addDown - adds, b, to the down link of, a.
161 PROCEDURE addDown (a, b: BlockInfoPtr) ;
168 WHILE a^.toNext # NIL DO
177 GraftBlock - add a new block, b, into the tree in the correct order.
180 PROCEDURE GraftBlock (b: BlockInfoPtr) ;
182 Assert (curBP # NIL) ;
183 Assert (ABS (Level-curBP^.level) <= 1) ;
184 CASE Level-curBP^.level OF
186 -1: (* returning up to the outer scope *)
187 curBP := curBP^.toUp ;
188 Assert (curBP^.toNext = NIL) ;
191 Assert (curBP^.toNext = NIL) ;
193 b^.toUp := curBP^.toUp |
194 +1: (* insert down a level *)
195 b^.toUp := curBP ; (* save return value *)
206 BeginBlock - denotes the start of the next block. We remember all imports and
207 local modules and procedures created in this block.
210 PROCEDURE BeginBlock (n: Name; k: Kind; s: CARDINAL; tok: CARDINAL) ;
219 InitList (LocalModules) ;
220 ImportedModules := InitIndex (1) ;
237 PROCEDURE InitUniverse ;
244 InitList (LocalModules) ;
245 ImportedModules := InitIndex (1) ;
259 PROCEDURE FlushImports (b: BlockInfoPtr) ;
265 i := LowIndice (ImportedModules) ;
266 n := HighIndice (ImportedModules) ;
268 desc := GetIndice (ImportedModules, i) ;
269 sym := MakeDefinitionSource (desc^.tok, desc^.name) ;
270 Assert (sym # NulSym) ;
278 EndBlock - shutdown the module and create definition symbols for all imported
284 FlushImports (curBP) ;
285 curBP := curBP^.toUp ;
295 RegisterLocalModule - register, n, as a local module.
298 PROCEDURE RegisterLocalModule (modname: Name) ;
303 (* printf1('seen local module %a\n', n) ; *)
305 IncludeItemIntoList (LocalModules, modname) ;
306 i := LowIndice (ImportedModules) ;
307 n := HighIndice (ImportedModules) ;
309 desc := GetIndice (ImportedModules, i) ;
310 IF desc^.name = modname
312 RemoveIndiceFromIndex (ImportedModules, desc) ;
315 (* Continue checking in case a user imported the same module again. *)
321 END RegisterLocalModule ;
325 RegisterImport - register, n, as a module imported from either a local scope or definition module.
328 PROCEDURE RegisterImport (tok: CARDINAL; modname: Name) ;
333 (* printf1('register import from module %a\n', n) ; *)
334 Assert (curBP # NIL) ;
335 Assert (curBP^.toUp # NIL) ;
336 bp := curBP^.toUp ; (* skip over current module *)
338 IF NOT IsItemInList (LocalModules, modname)
341 desc^.name := modname ;
343 IncludeIndiceIntoIndex (ImportedModules, desc)
353 PROCEDURE RegisterImports ;
358 PopT (n) ; (* n = # of the Ident List *)
359 IF OperandT (n+1) = ImportTok
361 (* Ident list contains Module Names *)
365 RegisterImport (OperandTok (index), OperandT (index)) ;
369 (* Ident List contains list of objects *)
370 RegisterImport (OperandTok (n+1), OperandT (n+1))
372 PopN (n+1) (* clear stack *)
373 END RegisterImports ;
377 RegisterInnerImports -
380 PROCEDURE RegisterInnerImports ;
384 PopT (n) ; (* n = # of the Ident List *)
385 IF OperandT (n+1) = ImportTok
387 (* Ident list contains list of objects, which will be seen outside the scope of this module. *)
389 (* Ident List contains list of objects, but we are importing directly from a module OperandT(n+1) *)
390 RegisterImport (OperandTok (n+1), OperandT (n+1))
392 PopN (n+1) (* clear stack *)
393 END RegisterInnerImports ;
397 RegisterProgramModule - register the top of stack as a program module.
400 PROCEDURE RegisterProgramModule ;
410 sym := MakeProgramSource (tok, n) ;
411 SetCurrentModule (sym) ;
412 SetFileModule (sym) ;
413 BeginBlock (n, program, sym, tok) ;
414 M2Error.EnterProgramScope (n)
415 END RegisterProgramModule ;
419 RegisterImplementationModule - register the top of stack as an implementation module.
422 PROCEDURE RegisterImplementationModule ;
432 sym := MakeImplementationSource (tok, n) ;
433 SetCurrentModule (sym) ;
434 SetFileModule (sym) ;
435 BeginBlock (n, defimp, sym, tok) ;
436 M2Error.EnterImplementationScope (n)
437 END RegisterImplementationModule ;
441 RegisterDefinitionModule - register the top of stack as a definition module.
444 PROCEDURE RegisterDefinitionModule (forC: BOOLEAN) ;
454 sym := MakeDefinitionSource (tok, n) ;
455 SetCurrentModule (sym) ;
456 SetFileModule (sym) ;
459 PutDefinitionForC (sym)
461 BeginBlock (n, defimp, sym, tok) ;
462 M2Error.EnterDefinitionScope (n)
463 END RegisterDefinitionModule ;
467 RegisterInnerModule - register the top of stack as an inner module, this module name
468 will be removed from the list of outstanding imports in the
469 current module block.
472 PROCEDURE RegisterInnerModule ;
480 RegisterLocalModule (n) ;
481 BeginBlock (n, inner, NulSym, tok) ;
482 M2Error.EnterModuleScope (n)
483 END RegisterInnerModule ;
487 RegisterProcedure - register the top of stack as a procedure.
490 PROCEDURE RegisterProcedure ;
498 BeginBlock (n, procedure, NulSym, tok) ;
499 M2Error.EnterProcedureScope (n)
500 END RegisterProcedure ;
504 EndBuildProcedure - ends building a Procedure.
507 PROCEDURE EndProcedure ;
509 NameEnd, NameStart: Name ;
510 end, start : CARDINAL ;
512 PopTtok (NameEnd, end) ;
513 PopTtok (NameStart, start) ;
514 Assert (start # UnknownTokenNo) ;
515 Assert (end # UnknownTokenNo) ;
516 IF NameEnd # NameStart
521 'procedure name at beginning {%1Ea} does not match the name at end',
522 MakeError (start, NameStart)) ;
523 MetaError1 ('procedure name at end does not match the name at beginning {%1Ea}',
524 MakeError (start, NameStart))
527 'procedure name at beginning {%1Ea} does not match the name at end {%2a}',
528 MakeError (start, curBP^.name), MakeError (end, NameEnd)) ;
530 'procedure name at end {%1Ea} does not match the name at beginning {%2Ea}',
531 MakeError (end, NameEnd), MakeError (start, curBP^.name))
535 M2Error.LeaveErrorScope
543 PROCEDURE EndModule ;
545 NameEnd, NameStart: Name ;
546 end, start : CARDINAL ;
548 PopTtok (NameEnd, end) ;
549 PopTtok (NameStart, start) ;
550 Assert (start # UnknownTokenNo) ;
551 Assert (end # UnknownTokenNo) ;
552 IF NameEnd # NameStart
557 'module name at beginning {%1Ea} does not match the name at end',
558 MakeError (start, NameStart)) ;
559 MetaError1 ('module name at end does not match the name at beginning {%1Ea}',
560 MakeError (start, NameStart))
563 'module name at beginning {%1Ea} does not match the name at end {%2a}',
564 MakeError (start, curBP^.name), MakeError (end, NameEnd)) ;
566 'module name at end {%1Ea} does not match the name at beginning {%2Ea}',
567 MakeError (end, NameEnd), MakeError (start, curBP^.name))
571 M2Error.LeaveErrorScope
576 DeclareModules - declare all inner modules seen at the current block level.
579 PROCEDURE DeclareModules ;
590 printf1 ("*** declaring inner module %a\n", b^.name)
592 s := MakeInnerModule (curBP^.token, b^.name) ;
613 curBP := curBP^.toNext ;
614 (* remember our return *)
628 (* move down a level *)
629 (* remember where we came from *)
631 curBP := curBP^.toDown ;
642 (* move up to the outer scope *)
643 curBP := curBP^.toUp ;
656 IF Level = curBP^.level
658 b := curBP^.toReturn ;
660 curBP := curBP^.toNext ;
661 (* remember our return *)
664 WHILE Level # curBP^.level DO
665 IF Level < curBP^.level
667 (* move up to the outer scope *)
669 curBP := curBP^.toReturn ;
670 curBP^.toPC := b^.toNext (* remember where we reached *)
672 (* move down a level *)
673 (* remember where we came from *)
677 Assert (curBP^.toDown#NIL) ;
678 curBP^.toPC := curBP^.toDown
680 Assert (curBP^.toPC#NIL) ;
681 curBP := curBP^.toPC ;
693 PROCEDURE EnterBlock (n: Name) ;
703 printf1 ('block %a\n', n)
705 printf2 ('seen block %a but tree has recorded %a\n', n, curBP^.name)
708 Assert ((n = curBP^.name) OR (curBP^.name = NulName)) ;
717 PROCEDURE LeaveBlock ;
721 printf1 ('leaving block %a ', curBP^.name)
751 (* curBP := headBP^.toDown ; *)
754 curBP^.toPC := curBP^.toDown ;
755 curBP^.toReturn := curBP ;