PR modula2/108121 Re-implement overflow detection for constant literals

This patch fixes the overflow detection for constant literals.
The ZTYPE is changed to int128 (or int64) if int128 is unavailable and
constant literals are built from widest_int.  The widest_int is converted
into the tree type and checked for overflow.
m2expr_interpret_integer and append_m2_digit are removed.

gcc/m2/ChangeLog:

	PR modula2/108121
	* gm2-compiler/M2ALU.mod (Less): Reformatted.
	* gm2-compiler/SymbolTable.mod (DetermineSizeOfConstant): Remove
	from import.
	(ConstantStringExceedsZType): Import.
	(GetConstLitType): Re-implement using ConstantStringExceedsZType.
	* gm2-gcc/m2decl.cc (m2decl_DetermineSizeOfConstant): Remove.
	(m2decl_ConstantStringExceedsZType): New function.
	(m2decl_BuildConstLiteralNumber): Re-implement.
	* gm2-gcc/m2decl.def (DetermineSizeOfConstant): Remove.
	(ConstantStringExceedsZType): New function.
	* gm2-gcc/m2decl.h (m2decl_DetermineSizeOfConstant): Remove.
	(m2decl_ConstantStringExceedsZType): New function.
	* gm2-gcc/m2expr.cc (append_digit): Remove.
	(m2expr_interpret_integer): Remove.
	(append_m2_digit): Remove.
	(m2expr_StrToWideInt): New function.
	(m2expr_interpret_m2_integer): Remove.
	* gm2-gcc/m2expr.def (CheckConstStrZtypeRange): New function.
	* gm2-gcc/m2expr.h (m2expr_StrToWideInt): New function.
	* gm2-gcc/m2type.cc (build_m2_word64_type_node): New function.
	(build_m2_ztype_node): New function.
	(m2type_InitBaseTypes): Call build_m2_ztype_node.
	* gm2-lang.cc (gm2_type_for_size): Re-write using early returns.

gcc/testsuite/ChangeLog:

	PR modula2/108121
	* gm2/pim/fail/largeconst.mod: Increased constant value test
	to fail now that cc1gm2 uses widest_int to represent a ZTYPE.
	* gm2/pim/fail/largeconst2.mod: New test.

Signed-off-by: Gaius Mulley <[email protected]>

gcc/m2/gm2-compiler/M2ALU.mod

@@ -2119,28 +2119,28 @@ VAR
    result: BOOLEAN ;
    res   : INTEGER ;
 BEGIN
-   v1 := Pop() ;
-   v2 := Pop() ;
-   IF (v1^.type=set) AND (v2^.type=set)
+   v1 := Pop () ;
+   v2 := Pop () ;
+   IF (v1^.type = set) AND (v2^.type = set)
    THEN
-      result := NOT IsSuperset(tokenno, v2, v1)
-   ELSIF (v1^.type=set) OR (v2^.type=set)
+      result := NOT IsSuperset (tokenno, v2, v1)
+   ELSIF (v1^.type = set) OR (v2^.type = set)
    THEN
       MetaErrorT0 (tokenno, 'cannot perform a comparison between a number and a set') ;
       result := FALSE
    ELSE
-      res := CompareTrees(v2^.numberValue, v1^.numberValue) ;
-      IF res=-1
+      res := CompareTrees (v2^.numberValue, v1^.numberValue) ;
+      IF res = -1
       THEN
          result := TRUE
       ELSE
          result := FALSE
       END ;
       (* result := (CompareTrees(v2^.numberValue, v1^.numberValue)=-1) *)
    END ;
-   Dispose(v1) ;
-   Dispose(v2) ;
-   RETURN( result )
+   Dispose (v1) ;
+   Dispose (v2) ;
+   RETURN result
 END Less ;
 
 

gcc/m2/gm2-compiler/SymbolTable.mod

@@ -76,7 +76,7 @@ FROM M2Base IMPORT MixTypes, InitBase, Char, Integer, LongReal,
                    Cardinal, LongInt, LongCard, ZType, RType ;
 
 FROM M2System IMPORT Address ;
-FROM m2decl IMPORT DetermineSizeOfConstant ;
+FROM m2decl IMPORT ConstantStringExceedsZType ;
 FROM m2tree IMPORT Tree ;
 FROM m2linemap IMPORT BuiltinsLocation ;
 FROM StrLib IMPORT StrEqual ;
@@ -819,7 +819,7 @@ TYPE
                SetSym              : Set              : SymSet |
                ProcedureSym        : Procedure        : SymProcedure |
                ProcTypeSym         : ProcType         : SymProcType |
-               ImportStatementSym        : ImportStatement        : SymImportStatement |
+               ImportStatementSym  : ImportStatement  : SymImportStatement |
                ImportSym           : Import           : SymImport |
                GnuAsmSym           : GnuAsm           : SymGnuAsm |
                InterfaceSym        : Interface        : SymInterface |
@@ -6376,10 +6376,8 @@ END IsHiddenType ;
 PROCEDURE GetConstLitType (tok: CARDINAL; name: Name;
                            VAR overflow: BOOLEAN; issueError: BOOLEAN) : CARDINAL ;
 VAR
-   loc          : location_t ;
-   s            : String ;
-   needsLong,
-   needsUnsigned: BOOLEAN ;
+   loc: location_t ;
+   s  : String ;
 BEGIN
    s := InitStringCharStar (KeyToCharStar (name)) ;
    IF char (s, -1) = 'C'
