diff options
author | Gaius Mulley <gaiusmod2@gmail.com> | 2024-04-16 23:08:43 +0100 |
---|---|---|
committer | Gaius Mulley <gaiusmod2@gmail.com> | 2024-04-16 23:08:43 +0100 |
commit | eadd05d5601063bd0c7ef6c3606b4eeb856d57d7 (patch) | |
tree | 530e99031bedeb9d7d36a0d2b5d3904a2fc08943 /gcc/m2 | |
parent | f438acf7ce2e6cb862cf62f2543c36639e2af233 (diff) | |
download | gcc-eadd05d5601063bd0c7ef6c3606b4eeb856d57d7.zip gcc-eadd05d5601063bd0c7ef6c3606b4eeb856d57d7.tar.gz gcc-eadd05d5601063bd0c7ef6c3606b4eeb856d57d7.tar.bz2 |
PR modula2/114745: const cast causes ICE
This patch allows SYSTEM.CAST to be used during a const expression and
prevents an ICE.
gcc/m2/ChangeLog:
PR modula2/114745
* gm2-compiler/M2Code.mod (DumpLangDecl): Replace with ...
(GetDumpDecl): ... this.
(DumpLangGimple): Replace with ...
(GetDumpGimple): ... this.
* gm2-compiler/M2GenGCC.mod:
* gm2-compiler/M2LangDump.mod (GetDumpLangQuadFilename): Replace with ...
(GetDumpQuadFilename): ... this.
(GetDumpLangDeclFilename): Replace with ...
(GetDumpDeclFilename): ... this.
(GetDumpLangGimpleFilename): Replace with ...
(GetDumpGimpleFilename): ... this.
* gm2-compiler/M2Options.def (GetDumpLangDeclFilename): New
procedure function.
(GetDumpDeclFilename): Ditto.
(SetDumpLangDeclFilename): New procedure.
(SetDumpDeclFilename): Ditto.
(GetDumpLangQuadFilename): New procedure function.
(GetDumpQuadFilename): Ditto
(SetDumpLangQuadFilename): New procedure.
(SetDumpQuadFilename): Ditto.
(GetDumpLangGimpleFilename): New procedure function.
(GetDumpGimpleFilename): Ditto.
(SetDumpLangGimpleFilename): New procedure.
(SetDumpGimpleFilename): Ditto.
(GetDumpLangGimple): New procedure function.
(SetM2Dump): New procedure.
(GetDumpGimple): New procedure function.
(GetDumpQuad): Ditto.
(GetDumpDecl): Ditto.
* gm2-compiler/M2Options.mod (DumpLangDeclFilename): Remove.
(DumpLangQuadFilename): Ditto.
(DumpLangGimpleFilename): Ditto.
(DumpDeclFilename): New variable.
(DumpQuadFilename): Ditto.
(DumpGimpleFilename): Ditto.
(DebugTraceTree): New variable.
(SetQuadDebugging): Rewrite.
(GetDumpLangDeclFilename): Replace with ...
(GetDumpDeclFilename): ... this.
(SetDumpLangQuadFilename): Replace with ...
(SetDumpQuadFilename): ... this.
(GetDumpLangGimpleFilename): Replace with ...
(GetDumpGimpleFilename): ... this.
(SetDumpLangGimpleFilename): Replace with ...
(SetDumpGimpleFilename): ... this.
(GetDumpLangGimple): Remove.
(MatchDump): New procedure function.
(SetM2Dump): New procedure.
(GetDumpGimple): New procedure function.
(GetDumpQuad): Ditto.
(GetDumpDecl): Ditto.
(GetDumpLangGimple): Ditto.
* gm2-compiler/M2Quads.mod (BreakAtQuad): Assigned to 140.
(BuildTypeCoercion): Add ConstExpr parameter.
Check for const parameter in a const expression.
Create a constant temporary if in a const expression.
(BuildCastFunction): Pass ConstExpr to BuildTypeCoercion.
(BuildFunctionCall): Pass ConstExpr to BuildTypeCoercion.
* gm2-compiler/PCSymBuild.mod (buildConstFunction): Test for Cast
and call InitConvert.
(ErrorConstFunction): Add CAST to the error message.
* gm2-compiler/SymbolTable.mod (GetConstStringContent): Remove
unused procedure.
* gm2-gcc/m2decl.cc (m2decl_DeclareKnownConstant): Copy value
and change type of value.
* gm2-gcc/m2options.h (M2Options_GetDumpLangDeclFilename): Remove.
(M2Options_SetDumpLangDeclFilename): Ditto.
(M2Options_GetDumpLangQuadFilename): Ditto.
(M2Options_SetDumpLangQuadFilename): Ditto.
(M2Options_GetDumpLangGimpleFilename): Ditto.
(M2Options_SetDumpLangGimpleFilename): Ditto.
(M2Options_GetDumpLangGimple): Ditto.
(M2Options_GetDumpDeclFilename): New function.
(M2Options_SetDumpDeclFilename): Ditto.
(M2Options_GetDumpQuadFilename): Ditto.
(M2Options_SetDumpQuadFilename): Ditto.
(M2Options_GetDumpGimpleFilename): Ditto.
(M2Options_SetDumpGimpleFilename): Ditto.
(M2Options_SetM2Dump): Ditto.
(M2Options_GetDumpGimple): Ditto.
* gm2-gcc/m2pp.cc (GM2): New define.
(m2pp_type_lowlevel): Remove linefeed.
(m2pp_identifier): Add type description for const.
(m2pp_assignment): Display lhs/rhs types.
(m2pp_dump_gimple): Replace GetDumpLangGimple with GetDumpGimple.
* gm2-lang.cc (ENABLE_QUAD_DUMP_ALL): Remove.
(ENABLE_M2DUMP_ALL): New define.
(gm2_langhook_handle_option): Remove commented options
OPT_fdump_lang_all, OPT_fdump_lang_decl_, OPT_fdump_lang_gimple,
OPT_fdump_lang_gimple_, OPT_fdump_lang_quad and
OPT_fdump_lang_quad_.
Add commented options OPT_fm2_dump_, OPT_fm2_dump_decl_,
OPT_fm2_dump_gimple_ and OPT_fm2_dump_quad_.
gcc/testsuite/ChangeLog:
PR modula2/114745
* gm2/iso/const/pass/constcast.mod: New test.
* gm2/iso/const/pass/constodd.mod: New test.
* gm2/pim/pass/tinyindr.mod: New test.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diffstat (limited to 'gcc/m2')
-rw-r--r-- | gcc/m2/gm2-compiler/M2Code.mod | 8 | ||||
-rw-r--r-- | gcc/m2/gm2-compiler/M2GenGCC.mod | 26 | ||||
-rw-r--r-- | gcc/m2/gm2-compiler/M2LangDump.mod | 10 | ||||
-rw-r--r-- | gcc/m2/gm2-compiler/M2Options.def | 52 | ||||
-rw-r--r-- | gcc/m2/gm2-compiler/M2Options.mod | 214 | ||||
-rw-r--r-- | gcc/m2/gm2-compiler/M2Quads.mod | 30 | ||||
-rw-r--r-- | gcc/m2/gm2-compiler/PCSymBuild.mod | 8 | ||||
-rw-r--r-- | gcc/m2/gm2-compiler/SymbolTable.mod | 21 | ||||
-rw-r--r-- | gcc/m2/gm2-gcc/m2decl.cc | 4 | ||||
-rw-r--r-- | gcc/m2/gm2-gcc/m2options.h | 15 | ||||
-rw-r--r-- | gcc/m2/gm2-gcc/m2pp.cc | 31 | ||||
-rw-r--r-- | gcc/m2/gm2-lang.cc | 40 |
12 files changed, 293 insertions, 166 deletions
diff --git a/gcc/m2/gm2-compiler/M2Code.mod b/gcc/m2/gm2-compiler/M2Code.mod index ea1126d..f8a773d 100644 --- a/gcc/m2/gm2-compiler/M2Code.mod +++ b/gcc/m2/gm2-compiler/M2Code.mod @@ -26,7 +26,7 @@ FROM SYSTEM IMPORT WORD ; FROM M2Options IMPORT Statistics, OptimizeUncalledProcedures, OptimizeCommonSubExpressions, StyleChecking, Optimizing, WholeProgram, - DumpLangDecl, DumpLangGimple ; + GetDumpDecl, GetDumpGimple ; FROM M2LangDump IMPORT CreateDumpDecl, CloseDumpDecl, MakeGimpleTemplate ; FROM M2Error IMPORT InternalError ; @@ -171,7 +171,7 @@ END RemoveUnreachableCode ; PROCEDURE DoModuleDeclare ; BEGIN - IF DumpLangDecl + IF GetDumpDecl () THEN CreateDumpDecl ("symbol resolver of filtered symbols\n") ; DumpFilteredResolver @@ -182,7 +182,7 @@ BEGIN ELSE StartDeclareScope (GetMainModule ()) END ; - IF DumpLangDecl + IF GetDumpDecl () THEN CloseDumpDecl ; CreateDumpDecl ("definitive declaration of filtered symbols\n") ; @@ -216,7 +216,7 @@ VAR filename: String ; len : CARDINAL ; BEGIN - IF DumpLangGimple + IF GetDumpGimple () THEN filename := MakeGimpleTemplate (len) ; CreateDumpGimple (filename, len) ; diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index a45d33e..da52c92 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -2950,9 +2950,11 @@ BEGIN virtpos := MakeVirtualTok (becomespos, despos, exprpos) ; CheckOrResetOverflow (exprpos, Mod2Gcc (des), MustCheckOverflow (quad)) ; AddModGcc (des, - DeclareKnownConstant (TokenToLocation (virtpos), - Mod2Gcc (GetType (expr)), - Mod2Gcc (expr))) + BuildConvert (TokenToLocation (virtpos), + Mod2Gcc (GetType (des)), + DeclareKnownConstant (TokenToLocation (virtpos), + Mod2Gcc (GetType (expr)), + Mod2Gcc (expr)), FALSE)) END END ; RemoveQuad (p, des, quad) ; @@ -5328,13 +5330,18 @@ BEGIN IF IsValueSolved (left) AND IsValueSolved (right) THEN (* We can take advantage of the known values and evaluate the condition. *) - PushValue (left) ; - PushValue (right) ; - IF Less (tokenno) + IF IsBooleanRelOpPattern (quad) THEN - PutQuad (quad, GotoOp, NulSym, NulSym, destQuad) + FoldBooleanRelopPattern (p, quad) ELSE - SubQuad (quad) + PushValue (left) ; + PushValue (right) ; + IF Less (tokenno) + THEN + PutQuad (quad, GotoOp, NulSym, NulSym, destQuad) + ELSE + SubQuad (quad) + END END ; NoChange := FALSE END @@ -7795,7 +7802,6 @@ PROCEDURE IsValidExpressionRelOp (quad: CARDINAL; isin: BOOLEAN) : BOOLEAN ; CONST Verbose = FALSE ; VAR - lefttype, righttype, left, right, dest, combined, leftpos, rightpos, destpos : CARDINAL ; constExpr, overflow : BOOLEAN ; @@ -7810,8 +7816,6 @@ BEGIN DeclareConstant (rightpos, right) ; DeclareConstructor (leftpos, quad, left) ; DeclareConstructor (rightpos, quad, right) ; - lefttype := GetType (left) ; - righttype := GetType (right) ; IF ExpressionTypeCompatible (combined, "", left, right, StrictTypeChecking, isin) THEN diff --git a/gcc/m2/gm2-compiler/M2LangDump.mod b/gcc/m2/gm2-compiler/M2LangDump.mod index 17fab86..ec3522b 100644 --- a/gcc/m2/gm2-compiler/M2LangDump.mod +++ b/gcc/m2/gm2-compiler/M2LangDump.mod @@ -40,8 +40,8 @@ FROM SymbolTable IMPORT NulSym, IsExported, IsPublic, IsExtern, IsMonoName, IsDefinitionForC ; -FROM M2Options IMPORT GetM2DumpFilter, GetDumpDir, GetDumpLangQuadFilename, - GetDumpLangDeclFilename, GetDumpLangGimpleFilename ; +FROM M2Options IMPORT GetM2DumpFilter, GetDumpDir, GetDumpQuadFilename, + GetDumpDeclFilename, GetDumpGimpleFilename ; FROM M2GCCDeclare IMPORT IncludeDumpSymbol ; FROM FormatStrings IMPORT Sprintf0, Sprintf1 ; @@ -751,7 +751,7 @@ END CreateTemplate ; PROCEDURE MakeQuadTemplate () : String ; BEGIN - RETURN CreateTemplate (GetDumpLangQuadFilename (), InitString ('quad')) + RETURN CreateTemplate (GetDumpQuadFilename (), InitString ('quad')) END MakeQuadTemplate ; @@ -761,7 +761,7 @@ END MakeQuadTemplate ; PROCEDURE MakeDeclTemplate () : String ; BEGIN - RETURN CreateTemplate (GetDumpLangDeclFilename (), InitString ('decl')) + RETURN CreateTemplate (GetDumpDeclFilename (), InitString ('decl')) END MakeDeclTemplate ; @@ -775,7 +775,7 @@ PROCEDURE MakeGimpleTemplate (VAR len: CARDINAL) : String ; VAR filename: String ; BEGIN - filename := CreateTemplate (GetDumpLangGimpleFilename (), InitString ('gimple')) ; + filename := CreateTemplate (GetDumpGimpleFilename (), InitString ('gimple')) ; len := Length (filename) ; (* This is a short cut based on '%03d' format specifier used above. *) RETURN filename diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def index 50504d0..a3d112c 100644 --- a/gcc/m2/gm2-compiler/M2Options.def +++ b/gcc/m2/gm2-compiler/M2Options.def @@ -53,9 +53,6 @@ VAR PedanticCast, (* -Wpedantic-cast warns if sizes differ. *) Statistics, (* -fstatistics information about code *) StyleChecking, (* -Wstudents checks for common student errs*) - DumpLangDecl, (* -fdump-lang-decl. *) - DumpLangGimple, (* -fdump-lang-gimple. *) - DumpLangQuad, (* -fq, -fdump-lang-quad dump quadruples. *) UnboundedByReference, (* -funbounded-by-reference *) VerboseUnbounded, (* -Wverbose-unbounded *) OptimizeUncalledProcedures, (* -Ouncalled removes uncalled procedures *) @@ -1004,45 +1001,45 @@ PROCEDURE GetIEEELongDouble () : BOOLEAN ; (* - GetDumpLangDeclFilename - returns the DumpLangDeclFilename. + GetDumpDeclFilename - returns the DumpLangDeclFilename. *) -PROCEDURE GetDumpLangDeclFilename () : String ; +PROCEDURE GetDumpDeclFilename () : String ; (* - SetDumpLangDeclFilename - set DumpLangDeclFilename to filename. + SetDumpDeclFilename - set DumpDeclFilename to filename. *) -PROCEDURE SetDumpLangDeclFilename (value: BOOLEAN; filename: ADDRESS) ; +PROCEDURE SetDumpDeclFilename (value: BOOLEAN; filename: ADDRESS) ; (* - GetDumpLangQuadFilename - returns the DumpLangQuadFilename. + GetDumpQuadFilename - returns the DumpQuadFilename. *) -PROCEDURE GetDumpLangQuadFilename () : String ; +PROCEDURE GetDumpQuadFilename () : String ; (* - SetDumpLangQuadFilename - set DumpLangQuadFilename to filename. + SetDumpQuadFilename - set DumpQuadFilename to filename. *) -PROCEDURE SetDumpLangQuadFilename (value: BOOLEAN; filename: ADDRESS) ; +PROCEDURE SetDumpQuadFilename (value: BOOLEAN; filename: ADDRESS) ; (* - GetDumpLangGimpleFilename - returns the DumpLangGimpleFilename. + GetDumpGimpleFilename - returns the DumpGimpleFilename. *) -PROCEDURE GetDumpLangGimpleFilename () : String ; +PROCEDURE GetDumpGimpleFilename () : String ; (* - SetDumpLangGimpleFilename - set DumpLangGimpleFilename to filename. + SetDumpGimpleFilename - set DumpGimpleFilename to filename. *) -PROCEDURE SetDumpLangGimpleFilename (value: BOOLEAN; filename: ADDRESS) ; +PROCEDURE SetDumpGimpleFilename (value: BOOLEAN; filename: ADDRESS) ; (* @@ -1061,10 +1058,31 @@ PROCEDURE GetM2DumpFilter () : ADDRESS ; (* - GetDumpLangGimple - return TRUE if -fdump-lang-gimple is set. + SetM2Dump - sets the dump via a comma separated list: quad,decl,gimple,all. *) -PROCEDURE GetDumpLangGimple () : BOOLEAN ; +PROCEDURE SetM2Dump (value: BOOLEAN; filter: ADDRESS) ; + + +(* + GetDumpGimple - return TRUE if the dump gimple flag is set from SetM2Dump. +*) + +PROCEDURE GetDumpGimple () : BOOLEAN ; + + +(* + GetDumpQuad - return TRUE if the dump quad flag is set from SetM2Dump. +*) + +PROCEDURE GetDumpQuad () : BOOLEAN ; + + +(* + GetDumpDecl - return TRUE if the dump quad flag is set from SetM2Dump. +*) + +PROCEDURE GetDumpDecl () : BOOLEAN ; (* diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod index d04cded..3b230dc 100644 --- a/gcc/m2/gm2-compiler/M2Options.mod +++ b/gcc/m2/gm2-compiler/M2Options.mod @@ -57,9 +57,10 @@ CONST DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ; VAR - DumpLangDeclFilename, - DumpLangQuadFilename, - DumpLangGimpleFilename, + DumpDeclFilename, + DumpQuadFilename, + DumpGimpleFilename, + M2Dump, M2DumpFilter, M2Prefix, M2PathName, @@ -76,10 +77,13 @@ VAR RuntimeModuleOverride, CppArgs : String ; DebugFunctionLineNumbers, - DebugTraceQuad, (* -fdebug-trace-quad. *) - DebugTraceTree, (* -fdebug-trace-tree. *) - DebugTraceLine, (* -fdebug-trace-line. *) - DebugTraceToken, (* -fdebug-trace-token. *) + DebugTraceQuad, (* -fm2-debug-trace=quad. *) + DebugTraceLine, (* -fm2-debug-trace=line. *) + DebugTraceToken, (* -fm2-debug-trace=token. *) + DebugTraceTree, (* -fm2-debug-trace=tree. (not yet implemented). *) + DumpDecl, (* -fm2-dump=decl. *) + DumpGimple, (* -fm2-dump=gimple. *) + DumpQuad, (* -fq, -fm2-dump=quad dump quadruples. *) MFlag, MMFlag, MPFlag, @@ -1085,9 +1089,9 @@ END SetSwig ; PROCEDURE SetQuadDebugging (value: BOOLEAN) ; BEGIN - DumpLangQuad := value ; - DumpLangQuadFilename := KillString (DumpLangQuadFilename) ; - DumpLangQuadFilename := InitString ('-') + DumpQuad := value ; + DumpQuadFilename := KillString (DumpQuadFilename) ; + DumpQuadFilename := InitString ('-') END SetQuadDebugging ; @@ -1140,7 +1144,7 @@ PROCEDURE SetM2DebugTrace (word: String; value: BOOLEAN) ; BEGIN IF EqualArray (word, 'all') THEN - (* DebugTraceTree := value *) + (* DebugTraceTree := value ; *) DebugTraceQuad := value ; DebugTraceToken := value ; DebugTraceLine := value @@ -1796,83 +1800,84 @@ END InitializeLongDoubleFlags ; (* - GetDumpLangDeclFilename - returns the DumpLangDeclFilename. + GetDumpDeclFilename - returns the DumpDeclFilename. *) -PROCEDURE GetDumpLangDeclFilename () : String ; +PROCEDURE GetDumpDeclFilename () : String ; BEGIN - RETURN DumpLangDeclFilename -END GetDumpLangDeclFilename ; + RETURN DumpDeclFilename +END GetDumpDeclFilename ; (* - SetDumpLangDeclFilename - + SetDumpDeclFilename - *) -PROCEDURE SetDumpLangDeclFilename (value: BOOLEAN; filename: ADDRESS) ; +PROCEDURE SetDumpDeclFilename (value: BOOLEAN; filename: ADDRESS) ; BEGIN - DumpLangDecl := value ; - DumpLangDeclFilename := KillString (DumpLangDeclFilename) ; + DumpDecl := value ; + DumpDeclFilename := KillString (DumpDeclFilename) ; IF filename # NIL THEN - DumpLangDeclFilename := InitStringCharStar (filename) + DumpDeclFilename := InitStringCharStar (filename) END -END SetDumpLangDeclFilename ; +END SetDumpDeclFilename ; (* - GetDumpLangQuadFilename - returns the DumpLangQuadFilename. + GetDumpQuadFilename - returns the DumpQuadFilename. *) -PROCEDURE GetDumpLangQuadFilename () : String ; +PROCEDURE GetDumpQuadFilename () : String ; BEGIN - RETURN DumpLangQuadFilename -END GetDumpLangQuadFilename ; + RETURN DumpQuadFilename +END GetDumpQuadFilename ; (* - SetDumpLangQuadFilename - + SetDumpQuadFilename - *) -PROCEDURE SetDumpLangQuadFilename (value: BOOLEAN; filename: ADDRESS) ; +PROCEDURE SetDumpQuadFilename (value: BOOLEAN; filename: ADDRESS) ; BEGIN - DumpLangQuad := value ; - DumpLangQuadFilename := KillString (DumpLangQuadFilename) ; + DumpQuad := value ; + DumpQuadFilename := KillString (DumpQuadFilename) ; IF filename # NIL THEN - DumpLangQuadFilename := InitStringCharStar (filename) + DumpQuadFilename := InitStringCharStar (filename) END -END SetDumpLangQuadFilename ; +END SetDumpQuadFilename ; (* - GetDumpLangGimpleFilename - returns the DumpLangGimpleFilename. + GetDumpGimpleFilename - returns the DumpGimpleFilename. *) -PROCEDURE GetDumpLangGimpleFilename () : String ; +PROCEDURE GetDumpGimpleFilename () : String ; BEGIN - RETURN DumpLangGimpleFilename -END GetDumpLangGimpleFilename ; + RETURN DumpGimpleFilename +END GetDumpGimpleFilename ; (* - SetDumpLangGimpleFilename - set DumpLangGimpleFilename to filename. + SetDumpGimpleFilename - set DumpGimpleFilename to filename. *) -PROCEDURE SetDumpLangGimpleFilename (value: BOOLEAN; filename: ADDRESS) ; +PROCEDURE SetDumpGimpleFilename (value: BOOLEAN; filename: ADDRESS) ; BEGIN - DumpLangGimple := value ; - DumpLangGimpleFilename := KillString (DumpLangGimpleFilename) ; + DumpGimple := value ; + DumpGimpleFilename := KillString (DumpGimpleFilename) ; IF value AND (filename # NIL) THEN - DumpLangGimpleFilename := InitStringCharStar (filename) + DumpGimpleFilename := InitStringCharStar (filename) END -END SetDumpLangGimpleFilename ; +END SetDumpGimpleFilename ; (* SetM2DumpFilter - sets the filter to a comma separated list of procedures - and modules. + and modules. Not to be confused with SetM2Dump below + which enables the class of data structures to be dumped. *) PROCEDURE SetM2DumpFilter (value: BOOLEAN; filter: ADDRESS) ; @@ -1901,13 +1906,115 @@ END GetM2DumpFilter ; (* - GetDumpLangGimple - return TRUE if -fdump-lang-gimple is set. + MatchDump - enable/disable dump using value. It returns TRUE if dump + is valid. *) -PROCEDURE GetDumpLangGimple () : BOOLEAN ; +PROCEDURE MatchDump (dump: String; value: BOOLEAN) : BOOLEAN ; BEGIN - RETURN DumpLangGimple -END GetDumpLangGimple ; + IF EqualArray (dump, 'all') + THEN + DumpDecl := value ; + DumpQuad := value ; + DumpGimple := value ; + RETURN TRUE + ELSIF EqualArray (dump, 'decl') + THEN + DumpDecl := value ; + RETURN TRUE + ELSIF EqualArray (dump, 'gimple') + THEN + DumpGimple := value ; + RETURN TRUE + ELSIF EqualArray (dump, 'quad') + THEN + DumpQuad := value ; + RETURN TRUE + END ; + RETURN FALSE +END MatchDump ; + + +(* + SetM2Dump - sets the dump via a comma separated list: quad,decl,gimple,all. + It returns TRUE if the comma separated list is valid. +*) + +PROCEDURE SetM2Dump (value: BOOLEAN; filter: ADDRESS) : BOOLEAN ; +VAR + result: BOOLEAN ; + dump : String ; + start, + i : INTEGER ; +BEGIN + IF filter = NIL + THEN + RETURN FALSE + END ; + IF M2Dump # NIL + THEN + M2Dump := KillString (M2Dump) + END ; + M2Dump := InitStringCharStar (filter) ; + start := 0 ; + REPEAT + i := Index (M2Dump, ',', start) ; + IF i = -1 + THEN + dump := Slice (M2Dump, start, 0) + ELSE + dump := Slice (M2Dump, start, i) + END ; + result := MatchDump (dump, value) ; + dump := KillString (dump) ; + IF NOT result + THEN + RETURN FALSE + END ; + start := i+1 ; + UNTIL i = -1 ; + RETURN TRUE +END SetM2Dump ; + + +(* + GetDumpGimple - return TRUE if the dump gimple flag is set from SetM2Dump. +*) + +PROCEDURE GetDumpGimple () : BOOLEAN ; +BEGIN + RETURN DumpGimple +END GetDumpGimple ; + + +(* + GetDumpQuad - return TRUE if the dump quad flag is set from SetM2Dump. +*) + +PROCEDURE GetDumpQuad () : BOOLEAN ; +BEGIN + RETURN DumpQuad +END GetDumpQuad ; + + +(* + GetDumpDecl - return TRUE if the dump decl flag is set from SetM2Dump. +*) + +PROCEDURE GetDumpDecl () : BOOLEAN ; +BEGIN + RETURN DumpDecl +END GetDumpDecl ; + + +(* + GetDumpLangGimple - return TRUE if the gimple flag is set from SetM2Dump. +*) + +PROCEDURE GetDumpGimple () : BOOLEAN ; +BEGIN + RETURN DumpGimple +END GetDumpGimple ; BEGIN @@ -1931,7 +2038,7 @@ BEGIN Quiet := TRUE ; CC1Quiet := TRUE ; Profiling := FALSE ; - DumpLangQuad := FALSE ; + DumpQuad := FALSE ; OptimizeBasicBlock := FALSE ; OptimizeUncalledProcedures := FALSE ; OptimizeCommonSubExpressions := FALSE ; @@ -1994,11 +2101,12 @@ BEGIN InitializeLongDoubleFlags ; M2Prefix := InitString ('') ; M2PathName := InitString ('') ; - DumpLangQuadFilename := NIL ; - DumpLangGimpleFilename := NIL ; - DumpLangDeclFilename := NIL ; - DumpLangDecl := FALSE ; - DumpLangQuad := FALSE ; - DumpLangGimple := FALSE ; + DumpQuadFilename := NIL ; + DumpGimpleFilename := NIL ; + DumpDeclFilename := NIL ; + DumpDecl := FALSE ; + DumpQuad := FALSE ; + DumpGimple := FALSE ; + M2Dump := NIL ; M2DumpFilter := NIL END M2Options. diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 17d7aab..68b9120 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -222,7 +222,7 @@ FROM M2Options IMPORT NilChecking, ScaffoldMain, SharedFlag, WholeProgram, GetDumpDir, GetM2DumpFilter, GetRuntimeModuleOverride, GetDebugTraceQuad, - DumpLangQuad ; + GetDumpQuad ; FROM M2LangDump IMPORT CreateDumpQuad, CloseDumpQuad, GetDumpFile ; FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ; @@ -276,7 +276,7 @@ IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ; CONST DebugStackOn = TRUE ; DebugVarients = FALSE ; - BreakAtQuad = 189 ; + BreakAtQuad = 140 ; DebugTokPos = FALSE ; TYPE @@ -7794,7 +7794,7 @@ BEGIN ELSIF IsAModula2Type (ProcSym) THEN ManipulatePseudoCallParameters ; - BuildTypeCoercion + BuildTypeCoercion (ConstExpr) ELSIF IsPseudoSystemFunction (ProcSym) OR IsPseudoBaseFunction (ProcSym) THEN @@ -7942,7 +7942,7 @@ END BuildConstFunctionCall ; differ. *) -PROCEDURE BuildTypeCoercion ; +PROCEDURE BuildTypeCoercion (ConstExpr: BOOLEAN) ; VAR resulttok, proctok, @@ -7964,18 +7964,24 @@ BEGIN THEN PopTrwtok (exp, r, exptok) ; MarkAsRead (r) ; - resulttok := MakeVirtualTok (proctok, proctok, exptok) ; - ReturnVar := MakeTemporary (resulttok, RightValue) ; - PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *) + resulttok := MakeVirtual2Tok (proctok, exptok) ; PopN (1) ; (* Pop procedure. *) - IF IsConst (exp) OR IsVar (exp) + IF ConstExprError (ProcSym, exp, exptok, ConstExpr) THEN + ReturnVar := MakeTemporary (resulttok, ImmediateValue) ; + PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *) + ELSIF IsConst (exp) OR IsVar (exp) + THEN + ReturnVar := MakeTemporary (resulttok, AreConstant (IsConst (exp))) ; + PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *) GenQuad (CoerceOp, ReturnVar, ProcSym, exp) ELSE MetaError2 ('trying to coerse {%1EMRad} which is not a variable or constant into {%2ad}', exp, ProcSym) ; MetaError2 ('trying to coerse {%1ECad} which is not a variable or constant into {%2ad}', - exp, ProcSym) + exp, ProcSym) ; + ReturnVar := MakeTemporary (resulttok, RightValue) ; + PutVar (ReturnVar, ProcSym) (* Set ReturnVar's TYPE. *) END ; PushTFtok (ReturnVar, ProcSym, resulttok) ELSE @@ -9632,7 +9638,7 @@ BEGIN PushTFtok (Type, NulSym, typetok) ; PushTtok (Exp, exptok) ; PushT (1) ; (* one parameter *) - BuildTypeCoercion + BuildTypeCoercion (ConstExpr) ELSIF IsVar (Exp) OR IsProcedure (Exp) THEN PopN (NoOfParam + 1) ; @@ -11737,7 +11743,7 @@ BEGIN Assert (GetSType (Sym) = Type) ; ti := calculateMultipicand (indexTok, Sym, Type, Dim) ; idx := OperandT (1) ; - IF IsConst (idx) + IF IsConst (idx) AND IsConst (ti) THEN (* tj has no type since constant *) tj := MakeTemporary (indexTok, ImmediateValue) ; @@ -13708,7 +13714,7 @@ END DumpQuadrupleAll ; PROCEDURE DumpQuadruples (title: ARRAY OF CHAR) ; BEGIN - IF DumpLangQuad + IF GetDumpQuad () THEN CreateDumpQuad (title) ; IF GetM2DumpFilter () = NIL diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod index 9a6e8c0..6d615b9 100644 --- a/gcc/m2/gm2-compiler/PCSymBuild.mod +++ b/gcc/m2/gm2-compiler/PCSymBuild.mod @@ -39,7 +39,7 @@ FROM M2Quads IMPORT PushT, PopT, OperandT, PopN, PopTF, PushTF, IsAutoPushOn, FROM M2Options IMPORT Iso ; FROM StdIO IMPORT Write ; -FROM M2System IMPORT IsPseudoSystemFunctionConstExpression ; +FROM M2System IMPORT Cast, IsPseudoSystemFunctionConstExpression ; FROM M2Base IMPORT MixTypes, ZType, RType, Char, Boolean, Val, Max, Min, Convert, @@ -1399,7 +1399,7 @@ BEGIN second := PopAddress (exprStack) ; first := PopAddress (exprStack) END ; - IF func=Val + IF (func=Val) OR (func=Cast) THEN InitConvert (cast, NulSym, first, second) ELSIF (func=Max) OR (func=Min) @@ -1424,7 +1424,7 @@ BEGIN IF Iso THEN ErrorFormat0 (NewError (functok), - 'the only functions permissible in a constant expression are: CAP, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins') + 'the only functions permissible in a constant expression are: CAP, CAST, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins') ELSE ErrorFormat0 (NewError (functok), 'the only functions permissible in a constant expression are: CAP, CHR, FLOAT, HIGH, MAX, MIN, ODD, ORD, SIZE, TSIZE, TRUNC, VAL and gcc builtins') @@ -1433,7 +1433,7 @@ BEGIN IF Iso THEN MetaErrorT1 (functok, - 'the only functions permissible in a constant expression are: CAP, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins, but not {%1Ead}', + 'the only functions permissible in a constant expression are: CAP, CAST, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins, but not {%1Ead}', func) ELSE MetaErrorT1 (functok, diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod index fc1cb74..13ee1fb 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.mod +++ b/gcc/m2/gm2-compiler/SymbolTable.mod @@ -5083,27 +5083,6 @@ END InitConstString ; (* - GetConstString - returns the contents of a string constant. -*) - -PROCEDURE GetConstStringContent (sym: CARDINAL) : Name ; -VAR - pSym: PtrToSymbol ; -BEGIN - pSym := GetPsym (sym) ; - WITH pSym^ DO - CASE SymbolType OF - - ConstStringSym: RETURN ConstString.Contents - - ELSE - InternalError ('expecting ConstStringSym') - END - END -END GetConstStringContent ; - - -(* IsConstStringNulTerminated - returns TRUE if the constant string, sym, should be created with a nul terminator. *) diff --git a/gcc/m2/gm2-gcc/m2decl.cc b/gcc/m2/gm2-gcc/m2decl.cc index 2dd2806..d8a2bc8 100644 --- a/gcc/m2/gm2-gcc/m2decl.cc +++ b/gcc/m2/gm2-gcc/m2decl.cc @@ -152,11 +152,11 @@ m2decl_DeclareKnownConstant (location_t location, tree type, tree value) decl = build_decl (location, CONST_DECL, id, type); + value = copy_node (value); + TREE_TYPE (value) = type; DECL_INITIAL (decl) = value; TREE_TYPE (decl) = type; - decl = m2block_global_constant (decl); - return decl; } diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h index 363b260..bf07773 100644 --- a/gcc/m2/gm2-gcc/m2options.h +++ b/gcc/m2/gm2-gcc/m2options.h @@ -155,16 +155,17 @@ EXTERN void M2Options_SetIBMLongDouble (bool value); EXTERN bool M2Options_GetIBMLongDouble (void); EXTERN void M2Options_SetIEEELongDouble (bool value); EXTERN bool M2Options_GetIEEELongDouble (void); -EXTERN bool M2Options_GetDumpLangDeclFilename (void); -EXTERN void M2Options_SetDumpLangDeclFilename (bool value, const char *arg); -EXTERN bool M2Options_GetDumpLangQuadFilename (void); -EXTERN void M2Options_SetDumpLangQuadFilename (bool value, const char *arg); -EXTERN bool M2Options_GetDumpLangGimpleFilename (void); -EXTERN void M2Options_SetDumpLangGimpleFilename (bool value, const char *arg); -EXTERN bool M2Options_GetDumpLangGimple (void); +EXTERN bool M2Options_GetDumpDeclFilename (void); +EXTERN void M2Options_SetDumpDeclFilename (bool value, const char *arg); +EXTERN bool M2Options_GetDumpQuadFilename (void); +EXTERN void M2Options_SetDumpQuadFilename (bool value, const char *arg); +EXTERN bool M2Options_GetDumpGimpleFilename (void); +EXTERN void M2Options_SetDumpGimpleFilename (bool value, const char *arg); EXTERN void M2Options_SetM2DumpFilter (bool value, const char *args); EXTERN char *M2Options_GetM2DumpFilter (void); EXTERN void M2Options_SetM2DebugTraceFilter (bool value, const char *arg); +EXTERN bool M2Options_SetM2Dump (bool value, const char *arg); +EXTERN bool M2Options_GetDumpGimple (void); #undef EXTERN #endif /* m2options_h. */ diff --git a/gcc/m2/gm2-gcc/m2pp.cc b/gcc/m2/gm2-gcc/m2pp.cc index de80158..ce004b7 100644 --- a/gcc/m2/gm2-gcc/m2pp.cc +++ b/gcc/m2/gm2-gcc/m2pp.cc @@ -34,6 +34,8 @@ along with GNU Modula-2; see the file COPYING3. If not see #define M2PP_C #include "m2pp.h" +#define GM2 + const char *m2pp_dump_description[M2PP_DUMP_END] = { "interactive user invoked output", @@ -526,9 +528,9 @@ m2pp_type_lowlevel (pretty *s, tree t) m2pp_needspace (s); if (TYPE_UNSIGNED (t)) - m2pp_print (s, "unsigned\n"); + m2pp_print (s, "unsigned"); else - m2pp_print (s, "signed\n"); + m2pp_print (s, "signed"); } } @@ -896,6 +898,19 @@ m2pp_identifier (pretty *s, tree t) else snprintf (name, 100, "D_%u", DECL_UID (t)); m2pp_print (s, name); + if (TREE_TYPE (t) != NULL_TREE) + { + m2pp_needspace (s); + m2pp_print (s, "(* type:"); + m2pp_needspace (s); + m2pp_simple_type (s, TREE_TYPE (t)); + m2pp_needspace (s); +#if 0 + m2pp_type_lowlevel (s, TREE_TYPE (t)); + m2pp_needspace (s); +#endif + m2pp_print (s, "*)"); + } } } } @@ -2554,6 +2569,16 @@ m2pp_assignment (pretty *s, tree t) int o; m2pp_begin (s); + + /* Print the types of des and expr. */ + m2pp_type (s, TREE_TYPE (TREE_OPERAND (t, 0))); + m2pp_needspace (s); + m2pp_print (s, ":="); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (TREE_OPERAND (t, 1))); + m2pp_needspace (s); + m2pp_print (s, ";\n"); + /* Print the assignment statement. */ m2pp_designator (s, TREE_OPERAND (t, 0)); m2pp_needspace (s); m2pp_print (s, ":="); @@ -2818,7 +2843,7 @@ m2pp_dump_gimple_pretty (m2pp_dump_kind kind, tree fndecl) void m2pp_dump_gimple (m2pp_dump_kind kind, tree fndecl) { - if (M2Options_GetDumpLangGimple () + if (M2Options_GetDumpGimple () && M2LangDump_IsDumpRequiredTree (fndecl, true)) m2pp_dump_gimple_pretty (kind, fndecl); } diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc index f7ab8b8..e31a6c4 100644 --- a/gcc/m2/gm2-lang.cc +++ b/gcc/m2/gm2-lang.cc @@ -42,7 +42,7 @@ Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #include "convert.h" #include "rtegraph.h" -#undef ENABLE_QUAD_DUMP_ALL +#undef ENABLE_M2DUMP_ALL static void write_globals (void); @@ -478,31 +478,6 @@ gm2_langhook_handle_option ( case OPT_fdebug_function_line_numbers: M2Options_SetDebugFunctionLineNumbers (value); return 1; -#ifdef ENABLE_QUAD_DUMP_ALL - case OPT_fdump_lang_all: - M2Options_SetDumpLangDeclFilename (value, NULL); - M2Options_SetDumpLangGimpleFilename (value, NULL); - M2Options_SetDumpLangQuadFilename (value, NULL); - return 1; - case OPT_fdump_lang_decl: - M2Options_SetDumpLangDeclFilename (value, NULL); - return 1; - case OPT_fdump_lang_decl_: - M2Options_SetDumpLangDeclFilename (value, arg); - return 1; - case OPT_fdump_lang_gimple: - M2Options_SetDumpLangGimpleFilename (value, NULL); - return 1; - case OPT_fdump_lang_gimple_: - M2Options_SetDumpLangGimpleFilename (value, arg); - return 1; - case OPT_fdump_lang_quad: - M2Options_SetDumpLangQuadFilename (value, NULL); - return 1; - case OPT_fdump_lang_quad_: - M2Options_SetDumpLangQuadFilename (value, arg); - return 1; -#endif case OPT_fauto_init: M2Options_SetAutoInit (value); return 1; @@ -546,7 +521,18 @@ gm2_langhook_handle_option ( case OPT_fm2_debug_trace_: M2Options_SetM2DebugTraceFilter (value, arg); return 1; -#ifdef ENABLE_QUAD_DUMP_ALL +#ifdef ENABLE_M2DUMP_ALL + case OPT_fm2_dump_: + return M2Options_SetM2Dump (value, arg); + case OPT_fm2_dump_decl_: + M2Options_SetDumpDeclFilename (value, arg); + return 1; + case OPT_fm2_dump_gimple_: + M2Options_SetDumpGimpleFilename (value, arg); + return 1; + case OPT_fm2_dump_quad_: + M2Options_SetDumpQuadFilename (value, arg); + return 1; case OPT_fm2_dump_filter_: M2Options_SetM2DumpFilter (value, arg); return 1; |