PR modula2/102989: reimplement overflow detection in ztype though WIDE_INT_MAX_PRECISION

The ZTYPE in iso modula2 is used to denote intemediate ordinal type const
expressions and these are always converted into the
approriate language or user ordinal type prior to code generation.
The increase of bits supported by _BitInt causes the modula2 largeconst.mod
regression failure tests to pass.  The largeconst.mod test has been
increased to fail, however the char at a time overflow check is now too slow
to detect failure.  The overflow detection for the ZTYPE has been
rewritten to check against exceeding WIDE_INT_MAX_PRECISION (many orders of
magnitude faster).

gcc/m2/ChangeLog:

	PR modula2/102989
	* gm2-compiler/SymbolTable.mod (OverflowZType): Import from m2expr.
	(ConstantStringExceedsZType): Remove import.
	(GetConstLitType): Replace ConstantStringExceedsZType with OverflowZType.
	* gm2-gcc/m2decl.cc (m2decl_ConstantStringExceedsZType): Remove.
	(m2decl_BuildConstLiteralNumber): Re-write.
	* gm2-gcc/m2decl.def (ConstantStringExceedsZType): Remove.
	* gm2-gcc/m2decl.h (m2decl_ConstantStringExceedsZType): Remove.
	* gm2-gcc/m2expr.cc (m2expr_StrToWideInt): Rewrite to check overflow.
	(m2expr_OverflowZType): New function.
	(ToWideInt): New function.
	* gm2-gcc/m2expr.def (OverflowZType): New procedure function declaration.
	* gm2-gcc/m2expr.h (m2expr_OverflowZType): New prototype.

gcc/testsuite/ChangeLog:

	PR modula2/102989
	* gm2/pim/fail/largeconst.mod: Updated foo to an outrageous value.
	* gm2/pim/fail/largeconst2.mod: Duplicate test removed.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

6 files changed, 87 insertions, 33 deletions

diff --git a/gcc/m2/gm2-gcc/m2decl.cc b/gcc/m2/gm2-gcc/m2decl.cc
index 535e3a6..24fff75 100644
--- a/gcc/m2/gm2-gcc/m2decl.cc
+++ b/gcc/m2/gm2-gcc/m2decl.cc
@@ -284,17 +284,6 @@ m2decl_DeclareModuleCtor (tree decl)
   return decl;
 }
 
-/* ConstantStringExceedsZType return TRUE if str cannot be represented in the ZTYPE.  */
-
-bool
-m2decl_ConstantStringExceedsZType (location_t location,
-				   const char *str, unsigned int base,
-				   bool issueError)
-{
-  widest_int wval;
-  return m2expr_StrToWideInt (location, str, base, wval, issueError);
-}
-
 /* BuildConstLiteralNumber - returns a GCC TREE built from the
    string, str.  It assumes that, str, represents a legal number in
    Modula-2.  It always returns a positive value.  */
