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>
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
END ;
(* result := (CompareTrees(v2^.numberValue, v1^.numberValue)=-1) *)
END ;
- Dispose(v1) ;
- Dispose(v2) ;
- RETURN( result )
+ Dispose (v1) ;
+ Dispose (v2) ;
+ RETURN result
END Less ;
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 ;
SetSym : Set : SymSet |
ProcedureSym : Procedure : SymProcedure |
ProcTypeSym : ProcType : SymProcType |
- ImportStatementSym : ImportStatement : SymImportStatement |
+ ImportStatementSym : ImportStatement : SymImportStatement |
ImportSym : Import : SymImport |
GnuAsmSym : GnuAsm : SymGnuAsm |
InterfaceSym : Interface : SymInterface |
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'
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 ;
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
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);
(*
- 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 ;
(*
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 (
}
}
-/* 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. */
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.
*)
#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,
m2decl_BuildIntegerConstant (7), loc);
}
+
/* GetM2Complex32 return the fixed size complex type. */
tree
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)
{
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);
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. */
MODULE largeconst ;
CONST
- foo = 12345678912345678912345679123456789123456789 ;
+ foo = 12345678912345678912345679123456789123456789123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789 ;
BEGIN
END largeconst.
\ No newline at end of file
--- /dev/null
+MODULE largeconst2 ;
+
+CONST
+ foo = 123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789 ;
+
+BEGIN
+END largeconst2.
\ No newline at end of file
projects / thirdparty / gcc.git / commitdiff
