| (* P1SymBuild.mod pass 1 symbol creation. |
| |
| Copyright (C) 2001-2026 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 libc IMPORT printf ; |
| |
| 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 |
| 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 (OperandTok (i), 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 {%1dv}', 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. |
