procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove duplicate constants created between passes

Browse source 
There is no need to re-create constant literals between passes.
This patch creates a constant pool and reuses a constant literal
providing it is created at the same location.  This in turn avoids
generating duplicate overflow error messages when encountering an
out of range constant literal.

gcc/m2/ChangeLog:

	* gm2-compiler/SymbolTable.mod (ConstLitPoolEntry): New
	pointer to record.
	(ConstLitSym): New field RangeError.
	(ConstLitPoolTree): New SymbolTree representing name to
	index.
	(ConstLitArray): New dynamic array containing pointers
	to a ConstLitPoolEntry.
	(CreateConstLit): New procedure function.
	(LookupConstLitPoolEntry): New procedure function.
	(AddConstLitPoolEntry): New procedure function.
	(MakeConstLit): Re-implemented to check the constant lit
	pool before calling CreateConstLit.
	* m2.flex: Add ability to decode binary constant literals.

gcc/testsuite/ChangeLog:

	* gm2/pim/run/pass/constlitbase.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
This commit is contained in:
Gaius Mulley 2023-04-30 02:53:23 +01:00
parent 8eb1e39441
commit d5e2694e82
3 changed files with 211 additions and 65 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

231
gcc/m2/gm2-compiler/SymbolTable.mod
View file

