public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Token accuracy fixes for module symbol creation.
@ 2022-11-30 21:47 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-11-30 21:47 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:bdec440d71872b863cc04440cfe9c01269a376a5
commit bdec440d71872b863cc04440cfe9c01269a376a5
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Wed Nov 30 21:45:33 2022 +0000
Token accuracy fixes for module symbol creation.
This patch improves the accuracy of tokens when module symbols
are created. Improve token position accuracy within WITH and
RETRY statements.
gcc/m2/ChangeLog:
* gm2-compiler/M2CaseList.mod (MissingCaseBounds):
Change format string to use keyword specifiers and
MetaErrorT1.
* gm2-compiler/M2Comp.mod (DoPass0): Use MetaError 'A'
format specifier to signify unrecoverable errors.
* gm2-compiler/M2MetaError.mod: Import FlushWarnings.
(checkAbort) Call FlushWarnings.
* gm2-compiler/M2Quads.def (BuildRetry): Add tok parameter.
* gm2-compiler/M2Quads.mod (BuildDesignatorRecord): Remove
parameters if an error is detected. (BuildDesignatorError)
New procedure. (BuildDesignatorArray) tidied up error
reporting.
* gm2-compiler/P0SymBuild.mod: Introduced tok recording
of module idents. (RegisterImports) Rewritten.
(RegisterImport) Rewritten.
* gm2-compiler/SymbolTable.mod: Added spacing.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2CaseList.mod | 2 +-
gcc/m2/gm2-compiler/M2Comp.mod | 19 ++++----
gcc/m2/gm2-compiler/M2MetaError.mod | 3 +-
gcc/m2/gm2-compiler/M2Quads.def | 2 +-
gcc/m2/gm2-compiler/M2Quads.mod | 85 +++++++++++++++++++++++++----------
gcc/m2/gm2-compiler/P0SymBuild.mod | 76 +++++++++++++++++++++----------
gcc/m2/gm2-compiler/P0SyntaxCheck.bnf | 4 +-
gcc/m2/gm2-compiler/P3Build.bnf | 3 +-
gcc/m2/gm2-compiler/SymbolTable.mod | 2 +-
9 files changed, 130 insertions(+), 66 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2CaseList.mod b/gcc/m2/gm2-compiler/M2CaseList.mod
index ba1d7843818..060d16c3cd3 100644
--- a/gcc/m2/gm2-compiler/M2CaseList.mod
+++ b/gcc/m2/gm2-compiler/M2CaseList.mod
@@ -770,7 +770,7 @@ BEGIN
THEN
missing := TRUE ;
MetaErrorT2 (tokenno,
- 'not all variant record alternatives in the CASE clause are specified, hint you either need to specify each value of {%2ad} or use an ELSE clause {%1U}',
+ 'not all variant record alternatives in the {%kCASE} clause are specified, hint you either need to specify each value of {%2ad} or use an {%kELSE} clause',
varient, type) ;
ErrorRanges(p, type, set)
END ;
diff --git a/gcc/m2/gm2-compiler/M2Comp.mod b/gcc/m2/gm2-compiler/M2Comp.mod
index c3fc02dc541..d9840f96305 100644
--- a/gcc/m2/gm2-compiler/M2Comp.mod
+++ b/gcc/m2/gm2-compiler/M2Comp.mod
@@ -263,16 +263,13 @@ BEGIN
qprintf0 ('\n') ;
CloseSource
ELSE
- MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUF%s} containing module {%%1a} cannot be found'), FileName), Sym) ;
- FlushWarnings ; FlushErrors ;
- fprintf1(StdErr, 'failed to open %s\n', FileName) ;
- exit(1)
+ (* Unrecoverable error. *)
+ MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUAF%s} containing module {%%1a} cannot be found'),
+ FileName), Sym)
END
ELSE
- MetaError1 ('the file containing the definition module {%1EUa} cannot be found', Sym) ;
- FlushWarnings ; FlushErrors ;
- fprintf1(StdErr, 'failed to find definition module %s.def\n', SymName) ;
- exit(1)
+ (* Unrecoverable error. *)
+ MetaError1 ('the file containing the definition module {%1EMAa} cannot be found', Sym)
END ;
ModuleType := Implementation
ELSE
@@ -313,9 +310,9 @@ BEGIN
is used. *)
IF (NOT WholeProgram) OR (Sym=Main) OR IsHiddenTypeDeclared(Sym)
THEN
- MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUF%s} containing module {%%1a} cannot be found'), FileName), Sym) ;
- FlushWarnings ; FlushErrors ;
- fprintf1(StdErr, 'file %s cannot be opened\n', FileName)
+ (* Unrecoverable error. *)
+ MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUAF%s} containing module {%%1a} cannot be found'),
+ FileName), Sym) ;
END
END
END
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 11e943e0ef0..1e292f68dab 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -26,7 +26,7 @@ FROM M2Base IMPORT ZType, RType ;
FROM NameKey IMPORT Name, KeyToCharStar, NulName ;
FROM StrLib IMPORT StrLen ;
FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ;
-FROM M2Error IMPORT Error, NewError, NewWarning, NewNote, ErrorString, InternalError, ChainError, SetColor, FlushErrors ;
+FROM M2Error IMPORT Error, NewError, NewWarning, NewNote, ErrorString, InternalError, ChainError, SetColor, FlushErrors, FlushWarnings ;
FROM FIO IMPORT StdOut, WriteLine ;
FROM SFIO IMPORT WriteS ;
FROM StringConvert IMPORT ctos ;
@@ -2275,6 +2275,7 @@ PROCEDURE checkAbort ;
BEGIN
IF seenAbort
THEN
+ FlushWarnings ;
FlushErrors
END
END checkAbort ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index 829cee5b21d..f1438c36bd8 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -667,7 +667,7 @@ PROCEDURE BuildExceptProcedure ;
BuildRetry - adds an RetryOp quadruple.
*)
-PROCEDURE BuildRetry ;
+PROCEDURE BuildRetry (tok: CARDINAL) ;
(*
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 12e9be55d7e..c3087fa96ce 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -114,6 +114,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
PushSize, PushValue, PopValue,
GetVariableAtAddress, IsVariableAtAddress,
MakeError, UnknownReported,
+ IsError,
IsInnerModule,
IsImportStatement, IsImport, GetImportModule, GetImportDeclared,
GetImportStatementList,
@@ -3386,7 +3387,11 @@ BEGIN
MetaErrorT2 (combinedtok,
'cannot assign a constant designator {%1Ead} with an expression {%2Ead}',
des, exp)
- END
+ END ;
+ PopN (2) (* Remove both parameters. *)
+ ELSIF IsError (des)
+ THEN
+ PopN (2) (* Remove both parameters. *)
ELSE
doBuildAssignment (becomesTokNo, TRUE, TRUE)
END
@@ -10992,6 +10997,30 @@ BEGIN
END BuildDesignatorRecord ;
+(*
+ BuildDesignatorError - removes the designator from the stack and replaces
+ it with an error symbol.
+*)
+
+PROCEDURE BuildDesignatorError (message: ARRAY OF CHAR) ;
+VAR
+ combinedTok,
+ arrayTok,
+ exprTok : CARDINAL ;
+ s : String ;
+ e, d, error,
+ Sym,
+ Type : CARDINAL ;
+BEGIN
+ PopTtok (e, exprTok) ;
+ PopTFDtok (Sym, Type, d, arrayTok) ;
+ combinedTok := MakeVirtualTok (arrayTok, arrayTok, exprTok) ;
+ error := MakeError (combinedTok, MakeKey (message)) ;
+ PushTFDtok (error, Type, d, arrayTok)
+END BuildDesignatorError ;
+
+
+
(*
BuildDesignatorArray - Builds the array referencing.
The purpose of this procedure is to work out
@@ -11044,32 +11073,35 @@ BEGIN
PushTtok (e, exprTok)
END
END ;
- IF (NOT IsVar(OperandT(2))) AND (NOT IsTemporary(OperandT(2)))
+ IF (NOT IsVar (OperandT (2))) AND (NOT IsTemporary (OperandT (2)))
THEN
- ErrorStringAt2(Mark(InitString('can only access arrays using variables or formal parameters')),
- GetDeclaredMod(OperandT(2)), GetTokenNo())
+ MetaErrorT1 (OperandTtok (2),
+ 'can only access arrays using variables or formal parameters not {%1Ead}',
+ OperandT (2)) ;
+ BuildDesignatorError ('bad array access')
END ;
- Sym := GetDType(OperandT(2)) ;
- IF Sym=NulSym
+ Sym := OperandT (2) ;
+ Type := GetDType (Sym) ;
+ arrayTok := OperandTtok (2) ;
+ IF Type = NulSym
THEN
- IF GetSymName(Sym)=NulName
+ IF (arrayTok = UnknownTokenNo) OR (arrayTok = BuiltinTokenNo)
THEN
- ErrorStringAt(Mark(InitString('type of array is undefined (no such array declared)')), GetTokenNo())
- ELSE
- s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Sym)))) ;
- ErrorStringAt(Sprintf1(Mark(InitString('type of array is undefined (%s)')),
- s),
- GetTokenNo())
- END
- END ;
- IF IsUnbounded(Sym)
+ arrayTok := GetTokenNo ()
+ END ;
+ MetaErrorT0 (arrayTok, "type of array is undefined") ;
+ BuildDesignatorError ('bad array access')
+ ELSIF IsUnbounded (Type)
THEN
BuildDynamicArray
- ELSIF IsArray(Sym)
+ ELSIF IsArray (Type)
THEN
BuildStaticArray
ELSE
- MetaError0 ('{%E}can only index static or dynamic arrays')
+ MetaErrorT1 (arrayTok,
+ 'can only index static or dynamic arrays, {%1Ead} is not an array but a {%tad}',
+ Sym) ;
+ BuildDesignatorError ('bad array access')
END
END BuildDesignatorArray ;
@@ -11450,17 +11482,22 @@ BEGIN
THEN
n := NoOfItemsInStackAddress(WithStack) ;
i := 1 ; (* top of the stack *)
- WHILE i<=n DO
+ WHILE i <= n DO
(* Search for other declarations of the with using Type *)
f := PeepAddress(WithStack, i) ;
IF f^.RecordSym=Type
THEN
- WriteFormat0('cannot have nested WITH statements referencing the same RECORD')
+ MetaErrorT1 (Tok,
+ 'cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}',
+ Sym) ;
+ MetaErrorT1 (f^.RecordTokPos,
+ 'cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}',
+ f^.RecordSym)
END ;
- INC(i)
+ INC (i)
END
END ;
- NEW(f) ;
+ NEW (f) ;
WITH f^ DO
RecordSym := Sym ;
RecordType := Type ;
@@ -11476,8 +11513,8 @@ PROCEDURE PopWith ;
VAR
f: WithFrame ;
BEGIN
- f := PopAddress(WithStack) ;
- DISPOSE(f)
+ f := PopAddress (WithStack) ;
+ DISPOSE (f)
END PopWith ;
diff --git a/gcc/m2/gm2-compiler/P0SymBuild.mod b/gcc/m2/gm2-compiler/P0SymBuild.mod
index e3025ebc564..7c3ff661365 100644
--- a/gcc/m2/gm2-compiler/P0SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P0SymBuild.mod
@@ -24,10 +24,11 @@ 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 ;
+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 ;
@@ -47,8 +48,8 @@ TYPE
sym : CARDINAL ;
level : CARDINAL ;
token : CARDINAL ; (* where the block starts. *)
- LocalModules, (* locally declared modules at the current level *)
- ImportedModules: List ; (* current list of imports for the scanned module *)
+ 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 *)
@@ -56,6 +57,11 @@ TYPE
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 ;
@@ -210,8 +216,8 @@ BEGIN
name := n ;
kind := k ;
sym := s ;
- InitList(LocalModules) ;
- InitList(ImportedModules) ;
+ InitList (LocalModules) ;
+ ImportedModules := InitIndex (1) ;
toPC := NIL ;
toReturn := NIL ;
toNext := NIL ;
@@ -235,8 +241,8 @@ BEGIN
name := NulName ;
kind := universe ;
sym := NulSym ;
- InitList(LocalModules) ;
- InitList(ImportedModules) ;
+ InitList (LocalModules) ;
+ ImportedModules := InitIndex (1) ;
toNext := NIL ;
toDown := NIL ;
toUp := curBP ;
@@ -254,13 +260,14 @@ PROCEDURE FlushImports (b: BlockInfoPtr) ;
VAR
i, n : CARDINAL ;
modname: Name ;
+ desc : ModuleDesc ;
BEGIN
WITH b^ DO
- i := 1 ;
- n := NoOfItemsInList (ImportedModules) ;
- WHILE i<=n DO
- modname := GetItemFromList (ImportedModules, i) ;
- sym := MakeDefinitionSource (GetTokenNo (), modname) ;
+ 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
@@ -289,12 +296,27 @@ END EndBlock ;
RegisterLocalModule - register, n, as a local module.
*)
-PROCEDURE RegisterLocalModule (n: Name) ;
+PROCEDURE RegisterLocalModule (name: Name) ;
+VAR
+ i, n: CARDINAL ;
+ desc: ModuleDesc ;
BEGIN
(* printf1('seen local module %a\n', n) ; *)
WITH curBP^ DO
- IncludeItemIntoList(LocalModules, n) ;
- RemoveItemFromList(ImportedModules, n)
+ IncludeItemIntoList (LocalModules, n) ;
+ i := LowIndice (ImportedModules) ;
+ n := HighIndice (ImportedModules) ;
+ WHILE i <= n DO
+ desc := GetIndice (ImportedModules, i) ;
+ IF desc^.name = name
+ THEN
+ RemoveIndiceFromIndex (ImportedModules, desc) ;
+ DISPOSE (desc) ;
+ RETURN (* All done. *)
+ ELSE
+ INC (i)
+ END
+ END
END
END RegisterLocalModule ;
@@ -303,18 +325,22 @@ END RegisterLocalModule ;
RegisterImport - register, n, as a module imported from either a local scope or definition module.
*)
-PROCEDURE RegisterImport (n: Name) ;
+PROCEDURE RegisterImport (n: Name; tok: CARDINAL) ;
VAR
- bp: BlockInfoPtr ;
+ 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, n)
+ IF NOT IsItemInList (LocalModules, n)
THEN
- IncludeItemIntoList(ImportedModules, n)
+ NEW (desc) ;
+ desc^.name := n ;
+ desc^.tok := tok ;
+ IncludeIndiceIntoIndex (ImportedModules, desc)
END
END
END RegisterImport ;
@@ -326,7 +352,8 @@ END RegisterImport ;
PROCEDURE RegisterImports ;
VAR
- i, n: CARDINAL ;
+ index,
+ i, n : CARDINAL ;
BEGIN
PopT(n) ; (* n = # of the Ident List *)
IF OperandT(n+1)=ImportTok
@@ -334,12 +361,13 @@ BEGIN
(* Ident list contains Module Names *)
i := 1 ;
WHILE i<=n DO
- RegisterImport(OperandT(n+1-i)) ;
+ index := n+1-i ;
+ RegisterImport (OperandT (index), OperandTok (index)) ;
INC(i)
END
ELSE
(* Ident List contains list of objects *)
- RegisterImport(OperandT(n+1))
+ RegisterImport (OperandT (n+1), OperandTok (n+1))
END ;
PopN(n+1) (* clear stack *)
END RegisterImports ;
@@ -366,9 +394,9 @@ BEGIN
*)
ELSE
(* Ident List contains list of objects, but we are importing directly from a module OperandT(n+1) *)
- RegisterImport(OperandT(n+1))
+ RegisterImport (OperandT (n+1), OperandTok (n+1))
END ;
- PopN(n+1) (* clear stack *)
+ PopN (n+1) (* clear stack *)
END RegisterInnerImports ;
diff --git a/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf b/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
index 2e599bdf154..7e948afd171 100644
--- a/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
+++ b/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
@@ -48,7 +48,7 @@ FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
InsertTokenAndRewind, GetTokenNo, DisplayToken, DumpTokens ;
FROM M2MetaError IMPORT MetaErrorStringT0 ;
-FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack, PushTFtok ;
+FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack, PushTFtok, PushTtok ;
FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
FROM P2SymBuild IMPORT BuildString, BuildNumber ;
FROM NameKey IMPORT Name, NulName, makekey ;
@@ -884,7 +884,7 @@ Export := "EXPORT" ( "QUALIFIED" IdentList |
) ";" =:
Import := "FROM" Ident "IMPORT" IdentList ";" |
- "IMPORT" % PushT(ImportTok)
+ "IMPORT" % PushTtok (ImportTok, GetTokenNo () -1)
(* determines whether Ident or Module *) %
IdentList ";" =:
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 16e4590a257..8a8861e11d4 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -1136,7 +1136,7 @@ Statement := % BuildStmtNote
] % PopAuto ; %
=:
-RetryStatement := "RETRY" % BuildRetry %
+RetryStatement := "RETRY" % BuildRetry (GetTokenNo () -1) %
=:
AssignmentOrProcedureCall := % VAR isFunc: BOOLEAN ;
@@ -1262,6 +1262,7 @@ WithStatement := % VAR
tok: CARDINAL ; %
"WITH" % tok := GetTokenNo () -1 %
Designator % StartBuildWith (tok) %
+ % BuildStmtNote (0) %
"DO"
StatementSequence
% BuildStmtNote (0) %
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index a2fd8691940..3a2b44ed990 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -1450,7 +1450,7 @@ VAR
Sym : CARDINAL ;
BEGIN
(* if Sym is present on the unknown tree then remove it *)
- Sym := FetchUnknownSym(name) ;
+ Sym := FetchUnknownSym (name) ;
IF Sym=NulSym
THEN
NewSym(Sym)
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-11-30 21:47 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-11-30 21:47 [gcc/devel/modula-2] Token accuracy fixes for module symbol creation Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).