This followup to PR modula2/122241 reduces error message clutter by
filtering unknown symbol error ensuring that only one error message
is emitted for an unknown symbol at a particular location.
The filter is implemented using two binary trees. A new generic
(based on the address type) binary dictionary module is added to
the base libraries.
gcc/m2/ChangeLog:
PR modula2/122407
* Make-lang.in (GM2-LIBS-BOOT-DEFS): Add BinDict.def.
(GM2-LIBS-BOOT-MODS): Add BinDict.mod.
(GM2-COMP-BOOT-DEFS): Add FilterError.def.
(GM2-COMP-BOOT-MODS): Add FilterError.mod.
(GM2-LIBS-DEFS): Add BinDict.def.
(GM2-LIBS-MODS): Add BinDict.mod.
* gm2-compiler/M2Error.def (KillError): New procedure.
* gm2-compiler/M2Error.mod (WriteFormat3): Reformat.
(NewError): Rewrite and call AddToList.
(AddToList): New procedure.
(SubFromList): Ditto.
(WipeReferences): Ditto.
(KillError): Ditto.
* gm2-compiler/M2LexBuf.mod (MakeVirtualTok): Return
caret if all token positions are identical.
* gm2-compiler/M2MetaError.mod (KillError): Import.
(FilterError): Import.
(FilterUnknown): New global.
(initErrorBlock): Initialize symcause and token.
(push): Capitalize comments.
(pop): Copy symcause to toblock if discovered.
(doError): Add parameter sym.
(defaultError): Assign token if discovered.
Pass NulSym to doError.
(updateTokSym): New procedure.
(chooseError): Call updateTokSym.
(doErrorScopeModule): Pass sym to doError.
(doErrorScopeForward): Ditto.
(doErrorScopeMod): Ditto.
(doErrorScopeFor): Ditto.
(doErrorScopeDefinition): Ditto.
(doErrorScopeDef): Ditto.
(doErrorScopeProc): Ditto.
(used): Pass sym[bol] to doError.
(op): Assign symcause when encountering
an error, warning or note.
(MetaErrorStringT1): Rewrite.
(MetaErrorStringT2): Ditto.
(MetaErrorStringT3): Ditto.
(MetaErrorStringT4): Ditto.
(isUniqueError): New procedure function.
(wrapErrors): Rewrite.
(FilterUnknown): Initialize.
* gm2-compiler/M2Quads.mod (BuildTSizeFunction): Add spell check
hint specifier.
* gm2-compiler/FilterError.def: New file.
* gm2-compiler/FilterError.mod: New file.
* gm2-libs/BinDict.def: New file.
* gm2-libs/BinDict.mod: New file.
libgm2/ChangeLog:
PR modula2/122407
* libm2pim/Makefile.am (M2MODS): Add BinDict.mod.
(M2DEFS): Add BinDict.def.
* libm2pim/Makefile.in: Regenerate.
Signed-off-by: Gaius Mulley <[email protected]>
---
gcc/m2/Make-lang.in | 8 +
gcc/m2/gm2-compiler/FilterError.def | 61 +++++++
gcc/m2/gm2-compiler/FilterError.mod | 229 +++++++++++++++++++++++
gcc/m2/gm2-compiler/M2Error.def | 8 +
gcc/m2/gm2-compiler/M2Error.mod | 108 +++++++++--
gcc/m2/gm2-compiler/M2LexBuf.mod | 4 +
gcc/m2/gm2-compiler/M2MetaError.mod | 212 ++++++++++++++++------
gcc/m2/gm2-compiler/M2Quads.mod | 3 +-
gcc/m2/gm2-libs/BinDict.def | 92 ++++++++++
gcc/m2/gm2-libs/BinDict.mod | 272 ++++++++++++++++++++++++++++
libgm2/libm2pim/Makefile.am | 8 +-
libgm2/libm2pim/Makefile.in | 22 ++-
12 files changed, 938 insertions(+), 89 deletions(-)
create mode 100644 gcc/m2/gm2-compiler/FilterError.def
create mode 100644 gcc/m2/gm2-compiler/FilterError.mod
create mode 100644 gcc/m2/gm2-libs/BinDict.def
create mode 100644 gcc/m2/gm2-libs/BinDict.mod
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index cd4dc9f0698..110a8a18966 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -671,6 +671,7 @@ GM2-LIBS-BOOT-DEFS = \
ASCII.def \
Args.def \
Assertion.def \
+ BinDict.def \
Break.def \
CmdArgs.def \
Debug.def \
@@ -718,6 +719,7 @@ GM2-LIBS-BOOT-MODS = \
ASCII.mod \
Args.mod \
Assertion.mod \
+ BinDict.mod \
Break.mod \
CmdArgs.mod \
Debug.mod \
@@ -769,6 +771,7 @@ GM2-LIBS-BOOT-CC = \
# Definition modules for the front end found in gm2-compiler.
GM2-COMP-BOOT-DEFS = \
+ FilterError.def \
FifoQueue.def \
Lists.def \
M2ALU.def \
@@ -845,6 +848,7 @@ GM2-COMP-BOOT-DEFS = \
# Implementation modules for the front end found in gm2-compiler.
GM2-COMP-BOOT-MODS = \
+ FilterError.mod \
FifoQueue.mod \
Lists.mod \
Lists.mod \
@@ -946,6 +950,7 @@ GM2-LIBS-DEFS = \
ASCII.def \
Args.def \
Assertion.def \
+ BinDict.def \
Break.def \
Builtins.def \
COROUTINES.def \
@@ -1000,6 +1005,7 @@ GM2-LIBS-MODS = \
ASCII.mod \
Args.mod \
Assertion.mod \
+ BinDict.mod \
Break.mod \
Builtins.mod \
COROUTINES.mod \
@@ -1062,6 +1068,7 @@ GM2-LIBS-CC = \
# cc1gm2$(exeext) uses these definition modules found in the gm2-compiler
directory.
GM2-COMP-DEFS = \
+ FilterError.def \
FifoQueue.def \
Lists.def \
M2ALU.def \
@@ -1135,6 +1142,7 @@ GM2-COMP-DEFS = \
# cc1gm2$(exeext) uses these implementation modules found in the gm2-compiler
directory.
GM2-COMP-MODS = \
+ FilterError.mod \
FifoQueue.mod \
Lists.mod \
M2ALU.mod \
diff --git a/gcc/m2/gm2-compiler/FilterError.def
b/gcc/m2/gm2-compiler/FilterError.def
new file mode 100644
index 00000000000..ef84aef2f1f
--- /dev/null
+++ b/gcc/m2/gm2-compiler/FilterError.def
@@ -0,0 +1,61 @@
+(* FilterError.def provides a filter for token and symbol.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE FilterError ;
+
+TYPE
+ Filter ;
+
+
+(*
+ Init - return a new empty Filter.
+*)
+
+PROCEDURE Init () : Filter ;
+
+
+(*
+ AddSymError - adds the pair sym token to the filter.
+*)
+
+PROCEDURE AddSymError (filter: Filter;
+ sym: CARDINAL; token: CARDINAL) ;
+
+(*
+ IsSymError - return TRUE if the pair sym token have been entered in the
filter.
+*)
+
+PROCEDURE IsSymError (filter: Filter; sym: CARDINAL; token: CARDINAL) :
BOOLEAN ;
+
+
+(*
+ Kill - deletes the entire filter tree.
+*)
+
+PROCEDURE Kill (VAR filter: Filter) ;
+
+
+END FilterError.
diff --git a/gcc/m2/gm2-compiler/FilterError.mod
b/gcc/m2/gm2-compiler/FilterError.mod
new file mode 100644
index 00000000000..b2070debabe
--- /dev/null
+++ b/gcc/m2/gm2-compiler/FilterError.mod
@@ -0,0 +1,229 @@
+(* FilterError.def implements a filter for token and symbol.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE FilterError ;
+
+(* The purpose of this module is to be able to filter out multiple error
+ reports refering to the same symbol and token. This is achieved by
+ maintaining a dictionary of symbols each pointing to a dictionary of
+ tokens. *)
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM Storage IMPORT DEALLOCATE, ALLOCATE ;
+FROM BinDict IMPORT Node ;
+FROM Assertion IMPORT Assert ;
+FROM libc IMPORT printf ;
+
+IMPORT BinDict ;
+
+CONST
+ Debugging = FALSE ;
+
+TYPE
+ Filter = POINTER TO RECORD
+ Sym2Dict: BinDict.Dictionary ;
+ END ;
+
+ PtrToCardinal = POINTER TO CARDINAL ;
+ PtrToBoolean = POINTER TO BOOLEAN ;
+
+
+(*
+ Init - return a new empty Filter.
+*)
+
+PROCEDURE Init () : Filter ;
+VAR
+ filter: Filter ;
+BEGIN
+ NEW (filter) ;
+ WITH filter^ DO
+ Sym2Dict := BinDict.Init (CompareCardinal, DeleteCardinal, DeleteTree) ;
+ END ;
+ RETURN filter
+END Init ;
+
+
+(*
+ Kill - deletes the entire filter tree and all contents.
+*)
+
+PROCEDURE Kill (VAR filter: Filter) ;
+BEGIN
+ BinDict.Kill (filter^.Sym2Dict) ;
+ DISPOSE (filter)
+END Kill ;
+
+
+(*
+ CompareCardinal - return an INTEGER representing the comparison
+ between left and right.
+ 0 if left == right, -1 if left < right,
+ +1 if left > right.
+*)
+
+PROCEDURE CompareCardinal (left, right: PtrToCardinal) : INTEGER ;
+BEGIN
+ IF left^ = right^
+ THEN
+ RETURN 0
+ ELSIF left^ < right^
+ THEN
+ RETURN -1
+ ELSE
+ RETURN 1
+ END
+END CompareCardinal ;
+
+
+(*
+ DeleteCardinal - deallocate the cardinal key.
+*)
+
+PROCEDURE DeleteCardinal (card: PtrToCardinal) ;
+BEGIN
+ DISPOSE (card)
+END DeleteCardinal ;
+
+
+(*
+ DeleteBoolean - deallocate the boolean value.
+*)
+
+PROCEDURE DeleteBoolean (boolean: PtrToBoolean) ;
+BEGIN
+ DISPOSE (boolean)
+END DeleteBoolean ;
+
+
+(*
+ DeleteTree - delete tree and all its contents.
+*)
+
+PROCEDURE DeleteTree (ErrorTree: BinDict.Dictionary) ;
+BEGIN
+ BinDict.Kill (ErrorTree)
+END DeleteTree ;
+
+
+(*
+ AddSymError - adds the pair sym token to the filter.
+*)
+
+PROCEDURE AddSymError (filter: Filter;
+ sym: CARDINAL; token: CARDINAL) ;
+BEGIN
+ IF NOT IsSymError (filter, sym, token)
+ THEN
+ AddNewEntry (filter, sym, token, TRUE)
+ END
+END AddSymError ;
+
+
+(*
+ AddNewEntry - adds a new value to the sym token pair.
+*)
+
+PROCEDURE AddNewEntry (filter: Filter; sym: CARDINAL;
+ token: CARDINAL; value: BOOLEAN) ;
+VAR
+ TokenTree : BinDict.Dictionary ;
+ ptrToToken,
+ ptrToCard : PtrToCardinal ;
+ ptrToBool : PtrToBoolean ;
+BEGIN
+ TokenTree := BinDict.Get (filter^.Sym2Dict, ADR (sym)) ;
+ IF TokenTree = NIL
+ THEN
+ TokenTree := BinDict.Init (CompareCardinal, DeleteCardinal,
DeleteBoolean) ;
+ NEW (ptrToCard) ;
+ ptrToCard^ := sym ;
+ BinDict.Insert (filter^.Sym2Dict, ptrToCard, TokenTree) ;
+ Assert (BinDict.Get (filter^.Sym2Dict, ptrToCard) = TokenTree)
+ END ;
+ NEW (ptrToBool) ;
+ ptrToBool^ := value ;
+ NEW (ptrToToken) ;
+ ptrToToken^ := token ;
+ IF Debugging
+ THEN
+ printf ("adding sym %d: key = 0x%x, value = 0x%x (%d, %d)\n",
+ sym, ptrToToken, ptrToBool, ptrToToken^, ptrToBool^)
+ END ;
+ BinDict.Insert (TokenTree, ptrToToken, ptrToBool) ;
+ Assert (BinDict.Get (TokenTree, ptrToToken) = ptrToBool) ;
+ IF Debugging
+ THEN
+ BinDict.PostOrder (TokenTree, PrintNode)
+ END
+END AddNewEntry ;
+
+
+(*
+ PrintNode -
+*)
+
+PROCEDURE PrintNode (node: Node) ;
+VAR
+ ptrToCard : PtrToCardinal ;
+ ptrToBool : PtrToBoolean ;
+BEGIN
+ ptrToCard := BinDict.Key (node) ;
+ ptrToBool := BinDict.Value (node) ;
+ printf ("key = 0x%x, value = 0x%x (%d, %d)\n",
+ ptrToCard, ptrToBool, ptrToCard^, ptrToBool^)
+END PrintNode ;
+
+
+(*
+ IsSymError - return TRUE if the pair sym token have been
+ entered in the filter.
+*)
+
+PROCEDURE IsSymError (filter: Filter; sym: CARDINAL; token: CARDINAL) :
BOOLEAN ;
+VAR
+ ptb : PtrToBoolean ;
+ TokenTree: BinDict.Dictionary ;
+BEGIN
+ TokenTree := BinDict.Get (filter^.Sym2Dict, ADR (sym)) ;
+ (* RETURN (TokenTree # NIL) ; *)
+ IF TokenTree = NIL
+ THEN
+ (* No symbol registered, therefore FALSE. *)
+ RETURN FALSE
+ END ;
+ ptb := BinDict.Get (TokenTree, ADR (token)) ;
+ IF ptb = NIL
+ THEN
+ (* The symbol was registered, but no entry for token, therefore FALSE.
*)
+ RETURN FALSE
+ END ;
+ (* Found symbol and token so we return the result. *)
+ RETURN ptb^
+END IsSymError ;
+
+
+END FilterError.
diff --git a/gcc/m2/gm2-compiler/M2Error.def b/gcc/m2/gm2-compiler/M2Error.def
index 427bd08bc89..7f945e42dc2 100644
--- a/gcc/m2/gm2-compiler/M2Error.def
+++ b/gcc/m2/gm2-compiler/M2Error.def
@@ -129,6 +129,14 @@ PROCEDURE ChainError (AtTokenNo: CARDINAL; e: Error) :
Error ;
PROCEDURE MoveError (e: Error; AtTokenNo: CARDINAL) : Error ;
+(*
+ KillError - remove error e from the error list and deallocate
+ memory associated with e.
+*)
+
+PROCEDURE KillError (VAR e: Error) ;
+
+
(*
SetColor - informs the error module that this error will have had colors
assigned to it. If an error is issued without colors assigned
diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod
index 561f42cf634..095e7327794 100644
--- a/gcc/m2/gm2-compiler/M2Error.mod
+++ b/gcc/m2/gm2-compiler/M2Error.mod
@@ -369,8 +369,8 @@ PROCEDURE WriteFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY
OF BYTE) ;
VAR
e: Error ;
BEGIN
- e := NewError(GetTokenNo()) ;
- e^.s := DoFormat3(a, w1, w2, w3)
+ e := NewError (GetTokenNo ()) ;
+ e^.s := DoFormat3 (a, w1, w2, w3)
END WriteFormat3 ;
@@ -394,7 +394,7 @@ END MoveError ;
PROCEDURE NewError (AtTokenNo: CARDINAL) : Error ;
VAR
- e, f: Error ;
+ e: Error ;
BEGIN
IF AtTokenNo = UnknownTokenNo
THEN
@@ -414,18 +414,7 @@ BEGIN
END ;
(* Assert (scopeKind # noscope) ; *)
e^.scope := currentScope ;
- IF (head=NIL) OR (head^.token>AtTokenNo)
- THEN
- e^.next := head ;
- head := e
- ELSE
- f := head ;
- WHILE (f^.next#NIL) AND (f^.next^.token<AtTokenNo) DO
- f := f^.next
- END ;
- e^.next := f^.next ;
- f^.next := e
- END ;
+ AddToList (e) ;
RETURN( e )
END NewError ;
@@ -462,6 +451,95 @@ BEGIN
END NewNote ;
+(*
+ AddToList - adds error e to the list of errors in token order.
+*)
+
+PROCEDURE AddToList (e: Error) ;
+VAR
+ f: Error ;
+BEGIN
+ IF (head=NIL) OR (head^.token > e^.token)
+ THEN
+ e^.next := head ;
+ head := e
+ ELSE
+ f := head ;
+ WHILE (f^.next # NIL) AND (f^.next^.token < e^.token) DO
+ f := f^.next
+ END ;
+ e^.next := f^.next ;
+ f^.next := e
+ END ;
+END AddToList ;
+
+
+(*
+ SubFromList - remove e from the global list.
+*)
+
+PROCEDURE SubFromList (e: Error) ;
+VAR
+ f: Error ;
+BEGIN
+ IF head = e
+ THEN
+ head := head^.next
+ ELSE
+ f := head ;
+ WHILE (f # NIL) AND (f^.next # e) DO
+ f := f^.next
+ END ;
+ IF (f # NIL) AND (f^.next = e)
+ THEN
+ f^.next := e^.next
+ ELSE
+ InternalError ('expecting e to be on the global list')
+ END
+ END ;
+ DISPOSE (e)
+END SubFromList ;
+
+
+(*
+ WipeReferences - remove any reference to e from the global list.
+*)
+
+PROCEDURE WipeReferences (e: Error) ;
+VAR
+ f: Error ;
+BEGIN
+ f := head ;
+ WHILE f # NIL DO
+ IF f^.parent = e
+ THEN
+ f^.parent := NIL
+ END ;
+ IF f^.child = e
+ THEN
+ f^.child := NIL
+ END ;
+ f := f^.next
+ END
+END WipeReferences ;
+
+
+(*
+ KillError - remove error e from the error list and deallocate
+ memory associated with e.
+*)
+
+PROCEDURE KillError (VAR e: Error) ;
+BEGIN
+ IF head # NIL
+ THEN
+ SubFromList (e) ;
+ WipeReferences (e) ;
+ e := NIL
+ END
+END KillError ;
+
+
(*
ChainError - creates and returns a new error handle, this new error
is associated with, e, and is chained onto the end of, e.
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.mod b/gcc/m2/gm2-compiler/M2LexBuf.mod
index 143190e06a0..51982430296 100644
--- a/gcc/m2/gm2-compiler/M2LexBuf.mod
+++ b/gcc/m2/gm2-compiler/M2LexBuf.mod
@@ -1078,6 +1078,10 @@ BEGIN
THEN
caret := right
END ;
+ IF (caret = left) AND (left = right)
+ THEN
+ RETURN caret
+ END ;
IF isSrcToken (caret) AND isSrcToken (left) AND isSrcToken (right)
THEN
lc := TokenToLocation (caret) ;
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod
b/gcc/m2/gm2-compiler/M2MetaError.mod
index dc14e6b06be..aae0f02eb10 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -26,7 +26,11 @@ FROM M2Base IMPORT ZType, RType, IsPseudoBaseFunction,
IsPseudoBaseProcedure ;
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, FlushWarnings ;
+
+FROM M2Error IMPORT Error, NewError, KillError,
+ NewWarning, NewNote, ErrorString, InternalError,
+ ChainError, SetColor, FlushErrors, FlushWarnings ;
+
FROM FIO IMPORT StdOut, WriteLine ;
FROM SFIO IMPORT WriteS ;
FROM StringConvert IMPORT ctos ;
@@ -67,6 +71,9 @@ FROM SymbolTable IMPORT NulSym,
IMPORT M2ColorString ;
IMPORT M2Error ;
+IMPORT FilterError ;
+
+FROM FilterError IMPORT Filter, AddSymError, IsSymError ;
CONST
@@ -85,6 +92,8 @@ TYPE
errorBlock = RECORD
useError : BOOLEAN ;
e : Error ;
+ symcause : CARDINAL ; (* The symbol (or NulSym)
associated with the token no. *)
+ token : CARDINAL ;
type : errorType ;
out, in : String ;
highplus1 : CARDINAL ;
@@ -115,12 +124,13 @@ TYPE
VAR
- lastRoot : Error ;
- lastColor : colorType ;
- seenAbort : BOOLEAN ;
- dictionary : Index ;
- outputStack: Index ;
- freeEntry : dictionaryEntry ;
+ lastRoot : Error ;
+ lastColor : colorType ;
+ seenAbort : BOOLEAN ;
+ dictionary : Index ;
+ outputStack : Index ;
+ freeEntry : dictionaryEntry ;
+ FilterUnknown: Filter ;
(*
@@ -513,6 +523,8 @@ BEGIN
WITH eb DO
useError := TRUE ;
e := NIL ;
+ symcause := NulSym ;
+ token := UnknownTokenNo ;
type := error ; (* Default to the error color. *)
out := InitString ('') ;
in := input ;
@@ -543,9 +555,9 @@ END initErrorBlock ;
PROCEDURE push (VAR newblock: errorBlock; oldblock: errorBlock) ;
BEGIN
- pushColor (oldblock) ; (* save the current color. *)
- newblock := oldblock ; (* copy all the fields. *)
- newblock.out := NIL ; (* must do this before a clear as we have copied the
address. *)
+ pushColor (oldblock) ; (* Save the current color. *)
+ newblock := oldblock ; (* Now copy all the fields. *)
+ newblock.out := NIL ; (* We must do this before a clear as we have copied
the address. *)
clear (newblock) ;
newblock.quotes := TRUE
END push ;
@@ -604,6 +616,10 @@ BEGIN
THEN
toblock.e := fromblock.e
END ;
+ IF toblock.symcause = NulSym
+ THEN
+ toblock.symcause := fromblock.symcause
+ END ;
toblock.chain := fromblock.chain ;
toblock.root := fromblock.root ;
toblock.ini := fromblock.ini ;
@@ -1173,35 +1189,54 @@ END doChain ;
doError - creates and returns an error note.
*)
-PROCEDURE doError (VAR eb: errorBlock; tok: CARDINAL) ;
+PROCEDURE doError (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ;
BEGIN
IF eb.useError
THEN
- chooseError (eb, tok)
+ chooseError (eb, tok, sym)
END
END doError ;
(*
- defaultError - adds the default error location to, tok, if one has not
already been
- assigned.
+ defaultError - adds the default error location to, tok,
+ if one has not already been assigned.
*)
PROCEDURE defaultError (VAR eb: errorBlock; tok: CARDINAL) ;
BEGIN
IF eb.e = NIL
THEN
- doError (eb, tok)
+ doError (eb, tok, NulSym)
+ END ;
+ IF eb.token = UnknownTokenNo
+ THEN
+ eb.token := tok
END
END defaultError ;
+(*
+ updateTokSym - assign symcause to sym if not NulSym.
+ Update token.
+*)
+
+PROCEDURE updateTokSym (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ;
+BEGIN
+ IF sym # NulSym
+ THEN
+ eb.symcause := sym
+ END ;
+ eb.token := tok
+END updateTokSym ;
+
+
(*
chooseError - choose the error kind dependant upon type.
Either an error, warning or note will be generated.
*)
-PROCEDURE chooseError (VAR eb: errorBlock; tok: CARDINAL) ;
+PROCEDURE chooseError (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ;
BEGIN
IF eb.chain
THEN
@@ -1217,19 +1252,22 @@ BEGIN
eb.e := NewError (tok)
ELSE
eb.e := MoveError (eb.e, tok)
- END |
+ END ;
+ updateTokSym (eb, tok, sym) |
warning: IF eb.e=NIL
THEN
eb.e := NewWarning (tok)
ELSE
eb.e := MoveError (eb.e, tok)
- END |
+ END ;
+ updateTokSym (eb, tok, sym) |
note : IF eb.e=NIL
THEN
eb.e := NewNote (tok)
ELSE
eb.e := MoveError (eb.e, tok)
- END
+ END ;
+ updateTokSym (eb, tok, sym)
ELSE
InternalError ('unexpected enumeration value')
@@ -1257,9 +1295,9 @@ BEGIN
THEN
IF IsInnerModule (scope)
THEN
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
ELSE
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
END
ELSE
Assert (IsDefImp (scope)) ;
@@ -1269,9 +1307,9 @@ BEGIN
UNTIL GetScope(OuterModule)=NulSym. *)
IF GetDeclaredModule (sym) = UnknownTokenNo
THEN
- doError (eb, GetDeclaredDef (sym))
+ doError (eb, GetDeclaredDef (sym), sym)
ELSE
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
END
END
END doErrorScopeModule ;
@@ -1290,9 +1328,9 @@ BEGIN
THEN
IF IsInnerModule (scope)
THEN
- doError (eb, GetDeclaredFor (sym))
+ doError (eb, GetDeclaredFor (sym), sym)
ELSE
- doError (eb, GetDeclaredFor (sym))
+ doError (eb, GetDeclaredFor (sym), sym)
END
ELSE
Assert (IsDefImp (scope)) ;
@@ -1302,9 +1340,9 @@ BEGIN
UNTIL GetScope(OuterModule)=NulSym. *)
IF GetDeclaredModule (sym) = UnknownTokenNo
THEN
- doError (eb, GetDeclaredDef (sym))
+ doError (eb, GetDeclaredDef (sym), sym)
ELSE
- doError (eb, GetDeclaredFor (sym))
+ doError (eb, GetDeclaredFor (sym), sym)
END
END
END doErrorScopeForward ;
@@ -1324,12 +1362,12 @@ BEGIN
IF scope = NulSym
THEN
M2Error.EnterErrorScope (NIL) ;
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
ELSE
M2Error.EnterErrorScope (GetErrorScope (scope)) ;
IF IsProcedure (scope)
THEN
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
ELSE
doErrorScopeModule (eb, sym)
END
@@ -1353,12 +1391,12 @@ BEGIN
IF scope = NulSym
THEN
M2Error.EnterErrorScope (NIL) ;
- doError (eb, GetDeclaredFor (sym))
+ doError (eb, GetDeclaredFor (sym), sym)
ELSE
M2Error.EnterErrorScope (GetErrorScope (scope)) ;
IF IsProcedure (scope)
THEN
- doError (eb, GetDeclaredFor (sym))
+ doError (eb, GetDeclaredFor (sym), sym)
ELSE
doErrorScopeForward (eb, sym)
END
@@ -1392,16 +1430,16 @@ BEGIN
IF IsModule (scope)
THEN
(* No definition module for a program module. *)
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
ELSE
Assert (IsDefImp (scope)) ;
IF GetDeclaredDefinition (sym) = UnknownTokenNo
THEN
(* Fall back to the implementation module if no declaration exists
in the definition module. *)
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
ELSE
- doError (eb, GetDeclaredDef (sym))
+ doError (eb, GetDeclaredDef (sym), sym)
END
END
END doErrorScopeDefinition ;
@@ -1421,12 +1459,12 @@ BEGIN
IF scope = NulSym
THEN
M2Error.EnterErrorScope (NIL) ;
- doError (eb, GetDeclaredFor (sym))
+ doError (eb, GetDeclaredFor (sym), sym)
ELSE
M2Error.EnterErrorScope (GetErrorScope (scope)) ;
IF IsProcedure (scope)
THEN
- doError (eb, GetDeclaredDef (sym))
+ doError (eb, GetDeclaredDef (sym), sym)
ELSE
doErrorScopeDefinition (eb, sym)
END
@@ -1477,25 +1515,25 @@ BEGIN
IF scope = NulSym
THEN
M2Error.EnterErrorScope (NIL) ;
- doError (eb, GetDeclaredDef (sym))
+ doError (eb, GetDeclaredDef (sym), sym)
ELSE
M2Error.EnterErrorScope (GetErrorScope (scope)) ;
IF IsVar (sym) OR IsParameter (sym)
THEN
- doError (eb, GetVarParamTok (sym))
+ doError (eb, GetVarParamTok (sym), sym)
ELSIF IsProcedure (scope)
THEN
- doError (eb, GetDeclaredDef (sym))
+ doError (eb, GetDeclaredDef (sym), sym)
ELSIF IsModule (scope)
THEN
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
ELSE
Assert (IsDefImp (scope)) ;
IF GetDeclaredDefinition (sym) = UnknownTokenNo
THEN
- doError (eb, GetDeclaredMod (sym))
+ doError (eb, GetDeclaredMod (sym), sym)
ELSE
- doError (eb, GetDeclaredDef (sym))
+ doError (eb, GetDeclaredDef (sym), sym)
END
END
END ;
@@ -1550,7 +1588,7 @@ PROCEDURE used (VAR eb: errorBlock; sym: ARRAY OF
CARDINAL; bol: CARDINAL) ;
BEGIN
IF bol <= HIGH (sym)
THEN
- doError (eb, GetFirstUsed (sym[bol]))
+ doError (eb, GetFirstUsed (sym[bol]), sym[bol])
END
END used ;
@@ -1755,7 +1793,8 @@ BEGIN
'B': declaredType (eb, sym, bol) |
'C': eb.chain := TRUE |
'D': declaredDef (eb, sym, bol) |
- 'E': eb.type := error |
+ 'E': eb.type := error ;
+ eb.symcause := sym[bol] |
'F': filename (eb) ;
DEC (eb.ini) |
'G': declaredFor (eb, sym, bol) |
@@ -1764,7 +1803,8 @@ BEGIN
DEC (eb.ini) |
'M': declaredMod (eb, sym, bol) |
'N': doCount (eb, sym, bol) |
- 'O': eb.type := note |
+ 'O': eb.type := note ;
+ eb.symcause := sym[bol] |
'P': pushColor (eb) |
'Q': resetDictionary |
'R': eb.root := TRUE |
@@ -1772,7 +1812,8 @@ BEGIN
'T': doGetType (eb, sym, bol) |
'U': used (eb, sym, bol) |
'V': declaredVar (eb, sym, bol) |
- 'W': eb.type := warning |
+ 'W': eb.type := warning ;
+ eb.symcause := sym[bol] |
'X': pushOutput (eb) |
'Y': processDefine (eb) |
'Z': popOutput (eb) |
@@ -2402,7 +2443,12 @@ BEGIN
ebnf (eb, sym) ;
flushColor (eb) ;
defaultError (eb, tok) ;
- ErrorString (eb.e, Dup (eb.out)) ;
+ IF isUniqueError (eb)
+ THEN
+ ErrorString (eb.e, Dup (eb.out)) ;
+ ELSE
+ KillError (eb.e)
+ END ;
killErrorBlock (eb) ;
checkAbort
END MetaErrorStringT1 ;
@@ -2425,7 +2471,12 @@ BEGIN
ebnf (eb, sym) ;
flushColor (eb) ;
defaultError (eb, tok) ;
- ErrorString (eb.e, Dup (eb.out)) ;
+ IF isUniqueError (eb)
+ THEN
+ ErrorString (eb.e, Dup (eb.out))
+ ELSE
+ KillError (eb.e)
+ END ;
killErrorBlock (eb) ;
checkAbort
END MetaErrorStringT2 ;
@@ -2450,7 +2501,12 @@ BEGIN
ebnf (eb, sym) ;
flushColor (eb) ;
defaultError (eb, tok) ;
- ErrorString (eb.e, Dup (eb.out)) ;
+ IF isUniqueError (eb)
+ THEN
+ ErrorString (eb.e, Dup (eb.out))
+ ELSE
+ KillError (eb.e)
+ END ;
killErrorBlock (eb) ;
checkAbort
END MetaErrorStringT3 ;
@@ -2475,7 +2531,12 @@ BEGIN
ebnf (eb, sym) ;
flushColor (eb) ;
defaultError (eb, tok) ;
- ErrorString (eb.e, Dup (eb.out)) ;
+ IF isUniqueError (eb)
+ THEN
+ ErrorString (eb.e, Dup (eb.out))
+ ELSE
+ KillError (eb.e)
+ END ;
killErrorBlock (eb) ;
checkAbort
END MetaErrorStringT4 ;
@@ -2517,6 +2578,31 @@ BEGIN
END MetaError4 ;
+(*
+ isUniqueError - return TRUE if the symbol associated with the
+ error block is unknown and we have seen the same
+ token before.
+*)
+
+PROCEDURE isUniqueError (VAR eb: errorBlock) : BOOLEAN ;
+BEGIN
+ IF (eb.symcause # NulSym) AND IsUnknown (eb.symcause)
+ THEN
+ (* A candidate for filtering. *)
+ IF IsSymError (FilterUnknown, eb.symcause, eb.token)
+ THEN
+ (* Seen and reported about this unknown and token
+ location before. *)
+ RETURN FALSE
+ ELSE
+ (* Remember this combination. *)
+ AddSymError (FilterUnknown, eb.symcause, eb.token)
+ END
+ END ;
+ RETURN TRUE
+END isUniqueError ;
+
+
(*
wrapErrors -
*)
@@ -2531,15 +2617,20 @@ BEGIN
ebnf (eb, sym) ;
flushColor (eb) ;
defaultError (eb, tok) ;
- lastRoot := eb.e ;
- ErrorString (eb.e, Dup (eb.out)) ;
- killErrorBlock (eb) ;
- initErrorBlock (eb, InitString (m2), sym) ;
- eb.type := chained ;
- ebnf (eb, sym) ;
- flushColor (eb) ;
- defaultError (eb, tok) ;
- ErrorString (eb.e, Dup (eb.out)) ;
+ IF isUniqueError (eb)
+ THEN
+ lastRoot := eb.e ;
+ ErrorString (eb.e, Dup (eb.out)) ;
+ killErrorBlock (eb) ;
+ initErrorBlock (eb, InitString (m2), sym) ;
+ eb.type := chained ;
+ ebnf (eb, sym) ;
+ flushColor (eb) ;
+ defaultError (eb, tok) ;
+ ErrorString (eb.e, Dup (eb.out))
+ ELSE
+ KillError (eb.e)
+ END ;
killErrorBlock (eb)
END wrapErrors ;
@@ -2871,5 +2962,6 @@ BEGIN
seenAbort := FALSE ;
outputStack := InitIndex (1) ;
dictionary := InitIndex (1) ;
- freeEntry := NIL
+ freeEntry := NIL ;
+ FilterUnknown := FilterError.Init ()
END M2MetaError.
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 3bdf8c56ced..bacd9561a72 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -10776,8 +10776,9 @@ BEGIN
PutVar (ReturnVar, Cardinal) ;
GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, GetSType (OperandT
(1)), FALSE)
ELSE
+ (* Spellcheck. *)
MetaErrorT1 (resulttok,
- '{%E}SYSTEM procedure function {%kTSIZE} expects a
variable or type as its first parameter, seen {%1Ed}',
+ '{%E}SYSTEM procedure function {%kTSIZE} expects a
variable or type as its first parameter, seen {%1Ed} {%1&s}',
OperandT (1)) ;
ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
END
diff --git a/gcc/m2/gm2-libs/BinDict.def b/gcc/m2/gm2-libs/BinDict.def
new file mode 100644
index 00000000000..16272fd4457
--- /dev/null
+++ b/gcc/m2/gm2-libs/BinDict.def
@@ -0,0 +1,92 @@
+(* BinDict.def provides a generic binary dictionary.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE BinDict ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+ Dictionary ;
+ Node ;
+ Compare = PROCEDURE (ADDRESS, ADDRESS) : INTEGER ;
+ Delete = PROCEDURE (ADDRESS) ;
+ VisitNode = PROCEDURE (Node) ;
+
+
+(*
+ Init - create and return a new binary dictionary which will use
+ the compare procedure to order the contents as they are added.
+*)
+
+PROCEDURE Init (KeyCompare: Compare;
+ KeyDelete, ValueDelete: Delete) : Dictionary ;
+
+
+(*
+ Kill - delete the dictionary and its contents.
+ dict is assigned to NIL.
+*)
+
+PROCEDURE Kill (VAR dict: Dictionary) ;
+
+
+(*
+ PostOrder - visit each dictionary entry in post order.
+*)
+
+PROCEDURE PostOrder (dict: Dictionary; visit: VisitNode) ;
+
+
+(*
+ Insert - insert key value pair into the dictionary.
+*)
+
+PROCEDURE Insert (dict: Dictionary; key, value: ADDRESS) ;
+
+
+(*
+ Get - return the value associated with the key or NIL
+ if it does not exist.
+*)
+
+PROCEDURE Get (dict: Dictionary; key: ADDRESS) : ADDRESS ;
+
+
+(*
+ Value - return the value from node.
+*)
+
+PROCEDURE Value (node: Node) : ADDRESS ;
+
+
+(*
+ Key - return the key from node.
+*)
+
+PROCEDURE Key (node: Node) : ADDRESS ;
+
+
+END BinDict.
diff --git a/gcc/m2/gm2-libs/BinDict.mod b/gcc/m2/gm2-libs/BinDict.mod
new file mode 100644
index 00000000000..f8bb8735155
--- /dev/null
+++ b/gcc/m2/gm2-libs/BinDict.mod
@@ -0,0 +1,272 @@
+(* BinDict.mod provides a generic binary dictionary.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE BinDict ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+
+TYPE
+ Dictionary = POINTER TO RECORD
+ content : Node ;
+ compare : Compare ;
+ deleteKey,
+ deleteValue: Delete
+ END ;
+
+ Node = POINTER TO RECORD
+ dict : Dictionary ;
+ left,
+ right: Node ;
+ key,
+ value: ADDRESS ;
+ END ;
+
+
+(*
+ Init - create and return a new binary dictionary which will use
+ the compare procedure to order the contents as they are
+ added.
+*)
+
+PROCEDURE Init (KeyCompare: Compare; KeyDelete,
+ ValueDelete: Delete) : Dictionary ;
+VAR
+ dict: Dictionary ;
+BEGIN
+ NEW (dict) ;
+ WITH dict^ DO
+ content := NIL ;
+ compare := KeyCompare ;
+ deleteKey := KeyDelete ;
+ deleteValue := ValueDelete
+ END ;
+ RETURN dict
+END Init ;
+
+
+(*
+ Kill - delete the dictionary and its contents.
+ dict is assigned to NIL.
+*)
+
+PROCEDURE Kill (VAR dict: Dictionary) ;
+BEGIN
+ PostOrder (dict, DeleteNode) ;
+ DISPOSE (dict) ;
+ dict := NIL
+END Kill ;
+
+
+(*
+ DeleteNode - deletes node dict, key and value.
+*)
+
+PROCEDURE DeleteNode (node: Node) ;
+BEGIN
+ IF node # NIL
+ THEN
+ WITH node^ DO
+ dict^.deleteKey (key) ;
+ dict^.deleteValue (value)
+ END ;
+ DISPOSE (node)
+ END
+END DeleteNode ;
+
+
+(*
+ Insert - insert key value pair into the dictionary.
+*)
+
+PROCEDURE Insert (dict: Dictionary; key, value: ADDRESS) ;
+BEGIN
+ dict^.content := InsertNode (dict, dict^.content, key, value)
+END Insert ;
+
+
+(*
+ InsertNode - insert the key value pair as a new node in the
+ binary tree within dict.
+*)
+
+PROCEDURE InsertNode (dict: Dictionary;
+ node: Node;
+ key, value: ADDRESS) : Node ;
+BEGIN
+ IF node = NIL
+ THEN
+ RETURN ConsNode (dict, key, value, NIL, NIL)
+ ELSE
+ CASE dict^.compare (key, node^.key) OF
+
+ 0: HALT | (* Not expecting to replace a key value. *)
+ -1: RETURN ConsNode (dict, node^.key, node^.value,
+ InsertNode (dict, node^.left,
+ key, value), node^.right) |
+ +1: RETURN ConsNode (dict, node^.key, node^.value,
+ node^.left,
+ InsertNode (dict, node^.right,
+ key, value))
+ END
+ END
+END InsertNode ;
+
+
+(*
+ ConsNode - return a new node containing the pairing key and value.
+ The new node fields are assigned left, right and dict.
+*)
+
+PROCEDURE ConsNode (dict: Dictionary;
+ key, value: ADDRESS;
+ left, right: Node) : Node ;
+VAR
+ node: Node ;
+BEGIN
+ NEW (node) ;
+ node^.key := key ;
+ node^.value := value ;
+ node^.left := left ;
+ node^.right := right ;
+ node^.dict := dict ;
+ RETURN node
+END ConsNode ;
+
+
+(*
+ KeyExist - return TRUE if dictionary contains an entry key.
+ It compares the content and not the address pointer.
+*)
+
+PROCEDURE KeyExist (dict: Dictionary; key: ADDRESS) : BOOLEAN ;
+BEGIN
+ RETURN KeyExistNode (dict^.content, key)
+END KeyExist ;
+
+
+(*
+ KeyExistNode - return TRUE if the binary tree under node contains
+ key.
+*)
+
+PROCEDURE KeyExistNode (node: Node; key: ADDRESS) : BOOLEAN ;
+BEGIN
+ IF node # NIL
+ THEN
+ CASE node^.dict^.compare (key, node^.key) OF
+
+ 0: RETURN TRUE |
+ -1: RETURN KeyExistNode (node^.left, key) |
+ +1: RETURN KeyExistNode (node^.right, key)
+
+ END
+ END ;
+ RETURN FALSE
+END KeyExistNode ;
+
+
+(*
+ Value - return the value from node.
+*)
+
+PROCEDURE Value (node: Node) : ADDRESS ;
+BEGIN
+ RETURN node^.value
+END Value ;
+
+
+(*
+ Key - return the key from node.
+*)
+
+PROCEDURE Key (node: Node) : ADDRESS ;
+BEGIN
+ RETURN node^.value
+END Key ;
+
+
+(*
+ Get - return the value associated with the key or NIL
+ if it does not exist.
+*)
+
+PROCEDURE Get (dict: Dictionary; key: ADDRESS) : ADDRESS ;
+BEGIN
+ RETURN GetNode (dict^.content, key)
+END Get ;
+
+
+(*
+ GetNode - return the value in binary node tree which
+ is associated with key.
+*)
+
+PROCEDURE GetNode (node: Node; key: ADDRESS) : ADDRESS ;
+BEGIN
+ IF node # NIL
+ THEN
+ CASE node^.dict^.compare (key, node^.key) OF
+
+ 0: RETURN node^.value |
+ +1: RETURN GetNode (node^.right, key) |
+ -1: RETURN GetNode (node^.left, key)
+
+ END
+ END ;
+ RETURN NIL
+END GetNode ;
+
+
+(*
+ PostOrder - visit each dictionary entry in post order.
+*)
+
+PROCEDURE PostOrder (dict: Dictionary; visit: VisitNode) ;
+BEGIN
+ IF dict # NIL
+ THEN
+ PostOrderNode (dict^.content, visit)
+ END
+END PostOrder ;
+
+
+(*
+ PostOrderNode - visit the tree node in post order.
+*)
+
+PROCEDURE PostOrderNode (node: Node; visit: VisitNode) ;
+BEGIN
+ IF node # NIL
+ THEN
+ PostOrderNode (node^.left, visit) ;
+ PostOrderNode (node^.right, visit) ;
+ visit (node)
+ END
+END PostOrderNode ;
+
+
+END BinDict.
diff --git a/libgm2/libm2pim/Makefile.am b/libgm2/libm2pim/Makefile.am
index 91990d71092..cc27a077030 100644
--- a/libgm2/libm2pim/Makefile.am
+++ b/libgm2/libm2pim/Makefile.am
@@ -96,8 +96,9 @@ FLAGS_TO_PASS = $(AM_MAKEFLAGS)
if BUILD_PIMLIB
toolexeclib_LTLIBRARIES = libm2pim.la
-M2MODS = ASCII.mod IO.mod \
- Args.mod M2RTS.mod \
+M2MODS = ASCII.mod \
+ Args.mod BinDict.mod \
+ IO.mod M2RTS.mod \
M2Dependent.mod \
M2Diagnostic.mod \
M2WIDESET.mod \
@@ -130,7 +131,8 @@ M2MODS = ASCII.mod IO.mod \
# COROUTINES.mod has been removed as it is implemented in ../libm2iso.
M2DEFS = Args.def ASCII.def \
- Assertion.def Break.def \
+ Assertion.def BinDict.def \
+ Break.def \
Builtins.def cbuiltin.def \
CmdArgs.def CFileSysOp.def \
COROUTINES.def \
diff --git a/libgm2/libm2pim/Makefile.in b/libgm2/libm2pim/Makefile.in
index 139aec94ec0..33b97bf6554 100644
--- a/libgm2/libm2pim/Makefile.in
+++ b/libgm2/libm2pim/Makefile.in
@@ -159,13 +159,13 @@ am__uninstall_files_from_dir = { \
am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
libm2pim_la_LIBADD =
-@BUILD_PIMLIB_TRUE@am__objects_1 = ASCII.lo IO.lo Args.lo M2RTS.lo \
-@BUILD_PIMLIB_TRUE@ M2Dependent.lo M2Diagnostic.lo M2WIDESET.lo \
-@BUILD_PIMLIB_TRUE@ Assertion.lo NumberIO.lo Break.lo SYSTEM.lo \
-@BUILD_PIMLIB_TRUE@ CmdArgs.lo Scan.lo StrCase.lo FIO.lo \
-@BUILD_PIMLIB_TRUE@ StrIO.lo StrLib.lo TimeString.lo \
-@BUILD_PIMLIB_TRUE@ Environment.lo FpuIO.lo Debug.lo \
-@BUILD_PIMLIB_TRUE@ SysStorage.lo Storage.lo StdIO.lo \
+@BUILD_PIMLIB_TRUE@am__objects_1 = ASCII.lo Args.lo BinDict.lo IO.lo \
+@BUILD_PIMLIB_TRUE@ M2RTS.lo M2Dependent.lo M2Diagnostic.lo \
+@BUILD_PIMLIB_TRUE@ M2WIDESET.lo Assertion.lo NumberIO.lo \
+@BUILD_PIMLIB_TRUE@ Break.lo SYSTEM.lo CmdArgs.lo Scan.lo \
+@BUILD_PIMLIB_TRUE@ StrCase.lo FIO.lo StrIO.lo StrLib.lo \
+@BUILD_PIMLIB_TRUE@ TimeString.lo Environment.lo FpuIO.lo \
+@BUILD_PIMLIB_TRUE@ Debug.lo SysStorage.lo Storage.lo StdIO.lo \
@BUILD_PIMLIB_TRUE@ SEnvironment.lo DynamicStrings.lo SFIO.lo \
@BUILD_PIMLIB_TRUE@ SArgs.lo SCmdArgs.lo PushBackInput.lo \
@BUILD_PIMLIB_TRUE@ StringConvert.lo FormatStrings.lo \
@@ -479,8 +479,9 @@ AM_MAKEFLAGS = \
# Subdir rules rely on $(FLAGS_TO_PASS)
FLAGS_TO_PASS = $(AM_MAKEFLAGS)
@BUILD_PIMLIB_TRUE@toolexeclib_LTLIBRARIES = libm2pim.la
-@BUILD_PIMLIB_TRUE@M2MODS = ASCII.mod IO.mod \
-@BUILD_PIMLIB_TRUE@ Args.mod M2RTS.mod \
+@BUILD_PIMLIB_TRUE@M2MODS = ASCII.mod \
+@BUILD_PIMLIB_TRUE@ Args.mod BinDict.mod \
+@BUILD_PIMLIB_TRUE@ IO.mod M2RTS.mod \
@BUILD_PIMLIB_TRUE@ M2Dependent.mod \
@BUILD_PIMLIB_TRUE@ M2Diagnostic.mod \
@BUILD_PIMLIB_TRUE@ M2WIDESET.mod \
@@ -513,7 +514,8 @@ FLAGS_TO_PASS = $(AM_MAKEFLAGS)
# COROUTINES.mod has been removed as it is implemented in ../libm2iso.
@BUILD_PIMLIB_TRUE@M2DEFS = Args.def ASCII.def \
-@BUILD_PIMLIB_TRUE@ Assertion.def Break.def \
+@BUILD_PIMLIB_TRUE@ Assertion.def BinDict.def \
+@BUILD_PIMLIB_TRUE@ Break.def \
@BUILD_PIMLIB_TRUE@ Builtins.def cbuiltin.def \
@BUILD_PIMLIB_TRUE@ CmdArgs.def CFileSysOp.def \
@BUILD_PIMLIB_TRUE@ COROUTINES.def \
--
2.39.5
