| (* P0SymBuild.mod pass 0 symbol creation. |
| |
| Copyright (C) 2011-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 P0SymBuild ; |
| |
| FROM Storage IMPORT ALLOCATE, DEALLOCATE ; |
| FROM M2Printf IMPORT printf0, printf1, printf2 ; |
| FROM Lists IMPORT List, InitList, KillList, IncludeItemIntoList, RemoveItemFromList, NoOfItemsInList, GetItemFromList, IsItemInList ; |
| FROM Indexing IMPORT Index, InitIndex, HighIndice, LowIndice, GetIndice, RemoveIndiceFromIndex, IncludeIndiceIntoIndex ; |
| FROM M2Batch IMPORT MakeDefinitionSource, MakeProgramSource, MakeImplementationSource ; |
| FROM SymbolTable IMPORT NulSym, MakeInnerModule, SetCurrentModule, SetFileModule, MakeError, PutDefinitionForC ; |
| FROM NameKey IMPORT Name, NulName ; |
| FROM M2Quads IMPORT PushT, PushTF, PopT, PopTF, PopN, OperandT, PopTtok, PushTtok, OperandTok ; |
| FROM M2Reserved IMPORT ImportTok ; |
| FROM M2Debug IMPORT Assert ; |
| FROM M2MetaError IMPORT MetaErrorT1, MetaErrorT2, MetaError1, MetaError2 ; |
| FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ; |
| IMPORT M2Error ; |
| |
| |
| CONST |
| Debugging = FALSE ; |
| |
| TYPE |
| Kind = (module, program, defimp, inner, procedure, universe, unknown) ; |
| |
| BlockInfoPtr = POINTER TO RECORD |
| name : Name ; |
| kind : Kind ; |
| sym : CARDINAL ; |
| level : INTEGER ; |
| token : CARDINAL ; (* where the block starts. *) |
| LocalModules : List ; (* locally declared modules at the current level *) |
| ImportedModules: Index ; (* current list of imports for the scanned module *) |
| toPC, |
| toReturn, |
| toNext, (* next in same level *) |
| toUp, (* return to outer level *) |
| toDown : BlockInfoPtr ; (* first of the inner level *) |
| END ; |
| |
| ModuleDesc = POINTER TO RECORD |
| name: Name ; (* Name of the module. *) |
| tok : CARDINAL ; (* Location where the module ident was first seen. *) |
| END ; |
| |
| VAR |
| headBP, |
| curBP : BlockInfoPtr ; |
| Level : INTEGER ; |
| |
| |
| (* |
| nSpaces - |
| *) |
| |
| PROCEDURE nSpaces (n: CARDINAL) ; |
| BEGIN |
| WHILE n > 0 DO |
| printf0 (" ") ; |
| DEC (n) |
| END |
| END nSpaces ; |
| |
| |
| (* |
| DisplayB - |
| *) |
| |
| PROCEDURE DisplayB (b: BlockInfoPtr) ; |
| BEGIN |
| CASE b^.kind OF |
| |
| program : printf1 ("MODULE %a ;\n", b^.name) | |
| defimp : printf1 ("DEFIMP %a ;\n", b^.name) | |
| inner : printf1 ("INNER MODULE %a ;\n", b^.name) | |
| procedure: printf1 ("PROCEDURE %a ;\n", b^.name) |
| |
| ELSE |
| HALT |
| END |
| END DisplayB ; |
| |
| |
| (* |
| DisplayBlock - |
| *) |
| |
| PROCEDURE DisplayBlock (b: BlockInfoPtr; l: CARDINAL) ; |
| VAR |
| a: BlockInfoPtr ; |
| BEGIN |
| nSpaces (l) ; |
| DisplayB (b) ; |
| a := b^.toDown ; |
| INC (l, 3) ; |
| WHILE a # NIL DO |
| DisplayBlock (a, l) ; |
| a := a^.toNext |
| END ; |
| DEC (l, 3) ; |
| nSpaces (l) ; |
| printf1 ("END %a\n", b^.name) |
| END DisplayBlock ; |
| |
| |
| (* |
| pc - an interactive debugging aid callable from gdb. |
| *) |
| |
| (* |
| PROCEDURE pc ; |
| BEGIN |
| DisplayB (curBP) |
| END pc ; |
| *) |
| |
| |
| (* |
| Display - |
| *) |
| |
| PROCEDURE Display ; |
| VAR |
| b: BlockInfoPtr ; |
| BEGIN |
| printf0 ("Universe of Modula-2 modules\n") ; |
| IF headBP # NIL |
| THEN |
| b := headBP^.toDown ; |
| WHILE b # NIL DO |
| DisplayBlock (b, 0) ; |
| b := b^.toNext |
| END |
| END |
| END Display ; |
| |
| |
| (* |
| addDown - adds, b, to the down link of, a. |
| *) |
| |
| PROCEDURE addDown (a, b: BlockInfoPtr) ; |
| BEGIN |
| IF a^.toDown = NIL |
| THEN |
| a^.toDown := b |
| ELSE |
| a := a^.toDown ; |
| WHILE a^.toNext # NIL DO |
| a := a^.toNext |
| END ; |
| a^.toNext := b |
| END |
| END addDown ; |
| |
| |
| (* |
| GraftBlock - add a new block, b, into the tree in the correct order. |
| *) |
| |
| PROCEDURE GraftBlock (b: BlockInfoPtr) ; |
| BEGIN |
| Assert (curBP # NIL) ; |
| Assert (ABS (Level-curBP^.level) <= 1) ; |
| CASE Level-curBP^.level OF |
| |
| -1: (* returning up to the outer scope *) |
| curBP := curBP^.toUp ; |
| Assert (curBP^.toNext = NIL) ; |
| curBP^.toNext := b | |
| 0: (* add toNext *) |
| Assert (curBP^.toNext = NIL) ; |
| curBP^.toNext := b ; |
| b^.toUp := curBP^.toUp | |
| +1: (* insert down a level *) |
| b^.toUp := curBP ; (* save return value *) |
| addDown (curBP, b) |
| |
| ELSE |
| HALT |
| END ; |
| curBP := b |
| END GraftBlock ; |
| |
| |
| (* |
| BeginBlock - denotes the start of the next block. We remember all imports and |
| local modules and procedures created in this block. |
| *) |
| |
| PROCEDURE BeginBlock (n: Name; k: Kind; s: CARDINAL; tok: CARDINAL) ; |
| VAR |
| b: BlockInfoPtr ; |
| BEGIN |
| NEW (b) ; |
| WITH b^ DO |
| name := n ; |
| kind := k ; |
| sym := s ; |
| InitList (LocalModules) ; |
| ImportedModules := InitIndex (1) ; |
| toPC := NIL ; |
| toReturn := NIL ; |
| toNext := NIL ; |
| toDown := NIL ; |
| toUp := NIL ; |
| level := Level ; |
| token := tok |
| END ; |
| GraftBlock(b) |
| END BeginBlock ; |
| |
| |
| (* |
| InitUniverse - |
| *) |
| |
| PROCEDURE InitUniverse ; |
| BEGIN |
| NEW (curBP) ; |
| WITH curBP^ DO |
| name := NulName ; |
| kind := universe ; |
| sym := NulSym ; |
| InitList (LocalModules) ; |
| ImportedModules := InitIndex (1) ; |
| toNext := NIL ; |
| toDown := NIL ; |
| toUp := curBP ; |
| level := Level |
| END ; |
| headBP := curBP |
| END InitUniverse ; |
| |
| |
| (* |
| FlushImports - |
| *) |
| |
| PROCEDURE FlushImports (b: BlockInfoPtr) ; |
| VAR |
| i, n: CARDINAL ; |
| desc: ModuleDesc ; |
| BEGIN |
| WITH b^ DO |
| i := LowIndice (ImportedModules) ; |
| n := HighIndice (ImportedModules) ; |
| WHILE i <= n DO |
| desc := GetIndice (ImportedModules, i) ; |
| sym := MakeDefinitionSource (desc^.tok, desc^.name) ; |
| Assert (sym # NulSym) ; |
| INC (i) |
| END |
| END |
| END FlushImports ; |
| |
| |
| (* |
| EndBlock - shutdown the module and create definition symbols for all imported |
| modules. |
| *) |
| |
| PROCEDURE EndBlock ; |
| BEGIN |
| FlushImports (curBP) ; |
| curBP := curBP^.toUp ; |
| DEC (Level) ; |
| IF Level = 0 |
| THEN |
| FlushImports (curBP) |
| END |
| END EndBlock ; |
| |
| |
| (* |
| RegisterLocalModule - register, n, as a local module. |
| *) |
| |
| PROCEDURE RegisterLocalModule (modname: Name) ; |
| VAR |
| i, n: CARDINAL ; |
| desc: ModuleDesc ; |
| BEGIN |
| (* printf1('seen local module %a\n', n) ; *) |
| WITH curBP^ DO |
| IncludeItemIntoList (LocalModules, modname) ; |
| i := LowIndice (ImportedModules) ; |
| n := HighIndice (ImportedModules) ; |
| WHILE i <= n DO |
| desc := GetIndice (ImportedModules, i) ; |
| IF desc^.name = modname |
| THEN |
| RemoveIndiceFromIndex (ImportedModules, desc) ; |
| DISPOSE (desc) ; |
| DEC (n) |
| (* Continue checking in case a user imported the same module again. *) |
| ELSE |
| INC (i) |
| END |
| END |
| END |
| END RegisterLocalModule ; |
| |
| |
| (* |
| RegisterImport - register, n, as a module imported from either a local scope or definition module. |
| *) |
| |
| PROCEDURE RegisterImport (tok: CARDINAL; modname: Name) ; |
| VAR |
| bp : BlockInfoPtr ; |
| desc: ModuleDesc ; |
| BEGIN |
| (* printf1('register import from module %a\n', n) ; *) |
| Assert (curBP # NIL) ; |
| Assert (curBP^.toUp # NIL) ; |
| bp := curBP^.toUp ; (* skip over current module *) |
| WITH bp^ DO |
| IF NOT IsItemInList (LocalModules, modname) |
| THEN |
| NEW (desc) ; |
| desc^.name := modname ; |
| desc^.tok := tok ; |
| IncludeIndiceIntoIndex (ImportedModules, desc) |
| END |
| END |
| END RegisterImport ; |
| |
| |
| (* |
| RegisterImports - |
| *) |
| |
| PROCEDURE RegisterImports ; |
| VAR |
| index, |
| 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 |
| index := n+1-i ; |
| RegisterImport (OperandTok (index), OperandT (index)) ; |
| INC (i) |
| END |
| ELSE |
| (* Ident List contains list of objects *) |
| RegisterImport (OperandTok (n+1), OperandT (n+1)) |
| END ; |
| PopN (n+1) (* clear stack *) |
| END RegisterImports ; |
| |
| |
| (* |
| RegisterInnerImports - |
| *) |
| |
| PROCEDURE RegisterInnerImports ; |
| VAR |
| n: CARDINAL ; |
| BEGIN |
| PopT (n) ; (* n = # of the Ident List *) |
| IF OperandT (n+1) = ImportTok |
| THEN |
| (* Ident list contains list of objects, which will be seen outside the scope of this module. *) |
| ELSE |
| (* Ident List contains list of objects, but we are importing directly from a module OperandT(n+1) *) |
| RegisterImport (OperandTok (n+1), OperandT (n+1)) |
| END ; |
| PopN (n+1) (* clear stack *) |
| END RegisterInnerImports ; |
| |
| |
| (* |
| RegisterProgramModule - register the top of stack as a program module. |
| *) |
| |
| PROCEDURE RegisterProgramModule ; |
| VAR |
| n : Name ; |
| sym: CARDINAL ; |
| tok: CARDINAL ; |
| BEGIN |
| Assert (Level = 0) ; |
| INC (Level) ; |
| PopTtok (n, tok) ; |
| PushTtok (n, tok) ; |
| sym := MakeProgramSource (tok, n) ; |
| SetCurrentModule (sym) ; |
| SetFileModule (sym) ; |
| BeginBlock (n, program, sym, tok) ; |
| M2Error.EnterProgramScope (n) |
| END RegisterProgramModule ; |
| |
| |
| (* |
| RegisterImplementationModule - register the top of stack as an implementation module. |
| *) |
| |
| PROCEDURE RegisterImplementationModule ; |
| VAR |
| n : Name ; |
| sym: CARDINAL ; |
| tok: CARDINAL ; |
| BEGIN |
| Assert (Level = 0) ; |
| INC (Level) ; |
| PopTtok (n, tok) ; |
| PushTtok (n, tok) ; |
| sym := MakeImplementationSource (tok, n) ; |
| SetCurrentModule (sym) ; |
| SetFileModule (sym) ; |
| BeginBlock (n, defimp, sym, tok) ; |
| M2Error.EnterImplementationScope (n) |
| END RegisterImplementationModule ; |
| |
| |
| (* |
| RegisterDefinitionModule - register the top of stack as a definition module. |
| *) |
| |
| PROCEDURE RegisterDefinitionModule (forC: BOOLEAN) ; |
| VAR |
| n : Name ; |
| sym: CARDINAL ; |
| tok: CARDINAL ; |
| BEGIN |
| Assert (Level=0) ; |
| INC (Level) ; |
| PopTtok (n, tok) ; |
| PushTtok (n, tok) ; |
| sym := MakeDefinitionSource (tok, n) ; |
| SetCurrentModule (sym) ; |
| SetFileModule (sym) ; |
| IF forC |
| THEN |
| PutDefinitionForC (sym) |
| END ; |
| BeginBlock (n, defimp, sym, tok) ; |
| M2Error.EnterDefinitionScope (n) |
| END RegisterDefinitionModule ; |
| |
| |
| (* |
| RegisterInnerModule - register the top of stack as an inner module, this module name |
| will be removed from the list of outstanding imports in the |
| current module block. |
| *) |
| |
| PROCEDURE RegisterInnerModule ; |
| VAR |
| n : Name ; |
| tok: CARDINAL ; |
| BEGIN |
| INC (Level) ; |
| PopTtok (n, tok) ; |
| PushTtok (n, tok) ; |
| RegisterLocalModule (n) ; |
| BeginBlock (n, inner, NulSym, tok) ; |
| M2Error.EnterModuleScope (n) |
| END RegisterInnerModule ; |
| |
| |
| (* |
| RegisterProcedure - register the top of stack as a procedure. |
| *) |
| |
| PROCEDURE RegisterProcedure ; |
| VAR |
| n : Name ; |
| tok: CARDINAL ; |
| BEGIN |
| INC (Level) ; |
| PopTtok (n, tok) ; |
| PushTtok (n, tok) ; |
| BeginBlock (n, procedure, NulSym, tok) ; |
| M2Error.EnterProcedureScope (n) |
| END RegisterProcedure ; |
| |
| |
| (* |
| EndBuildProcedure - ends building a Procedure. |
| *) |
| |
| PROCEDURE EndProcedure ; |
| VAR |
| NameEnd, NameStart: Name ; |
| end, start : CARDINAL ; |
| BEGIN |
| PopTtok (NameEnd, end) ; |
| PopTtok (NameStart, start) ; |
| Assert (start # UnknownTokenNo) ; |
| Assert (end # UnknownTokenNo) ; |
| IF NameEnd # NameStart |
| THEN |
| IF NameEnd = NulName |
| THEN |
| MetaErrorT1 (start, |
| 'procedure name at beginning {%1Ea} does not match the name at end', |
| MakeError (start, NameStart)) ; |
| MetaError1 ('procedure name at end does not match the name at beginning {%1Ea}', |
| MakeError (start, NameStart)) |
| ELSE |
| MetaErrorT2 (start, |
| 'procedure name at beginning {%1Ea} does not match the name at end {%2a}', |
| MakeError (start, curBP^.name), MakeError (end, NameEnd)) ; |
| MetaErrorT2 (end, |
| 'procedure name at end {%1Ea} does not match the name at beginning {%2Ea}', |
| MakeError (end, NameEnd), MakeError (start, curBP^.name)) |
| END |
| END ; |
| EndBlock ; |
| M2Error.LeaveErrorScope |
| END EndProcedure ; |
| |
| |
| (* |
| EndForward - ends building a forward procedure. |
| *) |
| |
| PROCEDURE EndForward ; |
| BEGIN |
| PopN (1) ; |
| EndBlock ; |
| M2Error.LeaveErrorScope |
| END EndForward ; |
| |
| |
| (* |
| EndModule - |
| *) |
| |
| PROCEDURE EndModule ; |
| VAR |
| NameEnd, NameStart: Name ; |
| end, start : CARDINAL ; |
| BEGIN |
| PopTtok (NameEnd, end) ; |
| PopTtok (NameStart, start) ; |
| Assert (start # UnknownTokenNo) ; |
| Assert (end # UnknownTokenNo) ; |
| IF NameEnd # NameStart |
| THEN |
| IF NameEnd = NulName |
| THEN |
| MetaErrorT1 (start, |
| 'module name at beginning {%1Ea} does not match the name at end', |
| MakeError (start, NameStart)) ; |
| MetaError1 ('module name at end does not match the name at beginning {%1Ea}', |
| MakeError (start, NameStart)) |
| ELSE |
| MetaErrorT2 (start, |
| 'module name at beginning {%1Ea} does not match the name at end {%2a}', |
| MakeError (start, curBP^.name), MakeError (end, NameEnd)) ; |
| MetaErrorT2 (end, |
| 'module name at end {%1Ea} does not match the name at beginning {%2Ea}', |
| MakeError (end, NameEnd), MakeError (start, curBP^.name)) |
| END |
| END ; |
| EndBlock ; |
| M2Error.LeaveErrorScope |
| END EndModule ; |
| |
| |
| (* |
| DeclareModules - declare all inner modules seen at the current block level. |
| *) |
| |
| PROCEDURE DeclareModules ; |
| VAR |
| b: BlockInfoPtr ; |
| s: CARDINAL ; |
| BEGIN |
| b := curBP^.toDown ; |
| WHILE b # NIL DO |
| IF b^.kind = inner |
| THEN |
| IF Debugging |
| THEN |
| printf1 ("*** declaring inner module %a\n", b^.name) |
| END ; |
| s := MakeInnerModule (curBP^.token, b^.name) ; |
| Assert (s # NulSym) |
| END ; |
| b := b^.toNext |
| END |
| END DeclareModules ; |
| |
| |
| (**** |
| (* |
| MoveNext - |
| *) |
| |
| PROCEDURE MoveNext ; |
| VAR |
| b: BlockInfoPtr ; |
| BEGIN |
| IF curBP^.toNext#NIL |
| THEN |
| b := curBP^.toUp ; |
| (* moving to next *) |
| curBP := curBP^.toNext ; |
| (* remember our return *) |
| curBP^.toUp := b |
| END |
| END MoveNext ; |
| |
| |
| (* |
| MoveDown - |
| *) |
| |
| PROCEDURE MoveDown ; |
| VAR |
| b: BlockInfoPtr ; |
| BEGIN |
| (* move down a level *) |
| (* remember where we came from *) |
| b := curBP ; |
| curBP := curBP^.toDown ; |
| curBP^.toUp := b |
| END MoveDown ; |
| |
| |
| (* |
| MoveUp - |
| *) |
| |
| PROCEDURE MoveUp ; |
| BEGIN |
| (* move up to the outer scope *) |
| curBP := curBP^.toUp ; |
| END MoveUp ; |
| ***** *) |
| |
| |
| (* |
| Move - |
| *) |
| |
| PROCEDURE Move ; |
| VAR |
| b: BlockInfoPtr ; |
| BEGIN |
| IF Level = curBP^.level |
| THEN |
| b := curBP^.toReturn ; |
| (* moving to next *) |
| curBP := curBP^.toNext ; |
| (* remember our return *) |
| curBP^.toReturn := b |
| ELSE |
| WHILE Level # curBP^.level DO |
| IF Level < curBP^.level |
| THEN |
| (* move up to the outer scope *) |
| b := curBP ; |
| curBP := curBP^.toReturn ; |
| curBP^.toPC := b^.toNext (* remember where we reached *) |
| ELSE |
| (* move down a level *) |
| (* remember where we came from *) |
| b := curBP ; |
| IF curBP^.toPC = NIL |
| THEN |
| Assert (curBP^.toDown#NIL) ; |
| curBP^.toPC := curBP^.toDown |
| END ; |
| Assert (curBP^.toPC#NIL) ; |
| curBP := curBP^.toPC ; |
| curBP^.toReturn := b |
| END |
| END |
| END |
| END Move ; |
| |
| |
| (* |
| EnterBlock - |
| *) |
| |
| PROCEDURE EnterBlock (n: Name) ; |
| BEGIN |
| Assert (curBP#NIL) ; |
| INC (Level) ; |
| Move ; |
| IF Debugging |
| THEN |
| nSpaces (Level*3) ; |
| IF n = curBP^.name |
| THEN |
| printf1 ('block %a\n', n) |
| ELSE |
| printf2 ('seen block %a but tree has recorded %a\n', n, curBP^.name) |
| END |
| END ; |
| Assert ((n = curBP^.name) OR (curBP^.name = NulName)) ; |
| DeclareModules |
| END EnterBlock ; |
| |
| |
| (* |
| LeaveBlock - |
| *) |
| |
| PROCEDURE LeaveBlock ; |
| BEGIN |
| IF Debugging |
| THEN |
| printf1 ('leaving block %a ', curBP^.name) |
| END ; |
| DEC (Level) ; |
| Move |
| END LeaveBlock ; |
| |
| |
| (* |
| P0Init - |
| *) |
| |
| PROCEDURE P0Init ; |
| BEGIN |
| headBP := NIL ; |
| curBP := NIL ; |
| Level := 0 ; |
| InitUniverse |
| END P0Init ; |
| |
| |
| (* |
| P1Init - |
| *) |
| |
| PROCEDURE P1Init ; |
| BEGIN |
| IF Debugging |
| THEN |
| Display |
| END ; |
| (* curBP := headBP^.toDown ; *) |
| curBP := headBP ; |
| Assert(curBP#NIL) ; |
| curBP^.toPC := curBP^.toDown ; |
| curBP^.toReturn := curBP ; |
| Level := 0 |
| END P1Init ; |
| |
| |
| END P0SymBuild. |
