https://gcc.gnu.org/g:eadd05d5601063bd0c7ef6c3606b4eeb856d57d7
commit r14-9998-geadd05d5601063bd0c7ef6c3606b4eeb856d57d7
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Tue Apr 16 23:08:43 2024 +0100
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 <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Code.mod | 8 +-
gcc/m2/gm2-compiler/M2GenGCC.mod | 26 +--
gcc/m2/gm2-compiler/M2LangDump.mod | 10 +-
gcc/m2/gm2-compiler/M2Options.def | 52 ++++--
gcc/m2/gm2-compiler/M2Options.mod | 214 +++++++++++++++++++------
gcc/m2/gm2-compiler/M2Quads.mod | 30 ++--
gcc/m2/gm2-compiler/PCSymBuild.mod | 8 +-
gcc/m2/gm2-compiler/SymbolTable.mod | 21 ---
gcc/m2/gm2-gcc/m2decl.cc | 4 +-
gcc/m2/gm2-gcc/m2options.h | 15 +-
gcc/m2/gm2-gcc/m2pp.cc | 31 +++-
gcc/m2/gm2-lang.cc | 40 ++---
gcc/testsuite/gm2/iso/const/pass/constcast.mod | 8 +
gcc/testsuite/gm2/iso/const/pass/constodd.mod | 16 ++
gcc/testsuite/gm2/pim/pass/tinyindr.mod | 24 +++
15 files changed, 341 insertions(+), 166 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Code.mod b/gcc/m2/gm2-compiler/M2Code.mod
index ea1126d756e..f8a773dc103 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 a45d33ef89e..da52c924974 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 17fab86bc0b..ec3522b62dd 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 50504d088b6..a3d112c0cdf 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 d04cded17f0..3b230dc3fd5 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 17d7aabc10a..68b91201702 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 9a6e8c06e70..6d615b9a311 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 fc1cb74c866..13ee1fb6fe3 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -5082,27 +5082,6 @@ BEGIN
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 2dd28067a3d..d8a2bc898d0 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 363b2605e9e..bf077735797 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 de8015864e3..ce004b771a6 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 f7ab8b807d3..e31a6c437ec 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;
diff --git a/gcc/testsuite/gm2/iso/const/pass/constcast.mod
b/gcc/testsuite/gm2/iso/const/pass/constcast.mod
new file mode 100644
index 00000000000..21ffd47b44b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/const/pass/constcast.mod
@@ -0,0 +1,8 @@
+MODULE constcast ;
+
+FROM SYSTEM IMPORT CAST ;
+
+CONST Nil = CAST (PROC, NIL) ;
+
+BEGIN
+END constcast.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/const/pass/constodd.mod
b/gcc/testsuite/gm2/iso/const/pass/constodd.mod
new file mode 100644
index 00000000000..58f5be8bad7
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/const/pass/constodd.mod
@@ -0,0 +1,16 @@
+MODULE constodd ;
+
+FROM libc IMPORT printf, exit ;
+
+CONST
+ IsOdd = ODD (1) AND (2 > 1) ;
+
+BEGIN
+ IF IsOdd
+ THEN
+ printf ("success\n");
+ ELSE
+ printf ("failure\n");
+ exit (1)
+ END
+END constodd.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyindr.mod
b/gcc/testsuite/gm2/pim/pass/tinyindr.mod
new file mode 100644
index 00000000000..c606e494ef2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyindr.mod
@@ -0,0 +1,24 @@
+MODULE tinyindr ;
+
+FROM SYSTEM IMPORT WORD, BYTE ;
+
+TYPE
+ File = RECORD
+ lastWord: WORD ;
+ lastByte: BYTE ;
+ END ;
+
+PROCEDURE Create (VAR f: File) ;
+BEGIN
+ WITH f DO
+ lastWord := WORD (0) ;
+ lastByte := BYTE (0)
+ END
+END Create ;
+
+
+VAR
+ foo: File ;
+BEGIN
+ Create (foo)
+END tinyindr.