@@ -305,12 +294,22 @@ m2decl_BuildConstLiteralNumber (location_t location, const char *str,
 {
   widest_int wval;
   tree value;
-  bool overflow = m2expr_StrToWideInt (location, str, base, wval, issueError);
-  value = wide_int_to_tree (m2type_GetM2ZType (), wval);
-
-  if (issueError && (overflow || m2expr_TreeOverflow (value)))
+  bool overflow = m2expr_OverflowZType (location, str, base, issueError);
+  if (overflow)
+    value = m2expr_GetIntegerZero (location);
+  else
+    {
+      overflow = m2expr_StrToWideInt (location, str, base, wval, issueError);
+      if (overflow)
+	value = m2expr_GetIntegerZero (location);
+      else
+	{
+	  value = wide_int_to_tree (m2type_GetM2ZType (), wval);
+	  overflow = m2expr_TreeOverflow (value);
+	}
+    }
+  if (issueError && overflow)
     error_at (location, "constant %qs is too large", str);
-
   return m2block_RememberConstant (value);
 }
 
diff --git a/gcc/m2/gm2-gcc/m2decl.def b/gcc/m2/gm2-gcc/m2decl.def
index 2fe4434..4bfeb15 100644
--- a/gcc/m2/gm2-gcc/m2decl.def
+++ b/gcc/m2/gm2-gcc/m2decl.def
@@ -161,15 +161,6 @@ PROCEDURE RememberVariables (l: Tree) ;
 
 
 (*
-   ConstantStringExceedsZType - return TRUE if str exceeds the ZTYPE range.
-*)
-
-PROCEDURE ConstantStringExceedsZType (location: location_t;
-                                      str: ADDRESS; base: CARDINAL;
-                                      issueError: BOOLEAN) : BOOLEAN ;
-
-
-(*
     BuildConstLiteralNumber - returns a GCC TREE built from the string, str.
                               It assumes that, str, represents a legal
                               number in Modula-2. It always returns a
diff --git a/gcc/m2/gm2-gcc/m2decl.h b/gcc/m2/gm2-gcc/m2decl.h
index 3756976..31e6bc7 100644
--- a/gcc/m2/gm2-gcc/m2decl.h
+++ b/gcc/m2/gm2-gcc/m2decl.h
@@ -51,9 +51,6 @@ EXTERN tree m2decl_BuildConstLiteralNumber (location_t location,
 					    const char *str,
                                             unsigned int base,
 					    bool issueError);
-EXTERN bool m2decl_ConstantStringExceedsZType (location_t location,
-					       const char *str, unsigned int base,
-					       bool issueError);
 EXTERN void m2decl_RememberVariables (tree l);
 
 EXTERN tree m2decl_BuildEndFunctionDeclaration (
diff --git a/gcc/m2/gm2-gcc/m2expr.cc b/gcc/m2/gm2-gcc/m2expr.cc
index bb56a57..a19aed5 100644
--- a/gcc/m2/gm2-gcc/m2expr.cc
+++ b/gcc/m2/gm2-gcc/m2expr.cc
@@ -40,6 +40,7 @@ along with GNU Modula-2; see the file COPYING3.  If not see
 #include "m2treelib.h"
 #include "m2type.h"
 #include "m2linemap.h"
+#include "math.h"
 
 static void m2expr_checkRealOverflow (location_t location, enum tree_code code,
                                       tree result);
@@ -3873,13 +3874,54 @@ m2expr_BuildBinaryForeachWordDo (location_t location, tree type, tree op1,
 }
 
 
-/* StrToWideInt return true if an overflow occurs when attempting to convert
-   str to an unsigned ZTYPE the value is contained in the widest_int result.
-   The value result is undefined if true is returned.  */
+/* OverflowZType returns true if the ZTYPE str will exceed the
+   internal representation.  This routine is much faster (at
+   least 2 orders of magnitude faster) than the char at a time overflow
+   detection used in ToWideInt and so it should be
+   used to filter out erroneously large constants before calling ToWideInt
+   allowing a quick fail.  */
 
 bool
-m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
-		     widest_int &result, bool issueError)
+m2expr_OverflowZType (location_t location, const char *str, unsigned int base,
+		      bool issueError)
+{
+  int length = strlen (str);
+  bool overflow = false;
+
+  switch (base)
+    {
+    case 2:
+      overflow = ((length -1) > WIDE_INT_MAX_PRECISION);
+      break;
+    case 8:
+      overflow = (((length -1) * 3) > WIDE_INT_MAX_PRECISION);
+      break;
+    case 10:
+      {
+	int str_log10 = length;
+	int bits_str = (int) (((float) (str_log10)) / log10f (2.0)) + 1;
+	overflow = (bits_str > WIDE_INT_MAX_PRECISION);
+      }
+      break;
+    case 16:
+      overflow = (((length -1) * 4) > WIDE_INT_MAX_PRECISION);
+      break;
+    default:
+      gcc_unreachable ();
+    }
+  if (issueError && overflow)
+    error_at (location,
+	      "constant literal %qs exceeds internal ZTYPE range", str);
+  return overflow;
+}
+
+
+/* ToWideInt converts a ZTYPE str value into result.  */
+
+static
+bool
+ToWideInt (location_t location, const char *str, unsigned int base,
+	   widest_int &result, bool issueError)
 {
   tree type = m2type_GetM2ZType ();
   unsigned int i = 0;
@@ -3990,6 +4032,20 @@ m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
 }
 
 
+/* StrToWideInt return true if an overflow occurs when attempting to convert
+   str to an unsigned ZTYPE the value is contained in the widest_int result.
+   The value result is undefined if true is returned.  */
+
+bool
+m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
+		     widest_int &result, bool issueError)
+{
+  if (m2expr_OverflowZType (location, str, base, issueError))
+    return true;
+  return ToWideInt (location, str, base, result, issueError);
+}
+
+
 /* GetSizeOfInBits return the number of bits used to contain, type.  */
 
 tree
diff --git a/gcc/m2/gm2-gcc/m2expr.def b/gcc/m2/gm2-gcc/m2expr.def
index e1ae799..e941d73 100644
--- a/gcc/m2/gm2-gcc/m2expr.def
+++ b/gcc/m2/gm2-gcc/m2expr.def
@@ -729,4 +729,13 @@ PROCEDURE BuildAddAddress (location: location_t; op1, op2: Tree) : Tree ;
 PROCEDURE calcNbits (location: location_t; min, max: Tree) : Tree ;
 
 
+(*
+   OverflowZType - return TRUE if str exceeds the ZTYPE range.
+*)
+
+PROCEDURE OverflowZType (location: location_t;
+                         str: ADDRESS; base: CARDINAL;
+                         issueError: BOOLEAN) : BOOLEAN ;
+
+
 END m2expr.
diff --git a/gcc/m2/gm2-gcc/m2expr.h b/gcc/m2/gm2-gcc/m2expr.h
index bf5e0b8..0eef3be 100644
--- a/gcc/m2/gm2-gcc/m2expr.h
+++ b/gcc/m2/gm2-gcc/m2expr.h
@@ -241,6 +241,8 @@ EXTERN tree m2expr_BuildRDiv (location_t location, tree op1, tree op2,
                               bool needconvert);
 EXTERN int m2expr_GetCstInteger (tree cst);
 EXTERN tree m2expr_calcNbits (location_t location, tree min, tree max);
+EXTERN bool m2expr_OverflowZType (location_t location, const char *str,
+				  unsigned int base, bool issueError);
 EXTERN void m2expr_init (location_t location);
 
 #undef EXTERN