public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Bugfixes for default scope, tidying up of code and neater error messages.
@ 2021-12-25 11:36 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2021-12-25 11:36 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:966f05c85e437c04c9138c10a3c957888c21ee48
commit 966f05c85e437c04c9138c10a3c957888c21ee48
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date: Sat Dec 25 11:22:00 2021 +0000
Bugfixes for default scope, tidying up of code and neater error messages.
gcc/m2/ChangeLog:
* m2/Make-lang.in (m2/gm2-compiler-boot/M2Error.o): New rule
to build M2Error.o using the --entended-opaque option since
M2Error.mod aggressively uses opaque data types.
* bnf/m2-1.bnf (DefProcedureHeading) ensure DefaultProcedure
scope is created before any further tokens are consumed.
Call LeaveErrorScope at the end of the rule.
* bnf/m2-2.bnf (DefProcedureHeading): Call LeaveErrorScope
at the end of the rule.
* bnf/m2-3.bnf (DefProcedureHeading): Call LeaveErrorScope
at the end of the rule.
* bnf/m2-c.bnf (DefProcedureHeading): Call LeaveErrorScope
at the end of the rule.
* bnf/m2-h.bnf (DefProcedureHeading): Call DefaultProcedure
and the beginning and LeaveErrorScope at the end of the rule.
* bnf/m2.bnf (DefProcedureHeading): Call DefaultProcedure
and the beginning of the rule.
* gm2-compiler/M2Comp.mod (M2Error): Import list replaced
identifiers ParsingComplete; and ResetErrorScope;.
* gm2-compiler/M2Error.def (NameKey): Renamed ParsingComplete to
ResetErrorScope. Call ResetErrorScope before each pass commenses.
Import list replaced identifiers LeaveScope,
ParsingComplete by EnterErrorScope, ErrorScope,
GetCurrentErrorScope,
(LeaveErrorScope): New procedure. (ResetErrorScope): New
procedure. (LeaveScope) Removed.
* gm2-compiler/M2Error.mod (M2Options): Import StackOfAddress.
(printf2) Imported. (printf3) Imported.
(IsErrorScopeNul): New procedure function.
(GetAnnounceScope): Re-implementation.
(IsSameScope): New procedure function.
(AnnounceScope): Detect no scope.
(newErrorScope): Use scopeArray to push a new scope.
(DefaultProgramModule): New implementation.
(DefaultImplementationModule): New implementation.
(DefaultDefinitionModule): New implementation.
(DefaultInnerModule): New implementation.
(GetCurrentErrorScope): New procedure function.
* gm2-compiler/M2MetaError.def: Extend the specifiers to
allow error contents to be pushed to a string stack;
string stack contents to be popped onto the output string;
replace dictionary string by the current output string and
remove all contents in the dictionary.
* gm2-compiler/M2MetaError.mod (addEntry) New procedure.
(killEntry) New procedure function.
(lookupDefine) New procedure function.
(lookupString) New procedure function.
(newEntry) New procedure function.
(popOutput) New procedure function.
(processDefine) New procedure.
(pushOutput) New procedure function.
(readWord) New procedure function.
(resetDictionary) New procedure.
(doErrorScopeMod) Enter error scope before
generate an error.
(doErrorScopeDef) Enter error scope before
generate an error.
(op): Handle 'Q', 'X', 'Y', 'Z' format directives.
* gm2-compiler/M2Scope.mod (SymbolTable): Import list includes
identifier GetErrorScope.
(enter): Re-implemented.
* gm2-compiler/M2StackWord.mod: Renamed data types so
they are easier to debug during bootstrap (avoid name clashes
with the M2StackAddress module).
* gm2-compiler/P0SymBuild.mod (EndProcedure): Call
LeaseErrorScope instead of LeaveScope at the end of the procedure.
* gm2-compiler/P2SymBuild.mod (P2EndBuildDefModule): Call
LeaseErrorScope instead of LeaveScope at the end of the procedure.
(P2EndBuildImplementationModule): Call
LeaseErrorScope instead of LeaveScope at the end of the procedure.
(P2EndBuildProgramModule): Call
LeaseErrorScope instead of LeaveScope at the end of the procedure.
(EndBuildInnerModule): Call
LeaseErrorScope instead of LeaveScope at the end of the procedure.
(P3EndBuildImpModule): Call
LeaseErrorScope instead of LeaveScope at the end of the procedure.
(P3EndBuildProgModule): Call
LeaseErrorScope instead of LeaveScope at the end of the procedure.
(EndBuildInnerModule): Call
LeaseErrorScope instead of LeaveScope at the end of the procedure.
* gm2-compiler/PCSymBuild.mod (PCEndBuildDefModule): Call
LeaseErrorScope instead of
LeaveScope at the end of the procedure.
(PCEndBuildImpModule): Call LeaseErrorScope instead of
LeaveScope at the end of the procedure.
(PCEndBuildProgModule): Call LeaseErrorScope instead of
LeaveScope at the end of the procedure.
(PCEndBuildInnerModule): Call LeaseErrorScope instead of
LeaveScope at the end of the procedure.
* gm2-compiler/SymbolKey.def (NoOfNodes): New procedure
function.
(ForeachNodeConditionDo) New procedure.
* gm2-compiler/SymbolKey.mod (NoOfNodes): New procedure
function.
(ContainsSymKey): Call FindNodeParentInTree instead of
FindNodeAndParentInTree.
(GetSymKey): Call FindNodeParentInTree instead of
FindNodeAndParentInTree.
(DelSymKey): Call FindNodeParentInTree instead of
FindNodeAndParentInTree.
(FindNodeParentInTree): Renamed from FindNodeAndParentInTree.
(IsEmptyTree): Reformatted. (DoesTreeContainAny): Reformatted.
(SearchForAny): Reformatted. (ForeachNodeConditionDo) New
procedure. (SearchConditional) New procedure.
* gm2-compiler/SymbolTable.def (GetErrorScope): New procedure
function. (PutErrorScope) New procedure.
* gm2-compiler/SymbolTable.def (GetErrorScope): New procedure
function implemented. (PutErrorScope) New procedure implemented.
(AddListify) New procedure. (Listify) New procedure.
(errorScope) field added to procedure, module, defimp
symbols and initialized during their construction.
Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Diff:
---
gcc/m2/Make-lang.in | 7 +
gcc/m2/bnf/m2-1.bnf | 5 +-
gcc/m2/bnf/m2-2.bnf | 2 +-
gcc/m2/bnf/m2-3.bnf | 1 +
gcc/m2/bnf/m2-c.bnf | 1 +
gcc/m2/bnf/m2-h.bnf | 4 +-
gcc/m2/bnf/m2.bnf | 4 +-
gcc/m2/gm2-compiler/M2Comp.mod | 12 +-
gcc/m2/gm2-compiler/M2Error.def | 44 +++--
gcc/m2/gm2-compiler/M2Error.mod | 324 +++++++++++++++++++++++-------------
gcc/m2/gm2-compiler/M2MetaError.def | 5 +
gcc/m2/gm2-compiler/M2MetaError.mod | 278 +++++++++++++++++++++++++++----
gcc/m2/gm2-compiler/M2Scope.mod | 14 +-
gcc/m2/gm2-compiler/M2StackWord.mod | 26 +--
gcc/m2/gm2-compiler/P0SymBuild.mod | 4 +-
gcc/m2/gm2-compiler/P2SymBuild.mod | 10 +-
gcc/m2/gm2-compiler/P3SymBuild.mod | 10 +-
gcc/m2/gm2-compiler/PCSymBuild.mod | 10 +-
gcc/m2/gm2-compiler/SymbolKey.def | 20 ++-
gcc/m2/gm2-compiler/SymbolKey.mod | 111 +++++++++---
gcc/m2/gm2-compiler/SymbolTable.def | 20 +++
gcc/m2/gm2-compiler/SymbolTable.mod | 115 ++++++++++++-
22 files changed, 789 insertions(+), 238 deletions(-)
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index 04e37419f3c..4b2803eb4ab 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -975,6 +975,13 @@ m2/gm2-compiler-boot/M2GCCDeclare.o: $(srcdir)/m2/gm2-compiler/M2GCCDeclare.mod
-I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \
-I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/M2GCCDeclare.c -o $@
+m2/gm2-compiler-boot/M2Error.o: $(srcdir)/m2/gm2-compiler/M2Error.mod $(MCDEPS) $(BUILD-BOOT-H)
+ $(MC) --extended-opaque -o=m2/gm2-compiler-boot/M2Error.c $<
+ $(COMPILER) -c -fpermissive $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \
+ -I. -I$(srcdir)/../include -I$(srcdir) \
+ -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \
+ -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/M2Error.c -o $@
+
m2/gm2-compiler-boot/%.o: $(srcdir)/m2/gm2-compiler/%.mod $(BUILD-BOOT-H) $(MCDEPS)
$(MC) -o=m2/gm2-compiler-boot/$*.c $(srcdir)/m2/gm2-compiler/$*.mod
$(COMPILER) -c -fpermissive $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \
diff --git a/gcc/m2/bnf/m2-1.bnf b/gcc/m2/bnf/m2-1.bnf
index c51ce0cd293..4d1237d1acb 100644
--- a/gcc/m2/bnf/m2-1.bnf
+++ b/gcc/m2/bnf/m2-1.bnf
@@ -907,14 +907,15 @@ Builtin := "__BUILTIN__" % Pus
| % PushT(NulTok) %
=:
-DefProcedureHeading := "PROCEDURE" % PushAutoOn %
- Builtin
+DefProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
+ Builtin % PushAutoOn %
( PossiblyExportIdent % StartBuildProcedure %
% PushAutoOff %
[ DefFormalParameters ] AttributeNoReturn
% PopAuto %
% BuildProcedureHeading %
) % PopAuto %
+ % M2Error.LeaveErrorScope %
=:
AttributeNoReturn := [ "<*" Ident "*>" ] =:
diff --git a/gcc/m2/bnf/m2-2.bnf b/gcc/m2/bnf/m2-2.bnf
index 4bee2acc559..7bf687e7fea 100644
--- a/gcc/m2/bnf/m2-2.bnf
+++ b/gcc/m2/bnf/m2-2.bnf
@@ -1006,7 +1006,7 @@ DefProcedureHeading := "PROCEDURE" % M2E
[ DefFormalParameters ] AttributeNoReturn
% EndBuildFormalParameters %
% BuildProcedureHeading %
- )
+ ) % M2Error.LeaveErrorScope %
=:
AttributeNoReturn := [ "<*" % PushAutoOff %
diff --git a/gcc/m2/bnf/m2-3.bnf b/gcc/m2/bnf/m2-3.bnf
index d91c6cf912f..836528f86d2 100644
--- a/gcc/m2/bnf/m2-3.bnf
+++ b/gcc/m2/bnf/m2-3.bnf
@@ -1293,6 +1293,7 @@ DefProcedureHeading := "PROCEDURE" % M2E
% BuildProcedureHeading ;
PopAuto %
) % PopAuto %
+ % M2Error.LeaveErrorScope %
=:
AttributeNoReturn := [ "<*" Ident "*>" ] =:
diff --git a/gcc/m2/bnf/m2-c.bnf b/gcc/m2/bnf/m2-c.bnf
index e5ddc516064..5f9ea360d05 100644
--- a/gcc/m2/bnf/m2-c.bnf
+++ b/gcc/m2/bnf/m2-c.bnf
@@ -1104,6 +1104,7 @@ DefProcedureHeading := "PROCEDURE" % M2E
% PCBuildProcedureHeading ;
PopAuto %
) % PopAuto %
+ % M2Error.LeaveErrorScope %
=:
AttributeNoReturn := [ "<*" Ident "*>" ] =:
diff --git a/gcc/m2/bnf/m2-h.bnf b/gcc/m2/bnf/m2-h.bnf
index c6d0d26a9b1..b9297b20da9 100644
--- a/gcc/m2/bnf/m2-h.bnf
+++ b/gcc/m2/bnf/m2-h.bnf
@@ -1120,11 +1120,11 @@ ProcedureHeading := "PROCEDURE" % M2E
Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
-DefProcedureHeading := "PROCEDURE"
+DefProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
Builtin
( Ident
[ DefFormalParameters ] AttributeNoReturn
- )
+ ) % M2Error.LeaveErrorScope %
=:
AttributeNoReturn := [ "<*" Ident "*>" ] =:
diff --git a/gcc/m2/bnf/m2.bnf b/gcc/m2/bnf/m2.bnf
index 515d9997641..67834ee19a3 100644
--- a/gcc/m2/bnf/m2.bnf
+++ b/gcc/m2/bnf/m2.bnf
@@ -807,8 +807,10 @@ AttributeNoReturn := [ "<*" Ident "*>" ] =:
Builtin := [ "__BUILTIN__" % PutModuleContainsBuiltin %
| "__INLINE__" ] =:
-DefProcedureHeading := "PROCEDURE" Builtin
+DefProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
+ Builtin
( Ident [ DefFormalParameters ] AttributeNoReturn )
+ % M2Error.LeaveErrorScope %
=:
-- introduced procedure block so we can produce more informative
diff --git a/gcc/m2/gm2-compiler/M2Comp.mod b/gcc/m2/gm2-compiler/M2Comp.mod
index 700f96eb9b5..a5b3dc52dde 100644
--- a/gcc/m2/gm2-compiler/M2Comp.mod
+++ b/gcc/m2/gm2-compiler/M2Comp.mod
@@ -36,7 +36,7 @@ FROM M2Preprocess IMPORT PreprocessModule ;
FROM libc IMPORT exit ;
FROM M2Error IMPORT ErrorStringAt, ErrorStringAt2, ErrorStringsAt2,
- WriteFormat0, FlushErrors, FlushWarnings, ParsingComplete ;
+ WriteFormat0, FlushErrors, FlushWarnings, ResetErrorScope ;
FROM M2MetaError IMPORT MetaErrorString1, MetaError0, MetaError1 ;
FROM FormatStrings IMPORT Sprintf1 ;
@@ -126,22 +126,22 @@ PROCEDURE Compile (s: String) ;
BEGIN
DoPass0(s) ;
FlushWarnings ; FlushErrors ;
- ResetForNewPass ;
+ ResetForNewPass ; ResetErrorScope ;
qprintf0('Pass 1: scopes, enumerated types, imports and exports\n') ;
DoPass1 ;
FlushWarnings ; FlushErrors ;
qprintf0('Pass 2: constants and types\n') ;
- ResetForNewPass ;
+ ResetForNewPass ; ResetErrorScope ;
DoPass2 ;
FlushWarnings ; FlushErrors ;
qprintf0('Pass C: aggregate constants\n') ;
- ResetForNewPass ;
+ ResetForNewPass ; ResetErrorScope ;
DoPassC ;
FlushWarnings ; FlushErrors ;
qprintf0('Pass 3: quadruple generation\n') ;
- ResetForNewPass ;
+ ResetForNewPass ; ResetErrorScope ;
DoPass3 ;
- FlushWarnings ; FlushErrors ; ParsingComplete ;
+ FlushWarnings ; FlushErrors ;
qprintf0('Pass 4: gcc tree generation\n') ;
Code ;
FlushWarnings ; FlushErrors
diff --git a/gcc/m2/gm2-compiler/M2Error.def b/gcc/m2/gm2-compiler/M2Error.def
index 842eccd18ba..d9d312c5b99 100644
--- a/gcc/m2/gm2-compiler/M2Error.def
+++ b/gcc/m2/gm2-compiler/M2Error.def
@@ -32,7 +32,8 @@ DEFINITION MODULE M2Error ;
FROM SYSTEM IMPORT BYTE ;
FROM DynamicStrings IMPORT String ;
FROM NameKey IMPORT Name ;
-EXPORT QUALIFIED Error,
+
+EXPORT QUALIFIED Error, ErrorScope,
InternalError,
WriteFormat0, WriteFormat1, WriteFormat2, WriteFormat3,
NewError, ErrorFormat0, ErrorFormat1, ErrorFormat2, ErrorFormat3,
@@ -45,13 +46,16 @@ EXPORT QUALIFIED Error,
WarnFormat0, WarnFormat1, MoveError,
AnnounceScope, EnterImplementationScope,
EnterModuleScope, EnterDefinitionScope, EnterProgramScope,
- EnterProcedureScope, LeaveScope, DepthScope, GetAnnounceScope,
+ EnterProcedureScope, DepthScope, GetAnnounceScope,
DefaultProgramModule, DefaultImplementationModule,
DefaultDefinitionModule, DefaultInnerModule, DefaultProcedure,
- ParsingComplete ;
+ EnterErrorScope, GetCurrentErrorScope, ResetErrorScope,
+ LeaveErrorScope ;
+
TYPE
Error ;
+ ErrorScope ;
(*
@@ -273,13 +277,6 @@ PROCEDURE EnterDefinitionScope (scopename: Name) ;
PROCEDURE EnterProcedureScope (scopename: Name) ;
-(*
- LeaveScope - leave the current scope and pop into the previous one.
-*)
-
-PROCEDURE LeaveScope ;
-
-
(*
DepthScope - returns the depth of the scope stack.
*)
@@ -336,11 +333,32 @@ PROCEDURE DefaultProcedure ;
(*
- ParsingComplete - after this is called the Enter scope procedure
- will not assert the default scope was set.
+ EnterErrorScope - pushes the currentScope and sets currentScope to scope.
+*)
+
+PROCEDURE EnterErrorScope (scope: ErrorScope) ;
+
+
+(*
+ LeaveErrorScope - leave the current scope and pop into the previous one.
+*)
+
+PROCEDURE LeaveErrorScope ;
+
+
+(*
+ GetCurrentErrorScope - returns currentScope.
+*)
+
+PROCEDURE GetCurrentErrorScope () : ErrorScope ;
+
+
+(*
+ ResetErrorScope - should be called at the start of each pass to
+ reset the error scope index.
*)
-PROCEDURE ParsingComplete ;
+PROCEDURE ResetErrorScope ;
END M2Error.
diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod
index 4eb4580d790..420ccf7a4de 100644
--- a/gcc/m2/gm2-compiler/M2Error.mod
+++ b/gcc/m2/gm2-compiler/M2Error.mod
@@ -28,14 +28,17 @@ FROM StrLib IMPORT StrLen, StrEqual ;
FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ;
FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToColumnNo, GetTokenNo ;
FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
-FROM M2Printf IMPORT printf0, printf1, printf2 ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
FROM M2Options IMPORT Xcode ;
FROM M2RTS IMPORT ExitOnHalt ;
FROM SYSTEM IMPORT ADDRESS ;
FROM M2Emit IMPORT EmitError ;
FROM M2LexBuf IMPORT UnknownTokenNo ;
-FROM M2StackWord IMPORT StackOfWord, InitStackWord, InitStackWord, PushWord, PopWord, NoOfItemsInStackWord ;
+FROM M2StackAddress IMPORT StackOfAddress, InitStackAddress, PushAddress, PopAddress, NoOfItemsInStackAddress ;
+FROM Indexing IMPORT Index, HighIndice, InitIndex, GetIndice, PutIndice ;
FROM M2Debug IMPORT Assert ;
+FROM M2Pass IMPORT IsPass0, IsPass1 ;
+FROM SymbolTable IMPORT NulSym ;
FROM M2ColorString IMPORT filenameColor, endColor, errorColor, warningColor, noteColor,
range1Color, range2Color, quoteOpen, quoteClose ;
@@ -46,6 +49,7 @@ IMPORT M2Emit ;
CONST
Debugging = TRUE ;
DebugTrace = FALSE ;
+ DebugError = FALSE ;
TYPE
Error = POINTER TO RECORD
@@ -58,20 +62,26 @@ TYPE
(* index of token causing the error *)
token : CARDINAL ;
color : BOOLEAN ;
+ scope : ErrorScope ;
+ END ;
+
+ KindScope = (noscope, definition, implementation, program, module, procedure) ;
+
+ ErrorScope = POINTER TO RECORD
scopeKind: KindScope ;
scopeName: Name ;
+ symbol : CARDINAL ; (* symbol table entry. *)
END ;
- KindScope = (noscope, definition, implementation, program, module, procedure) ;
VAR
head : Error ;
InInternal : BOOLEAN ;
- scopeName : Name ;
- lastKind,
- scopeKind : KindScope ;
- scopeStack : StackOfWord ;
- parsing : BOOLEAN ;
+ lastScope : ErrorScope ;
+ scopeIndex : CARDINAL ;
+ scopeArray : Index ;
+ currentScope: ErrorScope ;
+ scopeStack : StackOfAddress ;
(*
@@ -405,8 +415,7 @@ BEGIN
color := FALSE ;
END ;
(* Assert (scopeKind # noscope) ; *)
- e^.scopeKind := scopeKind ;
- e^.scopeName := scopeName ;
+ e^.scope := currentScope ;
IF (head=NIL) OR (head^.token>AtTokenNo)
THEN
e^.next := head ;
@@ -435,7 +444,7 @@ BEGIN
e := NewError(AtTokenNo) ;
e^.fatal := FALSE ;
e^.note := FALSE ;
- RETURN( e )
+ RETURN e
END NewWarning ;
@@ -451,7 +460,7 @@ BEGIN
e := NewError(AtTokenNo) ;
e^.fatal := FALSE ;
e^.note := TRUE ;
- RETURN( e )
+ RETURN e
END NewNote ;
@@ -477,8 +486,7 @@ BEGIN
parent := e ;
child := NIL ;
fatal := e^.fatal ;
- scopeKind := e^.scopeKind ;
- scopeName := e^.scopeName
+ scope := e^.scope
END ;
e^.child := f
END ;
@@ -568,11 +576,10 @@ PROCEDURE Init ;
BEGIN
head := NIL ;
InInternal := FALSE ;
- scopeStack := InitStackWord () ;
- scopeName := NulName ;
- scopeKind := noscope ;
- lastKind := noscope ;
- parsing := TRUE
+ scopeStack := InitStackAddress () ;
+ scopeArray := InitIndex (1) ;
+ currentScope := NIL ;
+ scopeIndex := 0
END Init ;
@@ -812,6 +819,16 @@ BEGIN
END ErrorAbort0 ;
+(*
+ IsErrorScopeNul - returns TRUE if es is NIL or it has a NulName.
+*)
+
+PROCEDURE IsErrorScopeNul (es: ErrorScope) : BOOLEAN ;
+BEGIN
+ RETURN (es = NIL) OR (es^.scopeName = NulName)
+END IsErrorScopeNul ;
+
+
(*
GetAnnounceScope - return message with the error scope attached to message.
filename and message are treated as read only by this
@@ -832,30 +849,59 @@ BEGIN
pre := Sprintf1 (Mark (InitString ("%s: ")), filename)
END ;
- quoted := InitString ('') ;
- IF scopeName # NulName
+ IF NOT IsErrorScopeNul (currentScope)
THEN
+ quoted := InitString ('') ;
quoted := quoteOpen (quoted) ;
- quoted := ConCat (quoted, Mark (InitStringCharStar (KeyToCharStar (scopeName)))) ;
+ quoted := ConCat (quoted, Mark (InitStringCharStar (KeyToCharStar (currentScope^.scopeName)))) ;
quoted := quoteClose (quoted)
END ;
- CASE scopeKind OF
- definition : desc := InitString ("In definition module") |
- implementation: desc := InitString ("In implementation module") |
- program : desc := InitString ("In program module") |
- module : desc := InitString ("In inner module") |
- procedure : desc := InitString ("In procedure")
+ IF currentScope = NIL
+ THEN
+ desc := InitString ('')
+ ELSE
+ CASE currentScope^.scopeKind OF
+
+ definition : desc := InitString ("In definition module") |
+ implementation: desc := InitString ("In implementation module") |
+ program : desc := InitString ("In program module") |
+ module : desc := InitString ("In inner module") |
+ procedure : desc := InitString ("In procedure")
+ END
+ END ;
+ fmt := ConCat (pre, Mark (desc)) ;
+ IF IsErrorScopeNul (currentScope)
+ THEN
+ fmt := ConCat (fmt, Sprintf0 (Mark (InitString (": "))))
+ ELSE
+ fmt := ConCat (fmt, Sprintf1 (Mark (InitString (" %s: ")), quoted))
END ;
- fmt := ConCat (pre, desc) ;
- fmt := ConCat (fmt, Sprintf1 (Mark (InitString (" %s:\n")), quoted)) ;
RETURN ConCat (fmt, message)
END GetAnnounceScope ;
(*
+ IsSameScope - return TRUE if a and b refer to the same scope.
+*)
+
+PROCEDURE IsSameScope (a, b: ErrorScope) : BOOLEAN ;
+BEGIN
+ IF a = b
+ THEN
+ RETURN TRUE
+ ELSIF (a = NIL) OR (b = NIL)
+ THEN
+ RETURN FALSE
+ ELSE
+ (* this does not compare the symbol field. *)
+ RETURN (a^.scopeKind = b^.scopeKind) AND (a^.scopeName = b^.scopeName)
+ END
+END IsSameScope ;
+
+(*
AnnounceScope - return the error string s with a scope description prepended
assuming that scope has changed.
*)
@@ -864,18 +910,16 @@ PROCEDURE AnnounceScope (e: Error; message: String) : String ;
VAR
filename: String ;
BEGIN
- IF (scopeKind#e^.scopeKind) OR (scopeName#e^.scopeName) OR (lastKind#e^.scopeKind)
+ IF NOT IsSameScope (lastScope, e^.scope)
THEN
- lastKind := e^.scopeKind ;
- scopeKind := e^.scopeKind ;
- scopeName := e^.scopeName ;
- IF e^.scopeKind = noscope
+ lastScope := e^.scope ;
+ IF IsErrorScopeNul (lastScope)
THEN
- RETURN InitString ("no scope active")
+ RETURN ConCat (InitString ("no scope active"), message)
ELSE
- Assert (e^.scopeKind # noscope) ;
- filename := FindFileNameFromToken (e^.token, 0) ;
- message := GetAnnounceScope (filename, message)
+ Assert ((e^.scope # NIL) AND (e^.scope^.scopeKind # noscope)) ;
+ (* filename := FindFileNameFromToken (e^.token, 0) ; *)
+ message := GetAnnounceScope (NIL, message)
END
END ;
RETURN message
@@ -883,18 +927,53 @@ END AnnounceScope ;
(*
- DefaultProgramModule - sets up an unnamed program scope before the Ident is seen.
+ newErrorScope - create an ErrorScope of kindScope and return the object.
+ It is also added the a dynamic array.
*)
-PROCEDURE DefaultProgramModule ;
+PROCEDURE newErrorScope (kind: KindScope) : ErrorScope ;
+VAR
+ es: ErrorScope ;
+ c : CARDINAL ;
BEGIN
- IF parsing
+ IF IsPass0 ()
+ THEN
+ NEW (es) ;
+ es^.scopeKind := kind ;
+ es^.scopeName := NulName ;
+ es^.symbol := NulSym ;
+ PutIndice (scopeArray, HighIndice (scopeArray) + 1, es) ;
+ IF DebugError
+ THEN
+ c := HighIndice (scopeArray) ;
+ printf2 ("pass 0: %d %d\n", c, kind)
+ END
+ ELSE
+ INC (scopeIndex) ;
+ es := GetIndice (scopeArray, scopeIndex) ;
+ IF DebugError
THEN
- scopeKind := program ;
- scopeName := NulName ;
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName)
+ IF IsPass1 ()
+ THEN
+ printf3 ("pass 1: %d %d %d\n", scopeIndex, es^.scopeKind, kind)
+ ELSE
+ printf3 ("pass 2: %d %d %d\n", scopeIndex, es^.scopeKind, kind)
END
+ END ;
+ Assert (es^.scopeKind = kind)
+ END ;
+ RETURN es
+END newErrorScope ;
+
+
+(*
+ DefaultProgramModule - sets up an unnamed program scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProgramModule ;
+BEGIN
+ PushAddress (scopeStack, currentScope) ;
+ currentScope := newErrorScope (program)
END DefaultProgramModule ;
@@ -905,13 +984,8 @@ END DefaultProgramModule ;
PROCEDURE DefaultImplementationModule ;
BEGIN
- IF parsing
- THEN
- scopeKind := implementation ;
- scopeName := NulName ;
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName)
- END
+ PushAddress (scopeStack, currentScope) ;
+ currentScope := newErrorScope (implementation)
END DefaultImplementationModule ;
@@ -922,13 +996,8 @@ END DefaultImplementationModule ;
PROCEDURE DefaultDefinitionModule ;
BEGIN
- IF parsing
- THEN
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName) ;
- scopeKind := definition ;
- scopeName := NulName
- END
+ PushAddress (scopeStack, currentScope) ;
+ currentScope := newErrorScope (definition)
END DefaultDefinitionModule ;
@@ -939,13 +1008,8 @@ END DefaultDefinitionModule ;
PROCEDURE DefaultInnerModule ;
BEGIN
- IF parsing
- THEN
- scopeKind := module ;
- scopeName := NulName ;
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName)
- END
+ PushAddress (scopeStack, currentScope) ;
+ currentScope := newErrorScope (module)
END DefaultInnerModule ;
@@ -956,13 +1020,8 @@ END DefaultInnerModule ;
PROCEDURE DefaultProcedure ;
BEGIN
- IF parsing
- THEN
- scopeKind := procedure ;
- scopeName := NulName ;
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName)
- END ;
+ PushAddress (scopeStack, currentScope) ;
+ currentScope := newErrorScope (procedure)
END DefaultProcedure ;
@@ -973,15 +1032,16 @@ END DefaultProcedure ;
PROCEDURE EnterImplementationScope (scopename: Name) ;
BEGIN
- IF parsing
+ Assert (currentScope # NIL) ;
+ Assert (currentScope^.scopeKind = implementation) ;
+ IF currentScope^.scopeName = NulName
+ THEN
+ IF DebugError
THEN
- Assert (scopeKind = implementation) ;
- LeaveScope (* shutdown the default implementation scope. *)
+ printf1 ("seen implementation: %a\n", scopename)
END ;
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName) ;
- scopeKind := implementation ;
- scopeName := scopename
+ currentScope^.scopeName := scopename
+ END
END EnterImplementationScope ;
@@ -992,15 +1052,16 @@ END EnterImplementationScope ;
PROCEDURE EnterProgramScope (scopename: Name) ;
BEGIN
- IF parsing
+ Assert (currentScope # NIL) ;
+ Assert (currentScope^.scopeKind = program) ;
+ IF currentScope^.scopeName = NulName
+ THEN
+ IF DebugError
THEN
- Assert (scopeKind = program) ;
- LeaveScope (* shutdown the default program scope. *)
+ printf1 ("seen program: %a\n", scopename)
END ;
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName) ;
- scopeKind := program ;
- scopeName := scopename
+ currentScope^.scopeName := scopename
+ END
END EnterProgramScope ;
@@ -1011,15 +1072,16 @@ END EnterProgramScope ;
PROCEDURE EnterModuleScope (scopename: Name) ;
BEGIN
- IF parsing
+ Assert (currentScope # NIL) ;
+ Assert (currentScope^.scopeKind = module) ;
+ IF currentScope^.scopeName = NulName
THEN
- Assert (scopeKind = module) ;
- LeaveScope (* shutdown the default inner module scope. *)
+ IF DebugError
+ THEN
+ printf1 ("seen module: %a\n", scopename)
END ;
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName) ;
- scopeKind := module ;
- scopeName := scopename
+ currentScope^.scopeName := scopename
+ END
END EnterModuleScope ;
@@ -1030,15 +1092,16 @@ END EnterModuleScope ;
PROCEDURE EnterDefinitionScope (scopename: Name) ;
BEGIN
- IF parsing
+ Assert (currentScope # NIL) ;
+ Assert (currentScope^.scopeKind = definition) ;
+ IF currentScope^.scopeName = NulName
THEN
- Assert (scopeKind = definition)
+ IF DebugError
+ THEN
+ printf1 ("seen definition: %a\n", scopename)
END ;
- LeaveScope ; (* shutdown the default definition module scope. *)
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName) ;
- scopeKind := definition ;
- scopeName := scopename
+ currentScope^.scopeName := scopename
+ END
END EnterDefinitionScope ;
@@ -1049,27 +1112,48 @@ END EnterDefinitionScope ;
PROCEDURE EnterProcedureScope (scopename: Name) ;
BEGIN
- IF parsing
+ Assert (currentScope # NIL) ;
+ Assert (currentScope^.scopeKind = procedure) ;
+ IF currentScope^.scopeName = NulName
THEN
- Assert (scopeKind = procedure) ;
- LeaveScope (* shutdown the default procedure scope. *)
+ IF DebugError
+ THEN
+ printf1 ("seen procedure: %a\n", scopename)
END ;
- PushWord (scopeStack, scopeKind) ;
- PushWord (scopeStack, scopeName) ;
- scopeKind := procedure ;
- scopeName := scopename
+ currentScope^.scopeName := scopename
+ END
END EnterProcedureScope ;
(*
- LeaveScope - leave the current scope and pop into the previous one.
+ LeaveErrorScope - leave the current scope and pop into the previous one.
+*)
+
+PROCEDURE LeaveErrorScope ;
+BEGIN
+ currentScope := PopAddress (scopeStack)
+END LeaveErrorScope ;
+
+
+(*
+ EnterErrorScope - pushes the currentScope and sets currentScope to scope.
+*)
+
+PROCEDURE EnterErrorScope (scope: ErrorScope) ;
+BEGIN
+ PushAddress (scopeStack, currentScope) ;
+ currentScope := scope
+END EnterErrorScope ;
+
+
+(*
+ GetCurrentErrorScope - returns currentScope.
*)
-PROCEDURE LeaveScope ;
+PROCEDURE GetCurrentErrorScope () : ErrorScope ;
BEGIN
- scopeName := PopWord (scopeStack) ;
- scopeKind := PopWord (scopeStack)
-END LeaveScope ;
+ RETURN currentScope
+END GetCurrentErrorScope ;
(*
@@ -1078,19 +1162,19 @@ END LeaveScope ;
PROCEDURE DepthScope () : CARDINAL ;
BEGIN
- RETURN NoOfItemsInStackWord (scopeStack)
+ RETURN NoOfItemsInStackAddress (scopeStack)
END DepthScope ;
(*
- ParsingComplete - after this is called the Enter scope procedure
- will not assert the default scope was set.
+ ResetErrorScope - should be called at the start of each pass to
+ reset the error scope index.
*)
-PROCEDURE ParsingComplete ;
+PROCEDURE ResetErrorScope ;
BEGIN
- parsing := FALSE
-END ParsingComplete ;
+ scopeIndex := 0
+END ResetErrorScope ;
BEGIN
diff --git a/gcc/m2/gm2-compiler/M2MetaError.def b/gcc/m2/gm2-compiler/M2MetaError.def
index b266f9cae42..a041fcae67c 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.def
+++ b/gcc/m2/gm2-compiler/M2MetaError.def
@@ -85,6 +85,11 @@ EXPORT QUALIFIED MetaError0, MetaError1, MetaError2, MetaError3, MetaError4,
{%R} this error will be the root of the future chained errors.
{%n} decimal number. Not quoted.
{%N} count (number), for example, 1st, 2nd, 3rd, 4th. Not quoted.
+ {%X} push contents of the output string onto the string stack.
+ {%Yname} place contents of dictionary entry name onto the output string.
+ {%Zname} replace dictionary entry name for the output string.
+ Pop contents of the string stack onto the output string.
+ {%Q} remove all entries in the dictionary.
{%P} push the current color state.
{%p} pop the current color state.
{%Ffilename} the string filename will be rendered using the filename color.
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 6bb5f6aa832..e96313a07be 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -38,9 +38,12 @@ FROM SYSTEM IMPORT ADDRESS ;
FROM M2Error IMPORT MoveError ;
FROM M2Debug IMPORT Assert ;
+FROM Indexing IMPORT Index, InitIndex, KillIndex, GetIndice, PutIndice,
+ DeleteIndice, HighIndice ;
+
FROM DynamicStrings IMPORT String, InitString, InitStringCharStar,
ConCat, ConCatChar, Mark, string, KillString,
- Dup, char, Length, Mult, EqualArray ;
+ Dup, char, Length, Mult, EqualArray, Equal ;
FROM SymbolTable IMPORT NulSym,
IsDefImp, IsModule, IsInnerModule,
@@ -55,7 +58,7 @@ FROM SymbolTable IMPORT NulSym,
IsError, GetSymName, GetScope, IsExported,
GetType, SkipType, GetDeclaredDef, GetDeclaredMod,
GetDeclaredModule, GetDeclaredDefinition, GetScope,
- GetFirstUsed, IsNameAnonymous ;
+ GetFirstUsed, IsNameAnonymous, GetErrorScope ;
IMPORT M2ColorString ;
IMPORT M2Error ;
@@ -92,10 +95,232 @@ TYPE
stackPtr : CARDINAL ;
END ;
+
+ dictionaryEntry = POINTER TO RECORD
+ key,
+ value: String ;
+ next : dictionaryEntry ;
+ END ;
+
+
VAR
lastRoot : Error ;
lastColor : colorType ;
seenAbort : BOOLEAN ;
+ dictionary : Index ;
+ outputStack: Index ;
+ freeEntry : dictionaryEntry ;
+
+
+(*
+ pushOutput -
+*)
+
+PROCEDURE pushOutput (VAR eb: errorBlock) ;
+BEGIN
+ PutIndice (outputStack, HighIndice (outputStack)+1, eb.out) ;
+ eb.out := InitString ('') ;
+ eb.glyph := FALSE
+END pushOutput ;
+
+
+(*
+ readWord - reads and returns a word delimited by '}' it uses '%' as
+ the escape character.
+*)
+
+PROCEDURE readWord (VAR eb: errorBlock) : String ;
+VAR
+ word: String ;
+BEGIN
+ word := InitString ('') ;
+ WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # "}") DO
+ IF char (eb.in, eb.ini) = "%"
+ THEN
+ INC (eb.ini)
+ END ;
+ word := ConCatChar (word, char (eb.in, eb.ini)) ;
+ INC (eb.ini)
+ END ;
+ RETURN word
+END readWord ;
+
+
+(*
+ addEntry -
+*)
+
+PROCEDURE addEntry (key, value: String) ;
+VAR
+ e: dictionaryEntry ;
+ s: String ;
+ i: CARDINAL ;
+BEGIN
+ s := lookupString (key) ;
+ IF s = NIL
+ THEN
+ e := newEntry () ;
+ e^.key := key ;
+ e^.value := value ;
+ PutIndice (dictionary, HighIndice (dictionary)+1, e)
+ ELSE
+ i := 1 ;
+ WHILE i <= HighIndice (dictionary) DO
+ e := GetIndice (dictionary, i) ;
+ IF Equal (e^.key, key)
+ THEN
+ e^.value := KillString (e^.value) ;
+ e^.value := value ;
+ RETURN
+ END ;
+ INC (i)
+ END
+ END
+END addEntry ;
+
+
+(*
+ popOutput -
+*)
+
+PROCEDURE popOutput (VAR eb: errorBlock) ;
+VAR
+ key,
+ previous: String ;
+BEGIN
+ IF HighIndice (outputStack) >= 1
+ THEN
+ previous := GetIndice (outputStack, HighIndice (outputStack)) ;
+ DeleteIndice (outputStack, HighIndice (outputStack)) ;
+ key := readWord (eb) ;
+ addEntry (key, eb.out) ;
+ eb.out := previous
+ END
+END popOutput ;
+
+
+(*
+ newEntry -
+*)
+
+PROCEDURE newEntry () : dictionaryEntry ;
+VAR
+ e: dictionaryEntry ;
+BEGIN
+ IF freeEntry = NIL
+ THEN
+ NEW (e)
+ ELSE
+ e := freeEntry ;
+ freeEntry := freeEntry^.next
+ END ;
+ WITH e^ DO
+ key := NIL ;
+ value := NIL ;
+ next := NIL
+ END ;
+ RETURN e
+END newEntry ;
+
+
+(*
+ killEntry - dispose e and delete any strings.
+*)
+
+PROCEDURE killEntry (e: dictionaryEntry) ;
+BEGIN
+ e^.next := freeEntry ;
+ freeEntry := e ;
+ IF e^.key # NIL
+ THEN
+ e^.key := KillString (e^.key)
+ END ;
+ IF e^.value # NIL
+ THEN
+ e^.value := KillString (e^.value)
+ END
+END killEntry ;
+
+
+(*
+ resetDictionary - remove all entries in the dictionary.
+*)
+
+PROCEDURE resetDictionary ;
+VAR
+ i: CARDINAL ;
+ e: dictionaryEntry ;
+BEGIN
+ i := 1 ;
+ WHILE i <= HighIndice (dictionary) DO
+ e := GetIndice (dictionary, i) ;
+ killEntry (e) ;
+ INC (i)
+ END ;
+ dictionary := KillIndex (dictionary) ;
+ dictionary := InitIndex (1)
+END resetDictionary ;
+
+
+(*
+ lookupString - lookup and return a duplicate of the string value for key s.
+ NIL is returned if the key s is unknown.
+*)
+
+PROCEDURE lookupString (s: String) : String ;
+VAR
+ i: CARDINAL ;
+ e: dictionaryEntry ;
+BEGIN
+ i := 1 ;
+ WHILE i <= HighIndice (dictionary) DO
+ e := GetIndice (dictionary, i) ;
+ IF Equal (e^.key, s)
+ THEN
+ RETURN Dup (e^.value)
+ END ;
+ INC (i)
+ END ;
+ RETURN NIL
+END lookupString ;
+
+
+(*
+ lookupDefine - looks up the word in the input string (ending with '}').
+ It uses this word as a key into the dictionary and returns
+ the entry.
+*)
+
+PROCEDURE lookupDefine (VAR eb: errorBlock) : String ;
+VAR
+ s: String ;
+BEGIN
+ s := InitString ('') ;
+ WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # "}") DO
+ IF char (eb.in, eb.ini) = "%"
+ THEN
+ INC (eb.ini)
+ END ;
+ s := ConCatChar (s, char (eb.in, eb.ini)) ;
+ INC (eb.ini)
+ END ;
+ s := lookupString (s) ;
+ IF s = NIL
+ THEN
+ s := InitString ('')
+ END ;
+ RETURN s
+END lookupDefine ;
+
+
+(*
+ processDefine - place contents of dictionary entry name onto the output string.
+*)
+
+PROCEDURE processDefine (VAR eb: errorBlock) ;
+BEGIN
+ eb.out := ConCat (eb.out, lookupDefine (eb))
+END processDefine ;
(*
@@ -972,24 +1197,20 @@ BEGIN
scope := GetScope (sym) ;
IF scope = NulSym
THEN
+ M2Error.EnterErrorScope (NIL) ;
doError (eb, GetDeclaredMod (sym))
ELSE
+ M2Error.EnterErrorScope (GetErrorScope (scope)) ;
IF IsProcedure (scope)
THEN
- M2Error.DefaultProcedure ;
- M2Error.EnterProcedureScope (GetSymName (scope)) ;
- doError (eb, GetDeclaredMod (sym)) ;
+ doError (eb, GetDeclaredMod (sym))
ELSE
IF IsModule (scope)
THEN
IF IsInnerModule (scope)
THEN
- M2Error.DefaultInnerModule ;
- M2Error.EnterModuleScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym))
ELSE
- M2Error.DefaultProgramModule ;
- M2Error.EnterProgramScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym))
END
ELSE
@@ -1000,18 +1221,14 @@ BEGIN
UNTIL GetScope(OuterModule)=NulSym ; *)
IF GetDeclaredModule (sym) = UnknownTokenNo
THEN
- M2Error.DefaultDefinitionModule ;
- M2Error.EnterDefinitionScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym))
ELSE
- M2Error.DefaultImplementationModule ;
- M2Error.EnterImplementationScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym))
END
END
- END ;
- M2Error.LeaveScope
- END
+ END
+ END ;
+ M2Error.LeaveErrorScope
END doErrorScopeMod ;
@@ -1028,24 +1245,20 @@ BEGIN
scope := GetScope (sym) ;
IF scope = NulSym
THEN
+ M2Error.EnterErrorScope (NIL) ;
doError (eb, GetDeclaredDef (sym))
ELSE
+ M2Error.EnterErrorScope (GetErrorScope (scope)) ;
IF IsProcedure (scope)
THEN
- M2Error.DefaultProcedure ;
- M2Error.EnterProcedureScope (GetSymName (scope)) ;
- doError (eb, GetDeclaredDef (sym)) ;
+ doError (eb, GetDeclaredDef (sym))
ELSE
IF IsModule (scope)
THEN
IF IsInnerModule (scope)
THEN
- M2Error.DefaultInnerModule ;
- M2Error.EnterModuleScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym))
ELSE
- M2Error.DefaultProgramModule ;
- M2Error.EnterProgramScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym))
END
ELSE
@@ -1056,18 +1269,14 @@ BEGIN
UNTIL GetScope(OuterModule)=NulSym ; *)
IF GetDeclaredDefinition (sym) = UnknownTokenNo
THEN
- M2Error.DefaultImplementationModule ;
- M2Error.EnterImplementationScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym))
ELSE
- M2Error.DefaultDefinitionModule ;
- M2Error.EnterDefinitionScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym))
END
END
- END ;
- M2Error.LeaveScope
END
+ END ;
+ M2Error.LeaveErrorScope
END doErrorScopeDef ;
@@ -1305,6 +1514,10 @@ BEGIN
DEC (eb.ini) |
'k': unquotedKeyword (eb) ;
DEC (eb.ini) |
+ 'Q': resetDictionary |
+ 'X': pushOutput (eb) |
+ 'Y': processDefine (eb) |
+ 'Z': popOutput (eb) |
'F': filename (eb) ;
DEC (eb.ini) |
'u': eb.quotes := FALSE |
@@ -1312,7 +1525,7 @@ BEGIN
DEC (eb.ini)
ELSE
- InternalFormat (eb, 'expecting one of [akqtdnpsuCDEKNPOUW:<>%]', __LINE__)
+ InternalFormat (eb, 'expecting one of [akqtdnpsuCDEFKNOPQRSTUWXYZ:<>%]', __LINE__)
END ;
INC (eb.ini)
END ;
@@ -2236,5 +2449,8 @@ END MetaString4 ;
BEGIN
lastRoot := NIL ;
lastColor := noColor ;
- seenAbort := FALSE
+ seenAbort := FALSE ;
+ outputStack := InitIndex (1) ;
+ dictionary := InitIndex (1) ;
+ freeEntry := NIL
END M2MetaError.
diff --git a/gcc/m2/gm2-compiler/M2Scope.mod b/gcc/m2/gm2-compiler/M2Scope.mod
index 61d03fa49cc..29955aac4e9 100644
--- a/gcc/m2/gm2-compiler/M2Scope.mod
+++ b/gcc/m2/gm2-compiler/M2Scope.mod
@@ -27,7 +27,7 @@ FROM NameKey IMPORT Name ;
FROM SymbolTable IMPORT IsProcedure, IsDefImp, GetProcedureQuads, GetScope,
GetProcedureScope, IsModule, IsModuleWithinProcedure,
- GetSymName, NulSym ;
+ GetSymName, GetErrorScope, NulSym ;
FROM M2Options IMPORT DisplayQuadruples ;
FROM M2Printf IMPORT printf0, printf1 ;
@@ -433,11 +433,11 @@ BEGIN
unsetscope,
ignorescope : |
- procedurescope : M2Error.EnterProcedureScope (GetSymName (scopeSym)) |
- modulescope : M2Error.EnterModuleScope (GetSymName (scopeSym)) |
- definitionscope : M2Error.EnterDefinitionScope (GetSymName (scopeSym)) |
- implementationscope: M2Error.EnterImplementationScope (GetSymName (scopeSym)) |
- programscope : M2Error.EnterProgramScope (GetSymName (scopeSym))
+ procedurescope ,
+ modulescope ,
+ definitionscope ,
+ implementationscope,
+ programscope : M2Error.EnterErrorScope (GetErrorScope (scopeSym))
END
END
@@ -456,7 +456,7 @@ BEGIN
ignorescope : |
ELSE
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END
END leave ;
diff --git a/gcc/m2/gm2-compiler/M2StackWord.mod b/gcc/m2/gm2-compiler/M2StackWord.mod
index 0507380165f..9a133ff8ed4 100644
--- a/gcc/m2/gm2-compiler/M2StackWord.mod
+++ b/gcc/m2/gm2-compiler/M2StackWord.mod
@@ -29,16 +29,16 @@ CONST
MaxBucket = 10 ;
TYPE
- StackBucket = POINTER TO Bucket ;
- Bucket = RECORD
+ StackBucketWord = POINTER TO BucketWord ;
+ BucketWord = RECORD
bucket: ARRAY [0..MaxBucket-1] OF WORD ;
items : CARDINAL ;
- last : StackBucket ;
+ last : StackBucketWord ;
END ;
StackOfWord = POINTER TO StackDescriptor ;
StackDescriptor = RECORD
- tail: StackBucket ;
+ tail: StackBucketWord ;
END ;
@@ -59,10 +59,10 @@ END InitStackWord ;
(*
- KillBucket - destroys a StackBucket and returns, NIL.
+ KillBucket - destroys a StackBucketWord and returns, NIL.
*)
-PROCEDURE KillBucket (b: StackBucket) : StackBucket ;
+PROCEDURE KillBucket (b: StackBucketWord) : StackBucketWord ;
BEGIN
IF b#NIL
THEN
@@ -89,12 +89,12 @@ END KillStackWord ;
(*
- InitBucket - returns an empty StackBucket.
+ InitBucket - returns an empty StackBucketWord.
*)
-PROCEDURE InitBucket (l: StackBucket) : StackBucket ;
+PROCEDURE InitBucket (l: StackBucketWord) : StackBucketWord ;
VAR
- b: StackBucket ;
+ b: StackBucketWord ;
BEGIN
NEW(b) ;
WITH b^ DO
@@ -138,7 +138,7 @@ END PushWord ;
PROCEDURE PopWord (s: StackOfWord) : WORD ;
VAR
- b: StackBucket ;
+ b: StackBucketWord ;
BEGIN
IF s=NIL
THEN
@@ -185,7 +185,7 @@ END IsEmptyWord ;
PROCEDURE PeepWord (s: StackOfWord; n: CARDINAL) : WORD ;
VAR
- b: StackBucket ;
+ b: StackBucketWord ;
BEGIN
IF s^.tail=NIL
THEN
@@ -227,7 +227,7 @@ END PeepWord ;
PROCEDURE ReduceWord (s: StackOfWord; n: CARDINAL) ;
VAR
- b: StackBucket ;
+ b: StackBucketWord ;
BEGIN
IF s^.tail=NIL
THEN
@@ -279,7 +279,7 @@ END RemoveTop ;
PROCEDURE NoOfItemsInStackWord (s: StackOfWord) : CARDINAL ;
VAR
- b: StackBucket ;
+ b: StackBucketWord ;
n: CARDINAL ;
BEGIN
IF IsEmptyWord(s)
diff --git a/gcc/m2/gm2-compiler/P0SymBuild.mod b/gcc/m2/gm2-compiler/P0SymBuild.mod
index 5bde3d1edf4..9575fd52e14 100644
--- a/gcc/m2/gm2-compiler/P0SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P0SymBuild.mod
@@ -507,7 +507,7 @@ BEGIN
END
END ;
EndBlock ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END EndProcedure ;
@@ -543,7 +543,7 @@ BEGIN
END
END ;
EndBlock ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END EndModule ;
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index b3e139c7907..8bedf3604e0 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -227,7 +227,7 @@ BEGIN
THEN
WriteFormat2('inconsistant definition module name, module began as (%a) and ended with (%a)', NameStart, NameEnd)
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END P2EndBuildDefModule ;
@@ -295,7 +295,7 @@ BEGIN
THEN
WriteFormat1('inconsistant implementation module name %a', NameStart)
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END P2EndBuildImplementationModule ;
@@ -368,7 +368,7 @@ BEGIN
THEN
WriteFormat2('inconsistant program module name %a does not match %a', NameStart, NameEnd)
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END P2EndBuildProgramModule ;
@@ -433,7 +433,7 @@ BEGIN
WriteFormat2('inconsistant inner module name %a does not match %a',
NameStart, NameEnd)
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END EndBuildInnerModule ;
@@ -1272,7 +1272,7 @@ BEGIN
WriteFormat2('end procedure name does not match beginning %a name %a', NameStart, NameEnd)
END ;
EndScope ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END EndBuildProcedure ;
diff --git a/gcc/m2/gm2-compiler/P3SymBuild.mod b/gcc/m2/gm2-compiler/P3SymBuild.mod
index fd8a9e22c78..b493c69db39 100644
--- a/gcc/m2/gm2-compiler/P3SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P3SymBuild.mod
@@ -129,7 +129,7 @@ BEGIN
WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)',
NameStart, NameEnd)
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END P3EndBuildDefModule ;
@@ -200,7 +200,7 @@ BEGIN
WriteFormat0('too many errors in pass 3') ;
FlushErrors
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END P3EndBuildImpModule ;
@@ -273,7 +273,7 @@ BEGIN
WriteFormat0('too many errors in pass 3') ;
FlushErrors
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END P3EndBuildProgModule ;
@@ -343,7 +343,7 @@ BEGIN
FlushErrors
END ;
SetCurrentModule(GetModuleScope(GetCurrentModule())) ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END EndBuildInnerModule ;
@@ -511,7 +511,7 @@ BEGIN
FlushErrors
END ;
EndScope ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END EndBuildProcedure ;
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod
index bdfada86008..c817f0197bf 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.mod
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -256,7 +256,7 @@ BEGIN
WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)',
NameStart, NameEnd)
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END PCEndBuildDefModule ;
@@ -327,7 +327,7 @@ BEGIN
WriteFormat0('too many errors in pass 3') ;
FlushErrors
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END PCEndBuildImpModule ;
@@ -400,7 +400,7 @@ BEGIN
WriteFormat0('too many errors in pass 3') ;
FlushErrors
END ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END PCEndBuildProgModule ;
@@ -470,7 +470,7 @@ BEGIN
FlushErrors
END ;
SetCurrentModule(GetModuleScope(GetCurrentModule())) ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END PCEndBuildInnerModule ;
@@ -663,7 +663,7 @@ BEGIN
FlushErrors
END ;
EndScope ;
- M2Error.LeaveScope
+ M2Error.LeaveErrorScope
END PCEndBuildProcedure ;
diff --git a/gcc/m2/gm2-compiler/SymbolKey.def b/gcc/m2/gm2-compiler/SymbolKey.def
index bd0bc7b5fbd..cfa9116831f 100644
--- a/gcc/m2/gm2-compiler/SymbolKey.def
+++ b/gcc/m2/gm2-compiler/SymbolKey.def
@@ -37,7 +37,8 @@ EXPORT QUALIFIED NulKey, SymbolTree,
IsSymbol, PerformOperation,
InitTree, KillTree, GetSymKey, PutSymKey, DelSymKey,
IsEmptyTree,
- DoesTreeContainAny, ForeachNodeDo, ContainsSymKey ;
+ DoesTreeContainAny, ForeachNodeDo, ContainsSymKey,
+ NoOfNodes, ForeachNodeConditionDo ;
CONST
NulKey = 0 ;
@@ -118,4 +119,21 @@ PROCEDURE ForeachNodeDo (t: SymbolTree; P: PerformOperation) ;
PROCEDURE ContainsSymKey (t: SymbolTree; NameKey: Name) : BOOLEAN ;
+(*
+ NoOfNodes - returns the number of nodes in the tree t.
+*)
+
+PROCEDURE NoOfNodes (t: SymbolTree; condition: IsSymbol) : CARDINAL ;
+
+
+(*
+ ForeachNodeConditionDo - traverse the tree t and for any node which satisfied
+ condition call P.
+*)
+
+PROCEDURE ForeachNodeConditionDo (t: SymbolTree;
+ condition: IsSymbol;
+ P: PerformOperation) ;
+
+
END SymbolKey.
diff --git a/gcc/m2/gm2-compiler/SymbolKey.mod b/gcc/m2/gm2-compiler/SymbolKey.mod
index 0e31c9d20e8..cc217301150 100644
--- a/gcc/m2/gm2-compiler/SymbolKey.mod
+++ b/gcc/m2/gm2-compiler/SymbolKey.mod
@@ -26,6 +26,7 @@ FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
FROM StrIO IMPORT WriteString, WriteLn ;
FROM NumberIO IMPORT WriteCard ;
FROM NameKey IMPORT WriteKey ;
+FROM Assertion IMPORT Assert ;
FROM Debug IMPORT Halt ;
@@ -100,7 +101,7 @@ VAR
father,
child : SymbolTree ;
BEGIN
- FindNodeAndParentInTree(t, NameKey, child, father) ;
+ FindNodeParentInTree(t, NameKey, child, father) ;
RETURN child#NIL
END ContainsSymKey ;
@@ -110,12 +111,12 @@ VAR
father,
child : SymbolTree ;
BEGIN
- FindNodeAndParentInTree(t, NameKey, child, father) ;
+ FindNodeParentInTree(t, NameKey, child, father) ;
IF child=NIL
THEN
- RETURN( NulKey )
+ RETURN NulKey
ELSE
- RETURN( child^.KeySym )
+ RETURN child^.KeySym
END
END GetSymKey ;
@@ -125,7 +126,7 @@ VAR
father,
child : SymbolTree ;
BEGIN
- FindNodeAndParentInTree(t, NameKey, child, father) ;
+ FindNodeParentInTree(t, NameKey, child, father) ;
IF child=NIL
THEN
(* no child found, now is NameKey less than father or greater? *)
@@ -168,7 +169,7 @@ PROCEDURE DelSymKey (t: SymbolTree; NameKey: Name) ;
VAR
i, child, father: SymbolTree ;
BEGIN
- FindNodeAndParentInTree(t, NameKey, child, father) ; (* find father and child of the node *)
+ FindNodeParentInTree(t, NameKey, child, father) ; (* find father and child of the node *)
IF (child#NIL) AND (child^.KeyName=NameKey)
THEN
(* Have found the node to be deleted *)
@@ -225,35 +226,36 @@ END DelSymKey ;
(*
- FindNodeAndParentInTree - find a node, child, in a binary tree, t, with name equal to n.
- if an entry is found, father is set to the node above child.
+ FindNodeParentInTree - find a node, child, in a binary tree, t, with name equal to n.
+ if an entry is found, parent is set to the node above child.
*)
-PROCEDURE FindNodeAndParentInTree (t: SymbolTree; n: Name;
- VAR child, father: SymbolTree) ;
+PROCEDURE FindNodeParentInTree (t: SymbolTree; n: Name;
+ VAR child, parent: SymbolTree) ;
BEGIN
- (* remember to skip the sentinal value and assign father and child *)
- father := t ;
+ (* remember to skip the sentinal value and assign parent and child *)
+ parent := t ;
IF t=NIL
THEN
Halt('parameter t should never be NIL', __LINE__, __FILE__)
END ;
+ Assert (t^.Right = NIL) ;
child := t^.Left ;
IF child#NIL
THEN
REPEAT
IF n<child^.KeyName
THEN
- father := child ;
+ parent := child ;
child := child^.Left
ELSIF n>child^.KeyName
THEN
- father := child ;
+ parent := child ;
child := child^.Right
END
UNTIL (child=NIL) OR (n=child^.KeyName)
END
-END FindNodeAndParentInTree ;
+END FindNodeParentInTree ;
(*
@@ -262,7 +264,7 @@ END FindNodeAndParentInTree ;
PROCEDURE IsEmptyTree (t: SymbolTree) : BOOLEAN ;
BEGIN
- RETURN( t^.Left=NIL )
+ RETURN t^.Left = NIL
END IsEmptyTree ;
@@ -276,7 +278,7 @@ END IsEmptyTree ;
PROCEDURE DoesTreeContainAny (t: SymbolTree; P: IsSymbol) : BOOLEAN ;
BEGIN
- RETURN( SearchForAny(t^.Left, P) )
+ RETURN SearchForAny (t^.Left, P)
END DoesTreeContainAny ;
@@ -290,9 +292,10 @@ PROCEDURE SearchForAny (t: SymbolTree; P: IsSymbol) : BOOLEAN ;
BEGIN
IF t=NIL
THEN
- RETURN( FALSE )
+ RETURN FALSE
ELSE
- RETURN( P(t^.KeySym) OR SearchForAny(t^.Left, P) OR
+ RETURN( P (t^.KeySym) OR
+ SearchForAny (t^.Left, P) OR
SearchForAny(t^.Right, P)
)
END
@@ -331,4 +334,74 @@ BEGIN
END SearchAndDo ;
+(*
+ CountNodes - wrapper for NoOfNodes.
+*)
+
+PROCEDURE CountNodes (t: SymbolTree; condition: IsSymbol; count: CARDINAL) : CARDINAL ;
+BEGIN
+ IF t # NIL
+ THEN
+ WITH t^ DO
+ IF condition (KeySym)
+ THEN
+ INC (count)
+ END ;
+ count := CountNodes (Left, condition, count) ;
+ count := CountNodes (Right, condition, count)
+ END
+ END ;
+ RETURN count
+END CountNodes ;
+
+
+(*
+ NoOfNodes - returns the number of nodes in the tree t.
+*)
+
+PROCEDURE NoOfNodes (t: SymbolTree; condition: IsSymbol) : CARDINAL ;
+BEGIN
+ RETURN CountNodes (t^.Left, condition, 0)
+END NoOfNodes ;
+
+
+(*
+ SearchConditional - wrapper for ForeachNodeConditionDo.
+*)
+
+PROCEDURE SearchConditional (t: SymbolTree; condition: IsSymbol; P: PerformOperation) ;
+BEGIN
+ IF t#NIL
+ THEN
+ WITH t^ DO
+ SearchConditional (Right, condition, P) ;
+ IF (KeySym # 0) AND condition (KeySym)
+ THEN
+ P (KeySym)
+ END ;
+ SearchConditional (Left, condition, P)
+ END
+ END
+END SearchConditional ;
+
+
+(*
+ ForeachNodeConditionDo - traverse the tree t and for any node which satisfied
+ condition call P.
+*)
+
+PROCEDURE ForeachNodeConditionDo (t: SymbolTree;
+ condition: IsSymbol;
+ P: PerformOperation) ;
+BEGIN
+ IF t#NIL
+ THEN
+ WITH t^ DO
+ Assert (Right = NIL) ;
+ SearchConditional (Left, condition, P)
+ END
+ END
+END ForeachNodeConditionDo ;
+
+
END SymbolKey.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index aaba4c4b893..24329a7e1ae 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -34,6 +34,7 @@ FROM SymbolKey IMPORT PerformOperation ;
FROM NameKey IMPORT Name ;
FROM m2tree IMPORT Tree ;
FROM DynamicStrings IMPORT String ;
+FROM M2Error IMPORT ErrorScope ;
EXPORT QUALIFIED NulSym,
FinalSymbol,
@@ -311,6 +312,7 @@ EXPORT QUALIFIED NulSym,
PutModuleContainsBuiltin, IsBuiltinInModule,
HasVarParameters,
+ GetErrorScope,
IsSizeSolved,
IsOffsetSolved,
@@ -3202,4 +3204,22 @@ PROCEDURE DisplayTrees (ModSym: CARDINAL) ;
PROCEDURE DebugLineNumbers (sym: CARDINAL) ;
+(*
+ GetErrorScope - returns the error scope for a symbol.
+ The error scope is the title scope which is used to
+ announce the symbol in the GCC error message.
+*)
+
+PROCEDURE GetErrorScope (sym: CARDINAL) : ErrorScope ;
+
+
+(*
+ PutErrorScope - sets the error scope for a symbol.
+ The error scope is the title scope which is used to
+ announce the symbol in the GCC error message.
+
+PROCEDURE PutErrorScope (sym: CARDINAL; errorScope: ErrorScope) ;
+*)
+
+
END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index f3e6b0b5bd6..14e89f36740 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -41,7 +41,7 @@ FROM M2ALU IMPORT InitValue, PtrToValue, PushCard, PopInto,
FROM M2Error IMPORT Error, NewError, ChainError, InternalError,
ErrorFormat0, ErrorFormat1, ErrorFormat2,
WriteFormat0, WriteFormat1, WriteFormat2, ErrorString,
- ErrorAbort0, FlushErrors ;
+ ErrorAbort0, FlushErrors, ErrorScope, GetCurrentErrorScope ;
FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3, MetaErrors1,
MetaErrorT0,
@@ -63,10 +63,11 @@ FROM Lists IMPORT List, InitList, GetItemFromList, PutItemIntoList,
FROM NameKey IMPORT Name, MakeKey, makekey, NulName, WriteKey, LengthKey, GetKey, KeyToCharStar ;
-FROM SymbolKey IMPORT NulKey, SymbolTree,
+FROM SymbolKey IMPORT NulKey, SymbolTree, IsSymbol,
InitTree,
GetSymKey, PutSymKey, DelSymKey, IsEmptyTree,
- DoesTreeContainAny, ForeachNodeDo ;
+ DoesTreeContainAny, ForeachNodeDo, ForeachNodeConditionDo,
+ NoOfNodes ;
FROM M2Base IMPORT MixTypes, InitBase, Char, Integer, LongReal,
Cardinal, LongInt, LongCard, ZType, RType ;
@@ -165,6 +166,8 @@ TYPE
name : Name ; (* Index into name array, name *)
(* of record. *)
oafamily : CARDINAL ; (* The oafamily for this sym *)
+ errorScope: ErrorScope ; (* Title scope used if an *)
+ (* error is emitted. *)
At : Where ; (* Where was sym declared/used *)
END ;
@@ -365,6 +368,7 @@ TYPE
ExceptionFinally,
ExceptionBlock: BOOLEAN ; (* does it have an exception? *)
Scope : CARDINAL ; (* Scope of declaration. *)
+ errorScope : ErrorScope ; (* The title scope. *)
ListOfModules : List ; (* List of all inner modules. *)
Begin, End : CARDINAL ; (* Tokens marking the BEGIN END *)
At : Where ; (* Where was sym declared/used *)
@@ -660,6 +664,7 @@ TYPE
ListOfProcs : List ; (* List of all procedures *)
(* declared within this module. *)
ListOfModules : List ; (* List of all inner modules. *)
+ errorScope : ErrorScope ; (* The title scope. *)
At : Where ; (* Where was sym declared/used *)
END ;
@@ -722,6 +727,7 @@ TYPE
ListOfProcs : List ; (* List of all procedures *)
(* declared within this module. *)
ListOfModules : List ; (* List of all inner modules. *)
+ errorScope : ErrorScope ; (* The title scope. *)
At : Where ; (* Where was sym declared/used *)
END ;
@@ -2808,7 +2814,8 @@ BEGIN
Scope := NulSym
ELSE
Scope := pCall^.Main
- END
+ END ;
+ errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
END
END ;
PutSymKey(ModuleTree, ModuleName, Sym) ;
@@ -2919,7 +2926,8 @@ BEGIN
ELSE
Scope := GetCurrentScope() ;
AddModuleToParent(Sym, Scope)
- END
+ END ;
+ errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
END ;
END ;
AddSymToScope(Sym, ModuleName)
@@ -3039,6 +3047,7 @@ BEGIN
InitList(ListOfModules) ; (* List of all inner modules. *)
InitWhereDeclaredTok(tok, At) ; (* Where symbol declared. *)
InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
+ errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
END
END ;
PutSymKey(ModuleTree, DefImpName, Sym) ;
@@ -3122,6 +3131,7 @@ BEGIN
Begin := 0 ; (* token number for BEGIN *)
End := 0 ; (* token number for END *)
InitWhereDeclaredTok(tok, At) ; (* Where symbol declared. *)
+ errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
END
END ;
(* Now add this procedure to the symbol table of the current scope *)
@@ -7897,6 +7907,45 @@ BEGIN
END IsUnreportedUnknown ;
+VAR
+ ListifySentance : String ;
+ ListifyTotal,
+ ListifyWordCount: CARDINAL ;
+
+
+(*
+ AddListify -
+*)
+
+PROCEDURE AddListify (sym: CARDINAL) ;
+BEGIN
+ INC (ListifyWordCount) ;
+ IF ListifyWordCount = ListifyTotal
+ THEN
+ ListifySentance := ConCat (ListifySentance, Mark (InitString (" and ")))
+ ELSIF ListifyWordCount > 1
+ THEN
+ ListifySentance := ConCat (ListifySentance, Mark (InitString (", ")))
+ END ;
+ ListifySentance := ConCat (ListifySentance,
+ Mark (InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
+END AddListify ;
+
+
+(*
+ Listify - convert tree into a string list and return the result.
+*)
+
+PROCEDURE Listify (tree: SymbolTree; isCondition: IsSymbol) : String ;
+BEGIN
+ ListifyTotal := NoOfNodes (tree, isCondition) ;
+ ListifyWordCount := 0 ;
+ ListifySentance := InitString ('') ;
+ ForeachNodeConditionDo (tree, isCondition, AddListify) ;
+ RETURN ListifySentance
+END Listify ;
+
+
(*
CheckForUnknowns - checks a binary tree, Tree, to see whether it contains
an unknown symbol. All unknown symbols are displayed
@@ -7915,6 +7964,8 @@ BEGIN
s := ConCat(s, Mark(InitStringCharStar(KeyToCharStar(name)))) ;
s := ConCat(s, Mark(InitString('%> were '))) ;
s := ConCat(s, Mark(InitString(a))) ;
+ s := ConCat (s, Mark (InitString (': '))) ;
+ s := ConCat (s, Mark (Listify (Tree, IsUnreportedUnknown))) ;
MetaErrorStringT0(GetTokenNo(), s) ;
ForeachNodeDo(Tree, UnknownSymbolError)
END
@@ -9678,6 +9729,7 @@ BEGIN
WITH Undefined DO
name := SymName ;
oafamily := NulSym ;
+ errorScope := GetCurrentErrorScope () ;
InitWhereFirstUsedTok (tok, At)
END
END
@@ -13283,6 +13335,59 @@ END DumpSymbols ;
*)
+(*
+ GetErrorScope - returns the error scope for a symbol.
+ The error scope is the title scope which is used to
+ announce the symbol in the GCC error message.
+*)
+
+PROCEDURE GetErrorScope (sym: CARDINAL) : ErrorScope ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: RETURN Procedure.errorScope |
+ ModuleSym : RETURN Module.errorScope |
+ DefImpSym : RETURN DefImp.errorScope |
+ UndefinedSym: RETURN Undefined.errorScope
+
+ ELSE
+ InternalError ('expecting procedure, module or defimp symbol')
+ END
+ END
+END GetErrorScope ;
+
+
+(*
+ PutErrorScope - sets the error scope for a symbol.
+ The error scope is the title scope which is used to
+ announce the symbol in the GCC error message.
+*)
+
+(*
+PROCEDURE PutErrorScope (sym: CARDINAL; errorScope: ErrorScope) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (type) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: Procedure.errorScope := errorScope |
+ ModuleSym : Module.errorScope := errorScope |
+ DefImpSym : DefImp.errorScope := errorScope
+
+ ELSE
+ InternalError ('expecting procedure, module or defimp symbol')
+ END
+ END
+END PutErrorScope ;
+*)
+
+
(*
IsLegal - returns TRUE if, sym, is a legal symbol.
*)
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-12-25 11:36 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-12-25 11:36 [gcc/devel/modula-2] Bugfixes for default scope, tidying up of code and neater error messages 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).