@ -108,6 +108,14 @@ CONST
UnboundedHighName = "_m2_high_%d" ;
TYPE
ConstLitPoolEntry = POINTER TO RECORD
sym : CARDINAL ;
tok : CARDINAL ;
constName: Name ;
constType: CARDINAL ;
next : ConstLitPoolEntry ;
END ;
LRLists = ARRAY [RightValue..LeftValue] OF List ;
TypeOfSymbol = (RecordSym, VarientSym, DummySym,
@ -469,6 +477,7 @@ TYPE
IsSet : BOOLEAN ; (* is the constant a set? *)
IsConstructor: BOOLEAN ; (* is the constant a set? *)
FromType : CARDINAL ; (* type is determined FromType *)
RangeError : BOOLEAN ; (* Have we reported an error? *)
UnresFromType: BOOLEAN ; (* is Type unresolved? *)
Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
@ -830,10 +839,10 @@ TYPE
END ;
CallFrame = RECORD
Main : CARDINAL ; (* Main scope for insertions *)
Search: CARDINAL ; (* Search scope for symbol searches *)
Start : CARDINAL ; (* ScopePtr value before StartScope *)
(* was called. *)
Main : CARDINAL ; (* Main scope for insertions *)
Search: CARDINAL ; (* Search scope for symbol searches *)
Start : CARDINAL ; (* ScopePtr value before StartScope *)
(* was called. *)
END ;
PtrToSymbol = POINTER TO Symbol ;
@ -842,52 +851,51 @@ TYPE
CheckProcedure = PROCEDURE (CARDINAL) ;
VAR
Symbols : Indexing.Index ; (* ARRAY [1..MaxSymbols] OF Symbol. *)
ScopeCallFrame: Indexing.Index ; (* ARRAY [1..MaxScopes] OF CallFrame. *)
FreeSymbol : CARDINAL ; (* The next free symbol indice. *)
Symbols : Indexing.Index ; (* ARRAY [1..MaxSymbols] OF Symbol. *)
ScopeCallFrame: Indexing.Index ; (* ARRAY [1..MaxScopes] OF CallFrame. *)
FreeSymbol : CARDINAL ; (* The next free symbol indice. *)
DefModuleTree : SymbolTree ;
ModuleTree : SymbolTree ; (* Tree of all modules ever used. *)
ModuleTree : SymbolTree ; (* Tree of all modules ever used. *)
ConstLitStringTree
: SymbolTree ; (* String Literal Constants only need *)
(* to be declared once. *)
ConstLitTree : SymbolTree ; (* Numerical Literal Constants only *)
(* need to be declared once. *)
CurrentModule : CARDINAL ; (* Index into symbols determining the *)
(* current module being compiled. *)
(* This maybe an inner module. *)
MainModule : CARDINAL ; (* Index into symbols determining the *)
(* module the user requested to *)
(* compile. *)
FileModule : CARDINAL ; (* Index into symbols determining *)
(* which module (file) is being *)
(* compiled. (Maybe an import def) *)
ScopePtr : CARDINAL ; (* An index to the ScopeCallFrame. *)
(* ScopePtr determines the top of the *)
(* ScopeCallFrame. *)
BaseScopePtr : CARDINAL ; (* An index to the ScopeCallFrame of *)
(* the top of BaseModule. BaseModule *)
(* is always left at the bottom of *)
(* stack since it is used so *)
(* frequently. When the BaseModule *)
(* needs to be searched the ScopePtr *)
(* is temporarily altered to *)
(* BaseScopePtr and GetScopeSym is *)
(* called. *)
BaseModule : CARDINAL ; (* Index to the symbol table of the *)
(* Base pseudo modeule declaration. *)
TemporaryNo : CARDINAL ; (* The next temporary number. *)
CurrentError : Error ; (* Current error chain. *)
AddressTypes : List ; (* A list of type symbols which must *)
(* be declared as ADDRESS or pointer *)
(*
FreeFVarientList, (* Lists used to maintain GC of field *)
UsedFVarientList: List ; (* varients. *)
*)
UnresolvedConstructorType: List ; (* all constructors whose type *)
(* is not yet known. *)
AnonymousName : CARDINAL ;(* anonymous type name unique id *)
ReportedUnknowns : Set ; (* set of symbols already reported as *)
(* unknowns to the user. *)
: SymbolTree ; (* String Literal Constants only need *)
(* to be declared once. *)
CurrentModule : CARDINAL ; (* Index into symbols determining the *)
(* current module being compiled. *)
(* This maybe an inner module. *)
MainModule : CARDINAL ; (* Index into symbols determining the *)
(* module the user requested to *)
(* compile. *)
FileModule : CARDINAL ; (* Index into symbols determining *)
(* which module (file) is being *)
(* compiled. (Maybe an import def) *)
ScopePtr : CARDINAL ; (* An index to the ScopeCallFrame. *)
(* ScopePtr determines the top of the *)
(* ScopeCallFrame. *)
BaseScopePtr : CARDINAL ; (* An index to the ScopeCallFrame of *)
(* the top of BaseModule. BaseModule *)
(* is always left at the bottom of *)
(* stack since it is used so *)
(* frequently. When the BaseModule *)
(* needs to be searched the ScopePtr *)
(* is temporarily altered to *)
(* BaseScopePtr and GetScopeSym is *)
(* called. *)
BaseModule : CARDINAL ; (* Index to the symbol table of the *)
(* Base pseudo modeule declaration. *)
TemporaryNo : CARDINAL ; (* The next temporary number. *)
CurrentError : Error ; (* Current error chain. *)
AddressTypes : List ; (* A list of type symbols which must *)
(* be declared as ADDRESS or pointer *)
UnresolvedConstructorType: List ; (* all constructors whose type *)
(* is not yet known. *)
AnonymousName : CARDINAL ; (* anonymous type name unique id *)
ReportedUnknowns : Set ; (* set of symbols already reported as *)
(* unknowns to the user. *)
ConstLitPoolTree : SymbolTree ; (* Pool of constants to ensure *)
(* constants are reused between *)
(* passes and reduce duplicate *)
(* errors. *)
ConstLitArray : Indexing.Index ;
(*
@ -1607,11 +1615,12 @@ VAR
BEGIN
AnonymousName := 0 ;
CurrentError := NIL ;
InitTree(ConstLitTree) ;
InitTree(ConstLitStringTree) ;
InitTree(DefModuleTree) ;
InitTree(ModuleTree) ;
Symbols := InitIndex(1) ;
InitTree (ConstLitPoolTree) ;
InitTree (ConstLitStringTree) ;
InitTree (DefModuleTree) ;
InitTree (ModuleTree) ;
Symbols := InitIndex (1) ;
ConstLitArray := InitIndex (1) ;
FreeSymbol := 1 ;
ScopePtr := 1 ;
ScopeCallFrame := InitIndex(1) ;
@ -4752,23 +4761,19 @@ END MakeConstant ;
(*
MakeConstLit - returns a constant literal of type, constType, with a constName,
at location, tok.
CreateConstLit -
*)
PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
PROCEDURE CreateConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
VAR
pSym : PtrToSymbol ;
Sym : CARDINAL ;
issueError,
overflow : BOOLEAN ;
BEGIN
issueError := TRUE ;
overflow := FALSE ;
IF constType=NulSym
THEN
constType := GetConstLitType (tok, constName, overflow, issueError) ;
issueError := NOT overflow
constType := GetConstLitType (tok, constName, overflow, TRUE)
END ;
NewSym (Sym) ;
pSym := GetPsym (Sym) ;
@ -4778,14 +4783,15 @@ BEGIN
ConstLitSym : ConstLit.name := constName ;
ConstLit.Value := InitValue () ;
PushString (tok, constName, issueError) ;
PushString (tok, constName, NOT overflow) ;
PopInto (ConstLit.Value) ;
ConstLit.Type := constType ;
ConstLit.IsSet := FALSE ;
ConstLit.IsConstructor := FALSE ;
ConstLit.FromType := NulSym ; (* type is determined FromType *)
ConstLit.RangeError := overflow ;
ConstLit.UnresFromType := FALSE ; (* is Type resolved? *)
ConstLit.Scope := GetCurrentScope() ;
ConstLit.Scope := GetCurrentScope () ;
InitWhereDeclaredTok (tok, ConstLit.At) ;
InitWhereFirstUsedTok (tok, ConstLit.At)
@ -4794,6 +4800,99 @@ BEGIN
END
END ;
RETURN Sym
END CreateConstLit ;
(*
LookupConstLitPoolEntry - return a ConstLit symbol from the constant pool which
matches tok, constName and constType.
*)
PROCEDURE LookupConstLitPoolEntry (tok: CARDINAL;
constName: Name; constType: CARDINAL) : CARDINAL ;
VAR
pe : ConstLitPoolEntry ;
rootIndex: CARDINAL ;
BEGIN
rootIndex := GetSymKey (ConstLitPoolTree, constName) ;
IF rootIndex # 0
THEN
pe := Indexing.GetIndice (ConstLitArray, rootIndex) ;
WHILE pe # NIL DO
IF (pe^.tok = tok) AND
(pe^.constName = constName) AND
(pe^.constType = constType)
THEN
RETURN pe^.sym
END ;
pe := pe^.next
END
END ;
RETURN NulSym
END LookupConstLitPoolEntry ;
(*
AddConstLitPoolEntry - adds sym to the constlit pool.
*)
PROCEDURE AddConstLitPoolEntry (sym: CARDINAL; tok: CARDINAL;
constName: Name; constType: CARDINAL) ;
VAR
pe, old : ConstLitPoolEntry ;
rootIndex, high: CARDINAL ;
BEGIN
rootIndex := GetSymKey (ConstLitPoolTree, constName) ;
IF rootIndex = NulKey
THEN
high := Indexing.HighIndice (ConstLitArray) ;
NEW (pe) ;
IF pe = NIL
THEN
InternalError ('out of memory')
ELSE
pe^.sym := sym ;
pe^.tok := tok ;
pe^.constName := constName ;
pe^.constType := constType ;
pe^.next := NIL ;
PutSymKey (ConstLitPoolTree, constName, high+1) ;
Indexing.PutIndice (ConstLitArray, high+1, pe)
END
ELSE
NEW (pe) ;
IF pe = NIL
THEN
InternalError ('out of memory')
ELSE
old := Indexing.GetIndice (ConstLitArray, rootIndex) ;
pe^.sym := sym ;
pe^.tok := tok ;
pe^.constName := constName ;
pe^.constType := constType ;
pe^.next := old ;
Indexing.PutIndice (ConstLitArray, rootIndex, pe)
END
END
END AddConstLitPoolEntry ;
(*
MakeConstLit - returns a constant literal of type, constType, with a constName,
at location, tok.
*)
PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
VAR
sym: CARDINAL ;
BEGIN
sym := LookupConstLitPoolEntry (tok, constName, constType) ;
IF sym = NulSym
THEN
sym := CreateConstLit (tok, constName, constType) ;
AddConstLitPoolEntry (sym, tok, constName, constType)
END ;
RETURN sym
END MakeConstLit ;
@ -4822,7 +4921,7 @@ BEGIN
FromType := NulSym ; (* type is determined FromType *)
UnresFromType := FALSE ; (* is Type resolved? *)
IsTemp := FALSE ;
Scope := GetCurrentScope() ;
Scope := GetCurrentScope () ;
InitWhereDeclaredTok (tok, At)
END
END ;
@ -6640,7 +6739,8 @@ BEGIN
WITH pSym^.Var DO
RETURN( IsPointerCheck )
END
END
END ;
RETURN FALSE
END GetVarPointerCheck ;
@ -11997,7 +12097,8 @@ BEGIN
s := CollectUnknown (tok, GetScope (sym), n)
END ;
RETURN( s )
END
END ;
InternalError ('expecting sym should be a module, defimp or procedure symbol')
END CollectUnknown ;

1
gcc/m2/m2.flex
View file

@ -302,6 +302,7 @@ VOLATILE { updatepos(); M2LexBuf_AddTok(M2Reserved_volatiletok
[0-9]*\.E[+-]?[0-9]+ { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
[a-zA-Z_][a-zA-Z0-9_]* { checkFunction(); updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_identtok, yytext); return; }
[0-9]+ { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
[0-1]+A { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
[0-9]+B { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
[0-9]+C { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
[0-9A-F]+H { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }

44
gcc/testsuite/gm2/pim/run/pass/constlitbase.mod Normal file
View file

@ -0,0 +1,44 @@
MODULE constlitbase ;
FROM libc IMPORT exit, printf ;
CONST
BaseAddress = 0ABCDH ;
One = 0FH ;
Two = 0FFH ;
Three = 0FFFH ;
Four = 0FFFFH ;
Limit = 01000 ;
Oct = 0100B ;
Bin = 0101A ;
Hex = 0101H ;
HexTest = 01AH ;
ByteMax = 011111111A ;
PROCEDURE Assert (var, const: CARDINAL) ;
BEGIN
IF var # const
THEN
printf ("test failed %d # %d\n", var, const) ;
code := 1
END
END Assert ;
VAR
code: INTEGER ;
BEGIN
code := 0 ;
Assert (BaseAddress, 43981) ;
Assert (One, 15) ;
Assert (Two, 255) ;
Assert (Three, 4095) ;
Assert (Four, 65535) ;
Assert (Limit, 1000) ;
Assert (Oct, 64) ;
Assert (Bin, 5) ;
Assert (Hex, 257) ;
Assert (HexTest, 16+10) ;
Assert (ByteMax, 255) ;
exit (code)
END constlitbase.