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>

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;