@@ -6395,27 +6393,14 @@ BEGIN
       loc := TokenToLocation (tok) ;
       CASE char (s, -1) OF
 
-      'H':  overflow := DetermineSizeOfConstant (loc, string (s), 16,
-                                                 needsLong, needsUnsigned, issueError) |
-      'B':  overflow := DetermineSizeOfConstant (loc, string (s), 8,
-                                                 needsLong, needsUnsigned, issueError) |
-      'A':  overflow := DetermineSizeOfConstant (loc, string (s), 2,
-                                                 needsLong, needsUnsigned, issueError)
+      'H':  overflow := ConstantStringExceedsZType (loc, string (s), 16, issueError) |
+      'B':  overflow := ConstantStringExceedsZType (loc, string (s), 8, issueError) |
+      'A':  overflow := ConstantStringExceedsZType (loc, string (s), 2, issueError)
 
       ELSE
-         overflow := DetermineSizeOfConstant (loc, string (s), 10,
-                                              needsLong, needsUnsigned, issueError)
+         overflow := ConstantStringExceedsZType (loc, string (s), 10, issueError)
       END ;
       s := KillString (s) ;
-(*
-      IF needsLong AND needsUnsigned
-      THEN
-         RETURN LongCard
-      ELSIF needsLong AND (NOT needsUnsigned)
-      THEN
-         RETURN LongInt
-      END ;
-*)
       RETURN ZType
    END
 END GetConstLitType ;

gcc/m2/gm2-gcc/m2decl.cc

@@ -284,23 +284,15 @@ m2decl_DeclareModuleCtor (tree decl)
   return decl;
 }
 
-/* DetermineSizeOfConstant - given, str, and, base, fill in needsLong
-   and needsUnsigned appropriately.  */
+/* ConstantStringExceedsZType return TRUE if str cannot be represented in the ZTYPE.  */
 
 bool
-m2decl_DetermineSizeOfConstant (location_t location,
-				const char *str, unsigned int base,
-                                bool *needsLong, bool *needsUnsigned,
-				bool issueError)
+m2decl_ConstantStringExceedsZType (location_t location,
+				   const char *str, unsigned int base,
+				   bool issueError)
 {
-  unsigned int ulow;
-  int high;
-  bool overflow = m2expr_interpret_m2_integer (location,
-					       str, base, &ulow, &high,
-					       needsLong, needsUnsigned);
-  if (overflow && issueError)
-    error_at (location, "constant %qs is too large", str);
-  return overflow;
+  widest_int wval;
+  return m2expr_StrToWideInt (location, str, base, wval, issueError);
 }
 
 /* BuildConstLiteralNumber - returns a GCC TREE built from the
@@ -311,30 +303,12 @@ tree
 m2decl_BuildConstLiteralNumber (location_t location, const char *str,
 				unsigned int base, bool issueError)
 {
-  tree value, type;
-  unsigned HOST_WIDE_INT low;
-  HOST_WIDE_INT high;
-  HOST_WIDE_INT ival[3];
-  bool overflow = m2expr_interpret_integer (location, str, base, &low, &high);
-  bool needLong, needUnsigned;
-
-  ival[0] = low;
-  ival[1] = high;
-  ival[2] = 0;
-
-  widest_int wval = widest_int::from_array (ival, 3);
-
-  bool overflow_m2 = m2decl_DetermineSizeOfConstant (location, str, base,
-						     &needLong, &needUnsigned,
-						     issueError);
-  if (needUnsigned && needLong)
-    type = m2type_GetM2LongCardType ();
-  else
-    type = m2type_GetM2LongIntType ();
-
-  value = wide_int_to_tree (type, wval);
+  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 || overflow_m2 || m2expr_TreeOverflow (value)))
+  if (issueError && (overflow || m2expr_TreeOverflow (value)))
     error_at (location, "constant %qs is too large", str);
 
   return m2block_RememberConstant (value);

gcc/m2/gm2-gcc/m2decl.def

@@ -161,14 +161,12 @@ PROCEDURE RememberVariables (l: Tree) ;
 
 
 (*
-    DetermineSizeOfConstant - given, str, and, base, fill in
-                              needsLong and needsUnsigned appropriately.
+   ConstantStringExceedsZType - return TRUE if str exceeds the ZTYPE range.
 *)
 
-PROCEDURE DetermineSizeOfConstant (location: location_t;
-                                   str: ADDRESS; base: CARDINAL;
-                                   VAR needsLong, needsUnsigned: BOOLEAN;
-                                   issueError: BOOLEAN) : BOOLEAN ;
+PROCEDURE ConstantStringExceedsZType (location: location_t;
+                                      str: ADDRESS; base: CARDINAL;
+                                      issueError: BOOLEAN) : BOOLEAN ;
 
 
 (*

gcc/m2/gm2-gcc/m2decl.h

@@ -51,11 +51,9 @@ EXTERN tree m2decl_BuildConstLiteralNumber (location_t location,
 					    const char *str,
                                             unsigned int base,
 					    bool issueError);
-EXTERN bool m2decl_DetermineSizeOfConstant (location_t location,
-					    const char *str, unsigned int base,
-                                            bool *needsLong,
-                                            bool *needsUnsigned,
-					    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 (