public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-232] PR modula2/108121 Re-implement overflow detection for constant literals
@ 2023-04-26 1:57 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-04-26 1:57 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:68201409bc2867da45791331e385198826fa4576
commit r14-232-g68201409bc2867da45791331e385198826fa4576
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Wed Apr 26 02:55:59 2023 +0100
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 <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2ALU.mod | 20 +-
gcc/m2/gm2-compiler/SymbolTable.mod | 31 +--
gcc/m2/gm2-gcc/m2decl.cc | 48 +---
gcc/m2/gm2-gcc/m2decl.def | 10 +-
gcc/m2/gm2-gcc/m2decl.h | 8 +-
gcc/m2/gm2-gcc/m2expr.cc | 362 +++++++++--------------------
gcc/m2/gm2-gcc/m2expr.def | 4 +
gcc/m2/gm2-gcc/m2expr.h | 2 +
gcc/m2/gm2-gcc/m2type.cc | 19 +-
gcc/m2/gm2-lang.cc | 29 ++-
gcc/testsuite/gm2/pim/fail/largeconst.mod | 2 +-
gcc/testsuite/gm2/pim/fail/largeconst2.mod | 7 +
12 files changed, 188 insertions(+), 354 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod
index caa66fc42cc..ef3b934bccf 100644
--- a/gcc/m2/gm2-compiler/M2ALU.mod
+++ b/gcc/m2/gm2-compiler/M2ALU.mod
@@ -2119,18 +2119,18 @@ 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
@@ -2138,9 +2138,9 @@ BEGIN
END ;
(* result := (CompareTrees(v2^.numberValue, v1^.numberValue)=-1) *)
END ;
- Dispose(v1) ;
- Dispose(v2) ;
- RETURN( result )
+ Dispose (v1) ;
+ Dispose (v2) ;
+ RETURN result
END Less ;
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 2a68636a0bc..a37681c831f 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/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 ;
diff --git a/gcc/m2/gm2-gcc/m2decl.cc b/gcc/m2/gm2-gcc/m2decl.cc
index 6dde7a22ea5..535e3a63497 100644
--- a/gcc/m2/gm2-gcc/m2decl.cc
+++ b/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);
diff --git a/gcc/m2/gm2-gcc/m2decl.def b/gcc/m2/gm2-gcc/m2decl.def
index 314cba56353..2fe44341b85 100644
--- a/gcc/m2/gm2-gcc/m2decl.def
+++ b/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 ;
(*
diff --git a/gcc/m2/gm2-gcc/m2decl.h b/gcc/m2/gm2-gcc/m2decl.h
index 0efaab6a186..375697672c5 100644
--- a/gcc/m2/gm2-gcc/m2decl.h
+++ b/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 (
diff --git a/gcc/m2/gm2-gcc/m2expr.cc b/gcc/m2/gm2-gcc/m2expr.cc
index a319960aa33..e46d894d636 100644
--- a/gcc/m2/gm2-gcc/m2expr.cc
+++ b/gcc/m2/gm2-gcc/m2expr.cc
@@ -3855,273 +3855,123 @@ m2expr_BuildBinaryForeachWordDo (location_t location, tree type, tree op1,
}
}
-/* Append DIGIT to NUM, a number of PRECISION bits being read in base
- BASE. */
-static int
-append_digit (location_t location,
- unsigned HOST_WIDE_INT *low, HOST_WIDE_INT *high,
- unsigned int digit, unsigned int base)
-{
- unsigned int shift;
- int overflow;
- HOST_WIDE_INT add_high, res_high, test_high;
- unsigned HOST_WIDE_INT add_low, res_low, test_low;
-
- switch (base)
- {
-
- case 2:
- shift = 1;
- break;
- case 8:
- shift = 3;
- break;
- case 10:
- shift = 3;
- break;
- case 16:
- shift = 4;
- break;
-
- default:
- shift = 3;
- m2linemap_internal_error_at (location,
- "not expecting this base value for a constant");
- }
-
- /* Multiply by 2, 8 or 16. Catching this overflow here means we
- don't need to worry about add_high overflowing. */
- if (((*high) >> (INT_TYPE_SIZE - shift)) == 0)
- overflow = false;
- else
- overflow = true;
-
- res_high = *high << shift;
- res_low = *low << shift;
- res_high |= (*low) >> (INT_TYPE_SIZE - shift);
-
- if (base == 10)
- {
- add_low = (*low) << 1;
- add_high = ((*high) << 1) + ((*low) >> (INT_TYPE_SIZE - 1));
- }
- else
- add_high = add_low = 0;
-
- test_low = add_low + digit;
- if (test_low < add_low)
- add_high++;
- add_low += digit;
-
- test_low = res_low + add_low;
- if (test_low < res_low)
- add_high++;
- test_high = res_high + add_high;
- if (test_high < res_high)
- overflow = true;
-
- *low = res_low + add_low;
- *high = res_high + add_high;
-
- return overflow;
-}
-
-/* interpret_integer convert an integer constant into two integer
- constants. Heavily borrowed from gcc/cppexp.cc. */
-
-int
-m2expr_interpret_integer (location_t location, const char *str, unsigned int base,
- unsigned HOST_WIDE_INT *low, HOST_WIDE_INT *high)
-{
- unsigned const char *p, *end;
- int overflow = false;
- int len;
-
- *low = 0;
- *high = 0;
- p = (unsigned const char *)str;
- len = strlen (str);
- end = p + len;
-
- /* Common case of a single digit. */
- if (len == 1)
- *low = p[0] - '0';
- else
- {
- unsigned int c = 0;
-
- /* We can add a digit to numbers strictly less than this without
- needing the precision and slowness of double integers. */
-
- unsigned HOST_WIDE_INT max = ~(unsigned HOST_WIDE_INT)0;
- max = (max - base + 1) / base + 1;
-
- for (; p < end; p++)
- {
- c = *p;
-
- if (ISDIGIT (c) || (base == 16 && ISXDIGIT (c)))
- c = hex_value (c);
- else
- return overflow;
-
- /* Strict inequality for when max is set to zero. */
- if (*low < max)
- *low = (*low) * base + c;
- else
- {
- overflow = append_digit (location, low, high, c, base);
- max = 0; /* From now on we always use append_digit. */
- }
- }
- }
- return overflow;
-}
-
-/* Append DIGIT to NUM, a number of PRECISION bits being read in base
- 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. */
-static int
-append_m2_digit (location_t location,
- unsigned int *low, int *high, unsigned int digit,
- unsigned int base, bool *needsUnsigned)
-{
- unsigned int shift;
- bool overflow;
- int add_high, res_high, test_high;
- unsigned int add_low, res_low, test_low;
- unsigned int add_uhigh, res_uhigh, test_uhigh;
-
- switch (base)
+bool
+m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
+ widest_int &result, bool issueError)
+{
+ tree type = m2type_GetM2ZType ();
+ unsigned int i = 0;
+ wi::overflow_type overflow = wi::OVF_NONE;
+ widest_int wbase = wi::to_widest (m2decl_BuildIntegerConstant (base));
+ unsigned int digit = 0;
+ result = wi::to_widest (m2decl_BuildIntegerConstant (0));
+ bool base_specifier = false;
+
+ while (((str[i] != (char)0) && (overflow == wi::OVF_NONE))
+ && (! base_specifier))
{
-
- case 2:
- shift = 1;
- break;
- case 8:
- shift = 3;
- break;
- case 10:
- shift = 3;
- break;
- case 16:
- shift = 4;
- break;
-
- default:
- shift = 3;
- m2linemap_internal_error_at (location,
- "not expecting this base value for a constant");
+ char ch = str[i];
+
+ switch (base)
+ {
+ /* GNU m2 extension allows 'A' to represent binary literals. */
+ case 2:
+ if (ch == 'A')
+ base_specifier = true;
+ else if ((ch < '0') || (ch > '1'))
+ {
+ if (issueError)
+ error_at (location,
+ "constant literal %qs contains %qc, expected 0 or 1",
+ str, ch);
+ return true;
+ }
+ else
+ digit = (unsigned int) (ch - '0');
+ break;
+ case 8:
+ /* An extension of 'B' indicates octal ZTYPE and 'C' octal character. */
+ if ((ch == 'B') || (ch == 'C'))
+ base_specifier = true;
+ else if ((ch < '0') || (ch > '7'))
+ {
+ if (issueError)
+ error_at (location,
+ "constant literal %qs contains %qc, expected %qs",
+ str, ch, "0..7");
+ return true;
+ }
+ else
+ digit = (unsigned int) (ch - '0');
+ break;
+ case 10:
+ if ((ch < '0') || (ch > '9'))
+ {
+ if (issueError)
+ error_at (location,
+ "constant literal %qs contains %qc, expected %qs",
+ str, ch, "0..9");
+ return true;
+ }
+ else
+ digit = (unsigned int) (ch - '0');
+ break;
+ case 16:
+ /* An extension of 'H' indicates hexidecimal ZTYPE. */
+ if (ch == 'H')
+ base_specifier = true;
+ else if ((ch >= '0') && (ch <= '9'))
+ digit = (unsigned int) (ch - '0');
+ else if ((ch >= 'A') && (ch <= 'F'))
+ digit = ((unsigned int) (ch - 'A')) + 10;
+ else
+ {
+ if (issueError)
+ error_at (location,
+ "constant literal %qs contains %qc, expected %qs or %qs",
+ str, ch, "0..9", "A..F");
+ return true;
+ }
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ if (! base_specifier)
+ {
+ widest_int wdigit = wi::to_widest (m2decl_BuildIntegerConstant (digit));
+ result = wi::umul (result, wbase, &overflow);
+ if (overflow == wi::OVF_NONE)
+ result = wi::add (result, wdigit, UNSIGNED, &overflow);
+ }
+ i++;
}
-
- /* Multiply by 2, 8 or 16. Catching this overflow here means we
- don't need to worry about add_high overflowing. */
- if (((*high) >> (INT_TYPE_SIZE - shift)) == 0)
- overflow = false;
- else
- overflow = true;
-
- res_high = *high << shift;
- res_low = *low << shift;
- res_high |= (*low) >> (INT_TYPE_SIZE - shift);
-
- if (base == 10)
+ if (overflow == wi::OVF_NONE)
{
- add_low = (*low) << 1;
- add_high = ((*high) << 1) + ((*low) >> (INT_TYPE_SIZE - 1));
+ tree value = wide_int_to_tree (type, result);
+ if (m2expr_TreeOverflow (value))
+ {
+ if (issueError)
+ error_at (location,
+ "constant literal %qs exceeds internal ZTYPE range", str);
+ return true;
+ }
+ return false;
}
else
- add_high = add_low = 0;
-
- test_low = add_low + digit;
- if (test_low < add_low)
- add_high++;
- add_low += digit;
-
- test_low = res_low + add_low;
- if (test_low < res_low)
- add_high++;
- test_high = res_high + add_high;
- if (test_high < res_high)
{
- res_uhigh = res_high;
- add_uhigh = add_high;
- test_uhigh = res_uhigh + add_uhigh;
- if (test_uhigh < res_uhigh)
- overflow = true;
- else
- *needsUnsigned = true;
+ if (issueError)
+ error_at (location,
+ "constant literal %qs exceeds internal ZTYPE range", str);
+ return true;
}
-
- *low = res_low + add_low;
- *high = res_high + add_high;
-
- return overflow;
}
-/* interpret_m2_integer convert an integer constant into two integer
- constants. Heavily borrowed from gcc/cppexp.cc. Note that this is a
- copy of the above code except that it uses `int' rather than
- HOST_WIDE_INT to allow gm2 to determine what Modula-2 base type to
- use for this constant and it also sets needsLong and needsUnsigned
- if an overflow can be avoided by using these techniques. */
-
-int
-m2expr_interpret_m2_integer (location_t location,
- const char *str, unsigned int base,
- unsigned int *low, int *high,
- bool *needsLong, bool *needsUnsigned)
-{
- const unsigned char *p, *end;
- int len;
- *needsLong = false;
- *needsUnsigned = false;
-
- *low = 0;
- *high = 0;
- p = (unsigned const char *)str;
- len = strlen (str);
- end = p + len;
-
- /* Common case of a single digit. */
- if (len == 1)
- *low = p[0] - '0';
- else
- {
- unsigned int c = 0;
-
- /* We can add a digit to numbers strictly less than this without
- needing the precision and slowness of double integers. */
-
- unsigned int max = ~(unsigned int)0;
- max = (max - base + 1) / base + 1;
-
- for (; p < end; p++)
- {
- c = *p;
-
- if (ISDIGIT (c) || (base == 16 && ISXDIGIT (c)))
- c = hex_value (c);
- else
- return false; /* End of string and no overflow found. */
-
- /* Strict inequality for when max is set to zero. */
- if (*low < max)
- *low = (*low) * base + c;
- else
- {
- *needsLong = true;
- if (append_m2_digit (location,
- low, high, c, base,
- needsUnsigned))
- return true; /* We have overflowed so bail out. */
- max = 0; /* From now on we always use append_digit. */
- }
- }
- }
- return false;
-}
/* GetSizeOfInBits return the number of bits used to contain, type. */
diff --git a/gcc/m2/gm2-gcc/m2expr.def b/gcc/m2/gm2-gcc/m2expr.def
index cc80ded1547..83e281331c4 100644
--- a/gcc/m2/gm2-gcc/m2expr.def
+++ b/gcc/m2/gm2-gcc/m2expr.def
@@ -44,6 +44,10 @@ TYPE
PROCEDURE init (location: location_t) ;
+
+PROCEDURE CheckConstStrZtypeRange (location: location_t;
+ str: ADDRESS; base: CARDINAL) : BOOLEAN ;
+
(*
CompareTrees - returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2.
*)
diff --git a/gcc/m2/gm2-gcc/m2expr.h b/gcc/m2/gm2-gcc/m2expr.h
index 86e3bab1cde..40fc84685cf 100644
--- a/gcc/m2/gm2-gcc/m2expr.h
+++ b/gcc/m2/gm2-gcc/m2expr.h
@@ -35,6 +35,8 @@ along with GNU Modula-2; see the file COPYING3. If not see
#endif /* !__GNUG__. */
#endif /* !m2expr_c. */
+EXTERN bool m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
+ widest_int &wval, bool issueError);
EXTERN void m2expr_BuildBinaryForeachWordDo (
location_t location, tree type, tree op1, tree op2, tree op3,
tree (*binop) (location_t, tree, tree, bool), bool is_op1lvalue,
diff --git a/gcc/m2/gm2-gcc/m2type.cc b/gcc/m2/gm2-gcc/m2type.cc
index fb7e196fc8b..2808ddf8b8a 100644
--- a/gcc/m2/gm2-gcc/m2type.cc
+++ b/gcc/m2/gm2-gcc/m2type.cc
@@ -364,6 +364,7 @@ build_m2_word64_type_node (location_t location, int loc)
m2decl_BuildIntegerConstant (7), loc);
}
+
/* GetM2Complex32 return the fixed size complex type. */
tree
@@ -1474,6 +1475,22 @@ build_m2_long_real_node (void)
return c;
}
+static tree
+build_m2_ztype_node (void)
+{
+ tree ztype_node;
+
+ /* Define `ZTYPE'. */
+
+ if (targetm.scalar_mode_supported_p (TImode))
+ ztype_node = gm2_type_for_size (128, 0);
+ else
+ ztype_node = gm2_type_for_size (64, 0);
+ layout_type (ztype_node);
+
+ return ztype_node;
+}
+
static tree
build_m2_long_int_node (void)
{
@@ -1761,7 +1778,7 @@ m2type_InitBaseTypes (location_t location)
m2_long_card_type_node = build_m2_long_card_node ();
m2_short_int_type_node = build_m2_short_int_node ();
m2_short_card_type_node = build_m2_short_card_node ();
- m2_z_type_node = build_m2_long_int_node ();
+ m2_z_type_node = build_m2_ztype_node ();
m2_integer8_type_node = build_m2_integer8_type_node (location);
m2_integer16_type_node = build_m2_integer16_type_node (location);
m2_integer32_type_node = build_m2_integer32_type_node (location);
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index a1b32d8ecf3..fe52393d34d 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -1107,41 +1107,40 @@ gm2_mark_addressable (tree exp)
tree
gm2_type_for_size (unsigned int bits, int unsignedp)
{
- tree type;
-
if (unsignedp)
{
if (bits == INT_TYPE_SIZE)
- type = unsigned_type_node;
+ return unsigned_type_node;
else if (bits == CHAR_TYPE_SIZE)
- type = unsigned_char_type_node;
+ return unsigned_char_type_node;
else if (bits == SHORT_TYPE_SIZE)
- type = short_unsigned_type_node;
+ return short_unsigned_type_node;
else if (bits == LONG_TYPE_SIZE)
- type = long_unsigned_type_node;
+ return long_unsigned_type_node;
else if (bits == LONG_LONG_TYPE_SIZE)
- type = long_long_unsigned_type_node;
+ return long_long_unsigned_type_node;
else
- type = build_nonstandard_integer_type (bits,
+ return build_nonstandard_integer_type (bits,
unsignedp);
}
else
{
if (bits == INT_TYPE_SIZE)
- type = integer_type_node;
+ return integer_type_node;
else if (bits == CHAR_TYPE_SIZE)
- type = signed_char_type_node;
+ return signed_char_type_node;
else if (bits == SHORT_TYPE_SIZE)
- type = short_integer_type_node;
+ return short_integer_type_node;
else if (bits == LONG_TYPE_SIZE)
- type = long_integer_type_node;
+ return long_integer_type_node;
else if (bits == LONG_LONG_TYPE_SIZE)
- type = long_long_integer_type_node;
+ return long_long_integer_type_node;
else
- type = build_nonstandard_integer_type (bits,
+ return build_nonstandard_integer_type (bits,
unsignedp);
}
- return type;
+ /* Never reach here. */
+ gcc_unreachable ();
}
/* Allow the analyzer to understand Storage ALLOCATE/DEALLOCATE. */
diff --git a/gcc/testsuite/gm2/pim/fail/largeconst.mod b/gcc/testsuite/gm2/pim/fail/largeconst.mod
index fa59cf29d19..befb93eb2db 100644
--- a/gcc/testsuite/gm2/pim/fail/largeconst.mod
+++ b/gcc/testsuite/gm2/pim/fail/largeconst.mod
@@ -1,7 +1,7 @@
MODULE largeconst ;
CONST
- foo = 12345678912345678912345679123456789123456789 ;
+ foo = 12345678912345678912345679123456789123456789123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789 ;
BEGIN
END largeconst.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/fail/largeconst2.mod b/gcc/testsuite/gm2/pim/fail/largeconst2.mod
new file mode 100644
index 00000000000..f961388106a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/largeconst2.mod
@@ -0,0 +1,7 @@
+MODULE largeconst2 ;
+
+CONST
+ foo = 123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789 ;
+
+BEGIN
+END largeconst2.
\ No newline at end of file
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-04-26 1:57 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-04-26 1:57 [gcc r14-232] PR modula2/108121 Re-implement overflow detection for constant literals Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).