[gcc r14-9429] PR modula2/114295 Incorrect location if compiling implementation without definition
Gaius Mulley
gaius@gcc.gnu.org
Mon Mar 11 15:22:23 GMT 2024
https://gcc.gnu.org/g:8410402272038aae7e4b2bd76df38607a78cad95
commit r14-9429-g8410402272038aae7e4b2bd76df38607a78cad95
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Mon Mar 11 15:21:42 2024 +0000
PR modula2/114295 Incorrect location if compiling implementation without definition
This patch fixes a bug which occurred if gm2 was asked to compile an
implementation module and could not find the definition module. The error
location would be set to the SYSTEM module. The bug occurred as the
module sym was created during the peep phase after which the few tokens are
destroyed and recreated during parsing. The bug fix is to call
PutDeclared when the module is encountered during parsing which updates
the tokenno associated with the module.
gcc/m2/ChangeLog:
PR modula2/114295
* gm2-compiler/M2Batch.mod (MakeProgramSource): Call PutDeclared
if the module is known.
(MakeDefinitionSource): Ditto.
(MakeImplementationSource): Ditto.
* gm2-compiler/M2Comp.mod (ExamineHeader): New procedure.
(ExamineCompilationUnit): Rewrite.
(PeepInto): Rewrite.
* gm2-compiler/M2Error.mod (NewError): Remove default call to
GetTokenNo.
* gm2-compiler/M2Quads.mod (callRequestDependant): Push tokno with
Adr.
(BuildStringAdrParam): Ditto.
(doBuildBinaryOp): Push OperatorPos on the bool stack.
(BuildRelOp): Ditto.
* gm2-compiler/P2Build.bnf (SetType): Pass set token pos to
BuildSetType.
(PointerType): Pass pointer token pos to BuildPointerType.
* gm2-compiler/P2SymBuild.def (BuildPointerType): Add parameter
pointerpos.
(BuildSetType): Add parameter setpos.
* gm2-compiler/P2SymBuild.mod (BuildPointerType): Add parameter
pointerpos. Build combined token and use it when creating a
pointer type.
(BuildSetType): Add parameter setpos. Build combined token and
use it when creating a set type.
* gm2-compiler/SymbolTable.mod (DebugUnknownToken): New constant.
(CheckTok): New procedure function.
(MakeProcedure): Call CheckTok.
(MakeRecord): Ditto.
(MakeVarient): Ditto.
(MakeEnumeration): Ditto.
(MakeHiddenType): Ditto.
(MakeConstant): Ditto.
(MakeConstStringCnul): Ditto.
(MakeSubrange): Ditto.
(MakeTemporary): Ditto.
(MakeVariableForParam): Ditto.
(MakeParameterHeapVar): Ditto.
(MakePointer): Ditto.
(MakeSet): Ditto.
(MakeUnbounded): Ditto.
(MakeProcType): Ditto.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Batch.mod | 12 ++++-
gcc/m2/gm2-compiler/M2Comp.mod | 88 +++++++++++++++++++++++++++----------
gcc/m2/gm2-compiler/M2Error.mod | 6 +--
gcc/m2/gm2-compiler/M2Quads.mod | 42 +++++++++---------
gcc/m2/gm2-compiler/P2Build.bnf | 13 +++---
gcc/m2/gm2-compiler/P2SymBuild.def | 4 +-
gcc/m2/gm2-compiler/P2SymBuild.mod | 45 ++++++++++---------
gcc/m2/gm2-compiler/SymbolTable.mod | 47 +++++++++++++++++++-
8 files changed, 179 insertions(+), 78 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Batch.mod b/gcc/m2/gm2-compiler/M2Batch.mod
index d6eb53ff90d..8cfc906513c 100644
--- a/gcc/m2/gm2-compiler/M2Batch.mod
+++ b/gcc/m2/gm2-compiler/M2Batch.mod
@@ -23,7 +23,11 @@ IMPLEMENTATION MODULE M2Batch ;
FROM M2Debug IMPORT Assert ;
-FROM SymbolTable IMPORT MakeModule, MakeDefImp, IsModule, IsDefImp, GetScope, GetLocalSym, GetCurrentScope, GetSym, NulSym ;
+
+FROM SymbolTable IMPORT MakeModule, MakeDefImp, IsModule, IsDefImp,
+ GetScope, GetLocalSym, GetCurrentScope,
+ PutDeclared, GetSym, NulSym ;
+
FROM NameKey IMPORT GetKey, WriteKey ;
FROM M2Printf IMPORT printf2 ;
FROM M2Error IMPORT InternalError ;
@@ -69,6 +73,8 @@ BEGIN
Sym := MakeModule (tok, n) ;
Put (Sym, n) ;
Push (Sym)
+ ELSE
+ PutDeclared (tok, Sym)
END ;
RETURN Sym
END MakeProgramSource ;
@@ -96,6 +102,8 @@ BEGIN
Sym := MakeDefImp (tok, n) ;
Put (Sym, n) ;
Push (Sym)
+ ELSE
+ PutDeclared (tok, Sym)
END ;
RETURN Sym
END MakeDefinitionSource ;
@@ -123,6 +131,8 @@ BEGIN
Sym := MakeDefImp (tok, n) ;
Put (Sym, n) ;
Push (Sym)
+ ELSE
+ PutDeclared (tok, Sym)
END ;
RETURN Sym
END MakeImplementationSource ;
diff --git a/gcc/m2/gm2-compiler/M2Comp.mod b/gcc/m2/gm2-compiler/M2Comp.mod
index c10c301cbde..719ae6641dc 100644
--- a/gcc/m2/gm2-compiler/M2Comp.mod
+++ b/gcc/m2/gm2-compiler/M2Comp.mod
@@ -30,7 +30,8 @@ FROM M2Search IMPORT FindSourceDefFile, FindSourceModFile ;
FROM M2Code IMPORT Code ;
FROM M2LexBuf IMPORT OpenSource, CloseSource, ResetForNewPass, currenttoken, GetToken,
- ReInitialize, currentstring, GetTokenNo ;
+ ReInitialize, currentstring, GetTokenNo, BuiltinTokenNo,
+ UnknownTokenNo ;
FROM M2FileName IMPORT CalculateFileName ;
FROM M2Preprocess IMPORT PreprocessModule, MakeSaveTempsFileNameExt, OnExitDelete ;
@@ -288,32 +289,74 @@ BEGIN
END compile ;
+(*
+ ExamineHeader - examines up until the ';', '[' or eof and determines if the source file
+ is a program, implementation/definition module.
+*)
+
+PROCEDURE ExamineHeader (VAR name: ADDRESS; VAR isdefimp, module: BOOLEAN) ;
+BEGIN
+ (* Stop if we see one of eof ';' '['. *)
+ WHILE (currenttoken#eoftok) AND
+ (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO
+ IF name = NIL
+ THEN
+ IF (currenttoken=implementationtok) OR (currenttoken=definitiontok)
+ THEN
+ isdefimp := TRUE ;
+ GetToken
+ END ;
+ IF currenttoken=moduletok
+ THEN
+ module := TRUE ;
+ GetToken ;
+ IF currenttoken=identtok
+ THEN
+ name := currentstring
+ END
+ END ;
+ END ;
+ GetToken
+ END ;
+END ExamineHeader ;
+
+
(*
ExamineCompilationUnit - opens the source file to obtain the module name and kind of module.
*)
-PROCEDURE ExamineCompilationUnit (VAR name: ADDRESS; VAR isdefimp: BOOLEAN) ;
+PROCEDURE ExamineCompilationUnit () : CARDINAL ;
VAR
- Message: String ;
+ Message : String ;
+ name : ADDRESS ;
+ module,
+ isdefimp: BOOLEAN ;
BEGIN
+ name := NIL ;
isdefimp := FALSE ; (* default to program module *)
- (* stop if we see eof, ';' or '[' *)
- WHILE (currenttoken#eoftok) AND (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO
- IF (currenttoken=implementationtok) OR (currenttoken=definitiontok)
+ module := FALSE ; (* Seen module keyword? *)
+ ExamineHeader (name, isdefimp, module) ;
+ IF name = NIL
+ THEN
+ IF module
THEN
- isdefimp := TRUE ;
- GetToken
+ Message := MetaString0 (InitString ('no {%kMODULE} keyword seen'))
+ ELSE
+ Message := MetaString0 (InitString ('no module ident seen'))
END ;
- IF currenttoken=identtok
+ m2flex.M2Error (string (Message)) ;
+ exit (1)
+ ELSE
+ (* The token used is will be overwritten when P0 is underway.
+ At this point we are determining the module kind and the tokens
+ read will be discarded (see ReInitialize below). *)
+ IF isdefimp
THEN
- name := currentstring ;
- RETURN
- END ;
- GetToken
- END ;
- Message := MetaString0 (InitString ('no {%kMODULE} name found')) ;
- m2flex.M2Error (string (Message)) ;
- exit (1)
+ RETURN MakeImplementationSource (BuiltinTokenNo, makekey (name))
+ ELSE
+ RETURN MakeProgramSource (BuiltinTokenNo, makekey (name))
+ END
+ END
END ExamineCompilationUnit ;
@@ -324,17 +367,14 @@ END ExamineCompilationUnit ;
PROCEDURE PeepInto (s: String) ;
VAR
- name : ADDRESS ;
- isdefimp: BOOLEAN ;
+ mainModule: CARDINAL ;
BEGIN
IF OpenSource (s)
THEN
- ExamineCompilationUnit (name, isdefimp) ;
- IF isdefimp
+ mainModule := ExamineCompilationUnit () ;
+ IF mainModule # NulSym
THEN
- SetMainModule (MakeImplementationSource (GetTokenNo (), makekey (name)))
- ELSE
- SetMainModule (MakeProgramSource (GetTokenNo (), makekey (name)))
+ SetMainModule (mainModule)
END ;
CloseSource ;
ReInitialize
diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod
index 37e08248eea..1d79c804a59 100644
--- a/gcc/m2/gm2-compiler/M2Error.mod
+++ b/gcc/m2/gm2-compiler/M2Error.mod
@@ -398,10 +398,8 @@ VAR
BEGIN
IF AtTokenNo = UnknownTokenNo
THEN
- (* this could be used as a useful debugging hook as the front end
- has forgotten the token no. This can occur if a complex record
- structure or array is used for example. *)
- AtTokenNo := GetTokenNo ()
+ (* This could be used as a useful debugging hook as the front end
+ has forgotten the token no. *)
END ;
NEW(e) ;
WITH e^ DO
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 2be229d0bf8..3231f9f5606 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -2384,12 +2384,12 @@ PROCEDURE callRequestDependant (tokno: CARDINAL;
BEGIN
Assert (requestDep # NulSym) ;
PushTtok (requestDep, tokno) ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tokno) ;
PushTtok (MakeConstString (tokno, GetSymName (moduleSym)), tokno) ;
PushT (1) ;
BuildAdrFunction ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tokno) ;
PushTtok (MakeConstString (tokno, GetLibName (moduleSym)), tokno) ;
PushT (1) ;
BuildAdrFunction ;
@@ -2399,12 +2399,12 @@ BEGIN
PushTF (Nil, Address) ;
PushTF (Nil, Address)
ELSE
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tokno) ;
PushTtok (MakeConstString (tokno, GetSymName (depModuleSym)), tokno) ;
PushT (1) ;
BuildAdrFunction ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tokno) ;
PushTtok (MakeConstString (tokno, GetLibName (depModuleSym)), tokno) ;
PushT (1) ;
BuildAdrFunction
@@ -2668,7 +2668,7 @@ PROCEDURE BuildStringAdrParam (tok: CARDINAL; name: Name);
VAR
str, m2strnul: CARDINAL ;
BEGIN
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
str := MakeConstString (tok, name) ;
PutConstStringKnown (tok, str, name, FALSE, TRUE) ;
m2strnul := DeferMakeConstStringM2nul (tok, str) ;
@@ -2772,12 +2772,12 @@ BEGIN
(* DeconstructModules (module_name, argc, argv, envp); *)
PushTtok (deconstructModules, tok) ;
- PushTF(Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
PushTtok (MakeConstString (tok, GetSymName (moduleSym)), tok) ;
PushT(1) ;
BuildAdrFunction ;
- PushTF(Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
PushTtok (MakeConstString (tok, GetLibName (moduleSym)), tok) ;
PushT(1) ;
BuildAdrFunction ;
@@ -2836,12 +2836,12 @@ BEGIN
(* RegisterModule (module_name, init, fini, dependencies); *)
PushTtok (RegisterModule, tok) ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
PushTtok (MakeConstString (tok, GetSymName (moduleSym)), tok) ;
PushT (1) ;
BuildAdrFunction ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
PushTtok (MakeConstString (tok, GetLibName (moduleSym)), tok) ;
PushT (1) ;
BuildAdrFunction ;
@@ -6422,7 +6422,7 @@ BEGIN
THEN
MarkAsReadWrite(rw) ;
(* pass the address field of an unbounded variable *)
- PushTF(Adr, Address) ;
+ PushTFtok (Adr, Address, OperandTok (pi)) ;
PushTFAD (f^.TrueExit, f^.FalseExit, f^.Unbounded, f^.Dimension) ;
PushT(1) ;
BuildAdrFunction ;
@@ -6452,7 +6452,7 @@ BEGIN
THEN
MarkAsReadWrite(rw) ;
(* pass the address field of an unbounded variable *)
- PushTF(Adr, Address) ;
+ PushTFtok (Adr, Address, OperandTok (pi)) ;
PushTFAD (f^.TrueExit, f^.FalseExit, f^.Unbounded, f^.Dimension) ;
PushT(1) ;
BuildAdrFunction ;
@@ -12574,19 +12574,21 @@ BEGIN
IF Operator = OrTok
THEN
CheckBooleanId ;
- PopBool (t1, f1) ;
+ PopBooltok (t1, f1, rightpos) ;
PopTtok (Operator, OperatorPos) ;
- PopBool (t2, f2) ;
+ PopBooltok (t2, f2, leftpos) ;
Assert (f2=0) ;
- PushBool (Merge (t1, t2), f1)
+ OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
+ PushBooltok (Merge (t1, t2), f1, OperatorPos)
ELSIF (Operator = AndTok) OR (Operator = AmbersandTok)
THEN
CheckBooleanId ;
- PopBool (t1, f1) ;
+ PopBooltok (t1, f1, rightpos) ;
PopTtok (Operator, OperatorPos) ;
- PopBool (t2, f2) ;
+ PopBooltok (t2, f2, leftpos) ;
Assert (t2=0) ;
- PushBool (t1, Merge (f1, f2))
+ OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
+ PushBooltok (t1, Merge (f1, f2), OperatorPos)
ELSE
PopTFrwtok (right, righttype, rightrw, rightpos) ;
PopTtok (Operator, OperatorPos) ;
@@ -12893,7 +12895,7 @@ BEGIN
GenQuadO (tokpos, Operator, Operand1, Operand2, 0, FALSE)
END ;
GenQuadO (tokpos, GotoOp, NulSym, NulSym, 0, FALSE) ;
- PushBool (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1))
+ PushBooltok (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1), tokpos)
ELSIF (OperandT (2) = HashTok) OR (OperandT (2) = LessGreaterTok)
THEN
(* are the two boolean expressions the different? *)
@@ -12909,7 +12911,7 @@ BEGIN
GenQuadO (tokpos, Operator, Operand1, Operand2, 0, FALSE)
END ;
GenQuadO (tokpos, GotoOp, NulSym, NulSym, 0, FALSE) ;
- PushBool (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1))
+ PushBooltok (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1), tokpos)
ELSE
MetaError0 ('only allowed to use the relation operators {%Ek=} {%Ek#} rather than {%Ek<} or {%Ek>} on {%EkBOOLEAN} expressions as these do not imply an ordinal value for {%kTRUE} or {%kFALSE}')
END
@@ -13061,7 +13063,7 @@ BEGIN
GenQuadOtok (combinedTok, MakeOp (Op), left, right, 0, FALSE,
leftpos, rightpos, UnknownTokenNo) ; (* True Exit *)
GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ; (* False Exit *)
- PushBool (NextQuad-2, NextQuad-1)
+ PushBooltok (NextQuad-2, NextQuad-1, combinedTok)
END
END BuildRelOp ;
diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf
index b22f052c92b..d69ce2cf17e 100644
--- a/gcc/m2/gm2-compiler/P2Build.bnf
+++ b/gcc/m2/gm2-compiler/P2Build.bnf
@@ -104,7 +104,6 @@ FROM P2SymBuild IMPORT P2StartBuildProgramModule,
BuildVarientSelector,
StartBuildVarientFieldRecord,
EndBuildVarientFieldRecord,
- BuildNulName,
StartBuildArray,
EndBuildArray,
BuildFieldArray, BuildArrayComma,
@@ -861,17 +860,21 @@ CaseLabelList := CaseLabels { "," CaseLabels } =:
CaseLabels := ConstExpression [ ".." ConstExpression ] =:
-SetType := % VAR ispacked: BOOLEAN ; %
+SetType := % VAR ispacked: BOOLEAN ;
+ setpos : CARDINAL ; %
+ % setpos := GetTokenNo () %
% ispacked := FALSE %
( "SET" % ispacked := FALSE %
| "PACKEDSET" % ispacked := TRUE %
) "OF" % BuildNulName %
- SimpleType % BuildSetType (ispacked) %
+ SimpleType % BuildSetType (setpos, ispacked) %
=:
-PointerType := "POINTER" "TO" % BuildNulName %
- Type % BuildPointerType %
+PointerType := % VAR pointerpos: CARDINAL ; %
+ % pointerpos := GetTokenNo () %
+ "POINTER" "TO" % BuildNulName %
+ Type % BuildPointerType (pointerpos) %
=:
ProcedureType := "PROCEDURE" % BuildProcedureType ; %
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.def b/gcc/m2/gm2-compiler/P2SymBuild.def
index 4f6ad96d844..89a83144011 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.def
+++ b/gcc/m2/gm2-compiler/P2SymBuild.def
@@ -887,7 +887,7 @@ PROCEDURE BuildNoReturnAttribute (procedureSym: CARDINAL) ;
|------------| |-------------|
*)
-PROCEDURE BuildPointerType ;
+PROCEDURE BuildPointerType (pointerpos: CARDINAL) ;
(*
@@ -906,7 +906,7 @@ PROCEDURE BuildPointerType ;
|------------| |-------------|
*)
-PROCEDURE BuildSetType (ispacked: BOOLEAN) ;
+PROCEDURE BuildSetType (setpos: CARDINAL; ispacked: BOOLEAN) ;
(*
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 17a6e1b71ca..0b90b762e2e 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -26,7 +26,7 @@ FROM libc IMPORT strlen ;
FROM NameKey IMPORT Name, MakeKey, makekey, KeyToCharStar, NulName, LengthKey, WriteKey ;
FROM StrLib IMPORT StrEqual ;
FROM M2Debug IMPORT Assert, WriteDebug ;
-FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo ;
+FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo, MakeVirtual2Tok ;
FROM M2Error IMPORT InternalError, WriteFormat1, WriteFormat2, WriteFormat0, ErrorStringAt, ErrorStringAt2 ;
FROM M2MetaError IMPORT MetaError1, MetaError2, MetaErrorsT2, MetaErrors1, MetaErrors2, MetaErrorString1 ;
FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, Mark, Slice, ConCat, KillString, string ;
@@ -2130,25 +2130,27 @@ END BuildNoReturnAttribute ;
|------------| |-------------|
*)
-PROCEDURE BuildPointerType ;
+PROCEDURE BuildPointerType (pointerpos: CARDINAL) ;
VAR
- tok : CARDINAL ;
+ combined,
+ namepos,
+ typepos : CARDINAL ;
name : Name ;
Type,
PtrToType: CARDINAL ;
BEGIN
- PopTtok(Type, tok) ;
- PopT(name) ;
- name := CheckAnonymous(name) ;
+ PopTtok (Type, typepos) ;
+ PopTtok (name, namepos) ;
+ name := CheckAnonymous (name) ;
- PtrToType := MakePointer(tok, name) ;
- PutPointer(PtrToType, Type) ;
+ combined := MakeVirtual2Tok (pointerpos, typepos) ;
+ PtrToType := MakePointer (combined, name) ;
+ PutPointer (PtrToType, Type) ;
CheckForExportedImplementation(PtrToType) ; (* May be an exported hidden type *)
- PushTtok(name, tok) ;
+ PushTtok (name, namepos) ;
Annotate("%1n|%3d||pointer type name") ;
- PushTtok(PtrToType, tok) ;
+ PushTtok(PtrToType, combined) ;
Annotate("%1s(%1d)|%3d||pointer type")
-
END BuildPointerType ;
@@ -2168,21 +2170,24 @@ END BuildPointerType ;
|------------| |-------------|
*)
-PROCEDURE BuildSetType (ispacked: BOOLEAN) ;
+PROCEDURE BuildSetType (setpos: CARDINAL; ispacked: BOOLEAN) ;
VAR
- tok : CARDINAL ;
- name : Name ;
+ combined,
+ namepos,
+ typepos : CARDINAL ;
+ name : Name ;
Type,
- SetType: CARDINAL ;
+ SetType : CARDINAL ;
BEGIN
- PopTtok(Type, tok) ;
- PopT(name) ;
- SetType := MakeSet (tok, name) ;
+ PopTtok (Type, typepos) ;
+ PopTtok (name, namepos) ;
+ combined := MakeVirtual2Tok (setpos, typepos) ;
+ SetType := MakeSet (combined, name) ;
CheckForExportedImplementation(SetType) ; (* May be an exported hidden type *)
PutSet(SetType, Type, ispacked) ;
- PushT(name) ;
+ PushTtok (name, namepos) ;
Annotate("%1n||set type name") ;
- PushTtok (SetType, tok) ;
+ PushTtok (SetType, combined) ;
Annotate ("%1s(%1d)|%3d||set type|token no")
END BuildSetType ;
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index b49cc889dca..c08de6a97c3 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -99,7 +99,10 @@ IMPORT Indexing ;
CONST
- DebugUnknowns = FALSE ;
+ DebugUnknowns = FALSE ; (* Debug unknown symbols. *)
+ DebugUnknownToken = FALSE ; (* If enabled it will generate a warning every
+ time a symbol is created with an unknown
+ location. *)
(*
The Unbounded is a pseudo type used within the compiler
@@ -3265,6 +3268,29 @@ BEGIN
END GetModuleCtors ;
+(*
+ CheckTok - checks to see that tok is at a known location. If not
+ it uses GetTokenNo as a fall back.
+*)
+
+PROCEDURE CheckTok (tok: CARDINAL; name: ARRAY OF CHAR) : CARDINAL ;
+VAR
+ s: String ;
+BEGIN
+ IF tok = UnknownTokenNo
+ THEN
+ tok := GetTokenNo () ;
+ IF DebugUnknownToken
+ THEN
+ s := InitString (name) ;
+ s := ConCat (s, InitString (' symbol {%W} has been created with an unknown token location')) ;
+ MetaErrorStringT0 (GetTokenNo (), s)
+ END
+ END ;
+ RETURN tok
+END CheckTok ;
+
+
(*
MakeModule - creates a module sym with ModuleName. It returns the
symbol index.
@@ -3276,6 +3302,7 @@ VAR
pCall: PtrToCallFrame ;
Sym : CARDINAL ;
BEGIN
+ (* tok := CheckTok (tok, 'module') ; *)
(*
Make a new symbol since we are at the outer scope level.
DeclareSym examines the current scope level for any symbols
@@ -3645,7 +3672,7 @@ BEGIN
(* We cannot use DeclareSym as it examines the current scope *)
(* for any symbols which have the correct name, but are yet *)
(* undefined. *)
-
+ (* tok := CheckTok (tok, 'defimp') ; *)
NewSym(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
@@ -3893,6 +3920,7 @@ VAR
pSym: PtrToSymbol ;
Sym : CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'procedure') ;
Sym := DeclareSym(tok, ProcedureName) ;
IF NOT IsError(Sym)
THEN
@@ -4466,6 +4494,7 @@ PROCEDURE MakeRecord (tok: CARDINAL; RecordName: Name) : CARDINAL ;
VAR
oaf, sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'record') ;
sym := HandleHiddenOrDeclare (tok, RecordName, oaf) ;
FillInRecordFields (tok, sym, RecordName, GetCurrentScope (), oaf) ;
ForeachOAFamily (oaf, doFillInOAFamily) ;
@@ -4483,6 +4512,7 @@ VAR
pSym: PtrToSymbol ;
Sym : CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'varient') ;
NewSym (Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
@@ -4632,6 +4662,7 @@ VAR
pSym : PtrToSymbol ;
sym, oaf: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'enumeration') ;
sym := CheckForHiddenType (EnumerationName) ;
IF sym=NulSym
THEN
@@ -4723,6 +4754,7 @@ VAR
pSym: PtrToSymbol ;
Sym : CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'hidden') ;
Sym := DeclareSym (tok, TypeName) ;
IF NOT IsError(Sym)
THEN
@@ -4835,6 +4867,7 @@ VAR
str: String ;
sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'constant') ;
str := Sprintf1 (Mark (InitString ("%d")), value) ;
sym := MakeConstLit (tok, makekey (string (str)), Cardinal) ;
str := KillString (str) ;
@@ -4970,6 +5003,7 @@ PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : C
VAR
sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'constlit') ;
sym := LookupConstLitPoolEntry (tok, constName, constType) ;
IF sym = NulSym
THEN
@@ -5100,6 +5134,7 @@ PROCEDURE MakeConstStringCnul (tok: CARDINAL; name: Name; known: BOOLEAN) : CARD
VAR
newstr: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'conststringcnul') ;
NewSym (newstr) ;
InitConstString (tok, newstr, name, name, cnulstr, TRUE, known) ;
RETURN newstr
@@ -5970,6 +6005,7 @@ VAR
pSym : PtrToSymbol ;
sym, oaf: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'subrange') ;
sym := HandleHiddenOrDeclare (tok, SubrangeName, oaf) ;
IF NOT IsError(sym)
THEN
@@ -7739,6 +7775,7 @@ END IsComponent ;
PROCEDURE MakeTemporary (tok: CARDINAL; Mode: ModeOfAddr) : CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'temporary') ;
RETURN buildTemporary (tok, Mode, FALSE, NulSym)
END MakeTemporary ;
@@ -10122,6 +10159,7 @@ VAR
pSym : PtrToSymbol ;
VariableSym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'parameter') ;
VariableSym := MakeVar (tok, ParamName) ;
pSym := GetPsym (VariableSym) ;
WITH pSym^ DO
@@ -10604,6 +10642,7 @@ PROCEDURE MakeParameterHeapVar (tok: CARDINAL; type: CARDINAL; mode: ModeOfAddr)
VAR
heapvar: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'parameter heap var') ;
heapvar := NulSym ;
type := SkipType (type) ;
IF IsPointer (type)
@@ -11079,6 +11118,7 @@ PROCEDURE MakePointer (tok: CARDINAL; PointerName: Name) : CARDINAL ;
VAR
oaf, sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'pointer') ;
sym := HandleHiddenOrDeclare(tok, PointerName, oaf) ;
FillInPointerFields(sym, PointerName, GetCurrentScope(), oaf) ;
ForeachOAFamily(oaf, doFillInOAFamily) ;
@@ -11341,6 +11381,7 @@ VAR
pSym : PtrToSymbol ;
oaf, sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'set') ;
sym := HandleHiddenOrDeclare(tok, SetName, oaf) ;
IF NOT IsError(sym)
THEN
@@ -11680,6 +11721,7 @@ PROCEDURE MakeUnbounded (tok: CARDINAL;
VAR
sym, oaf: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'unbounded') ;
oaf := MakeOAFamily(SimpleType) ;
sym := GetUnbounded(oaf, ndim) ;
IF sym=NulSym
@@ -12513,6 +12555,7 @@ VAR
pSym : PtrToSymbol ;
oaf, sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'proctype') ;
sym := HandleHiddenOrDeclare (tok, ProcTypeName, oaf) ;
IF NOT IsError(sym)
THEN
More information about the Gcc-cvs
mailing list