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>
This commit is contained in:
Gaius Mulley
parent
49cea02d8b
commit
68201409bc
12 changed files with 187 additions and 353 deletions
|
|
@ -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 ;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
widest_int wval;
|
||||
tree value;
|
||||
bool overflow = m2expr_StrToWideInt (location, str, base, wval, issueError);
|
||||
value = wide_int_to_tree (m2type_GetM2ZType (), wval);
|
||||
|
||||
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);
|
||||
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
||||
(*
|
||||
|
|
|
|||
|
|
@ -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 (
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
/* 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)
|
||||
{
|
||||
unsigned int shift;
|
||||
int overflow;
|
||||
HOST_WIDE_INT add_high, res_high, test_high;
|
||||
unsigned HOST_WIDE_INT add_low, res_low, test_low;
|
||||
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;
|
||||
|
||||
switch (base)
|
||||
while (((str[i] != (char)0) && (overflow == wi::OVF_NONE))
|
||||
&& (! base_specifier))
|
||||
{
|
||||
char ch = str[i];
|
||||
|
||||
case 2:
|
||||
shift = 1;
|
||||
break;
|
||||
case 8:
|
||||
shift = 3;
|
||||
break;
|
||||
case 10:
|
||||
shift = 3;
|
||||
break;
|
||||
case 16:
|
||||
shift = 4;
|
||||
break;
|
||||
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 ();
|
||||
}
|
||||
|
||||
default:
|
||||
shift = 3;
|
||||
m2linemap_internal_error_at (location,
|
||||
"not expecting this base value for a constant");
|
||||
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)
|
||||
overflow = true;
|
||||
|
||||
*low = res_low + add_low;
|
||||
*high = res_high + add_high;
|
||||
|
||||
return overflow;
|
||||
{
|
||||
if (issueError)
|
||||
error_at (location,
|
||||
"constant literal %qs exceeds internal ZTYPE range", str);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
/* 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. */
|
||||
|
||||
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)
|
||||
{
|
||||
|
||||
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)
|
||||
{
|
||||
res_uhigh = res_high;
|
||||
add_uhigh = add_high;
|
||||
test_uhigh = res_uhigh + add_uhigh;
|
||||
if (test_uhigh < res_uhigh)
|
||||
overflow = true;
|
||||
else
|
||||
*needsUnsigned = 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. */
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
MODULE largeconst ;
|
||||
|
||||
CONST
|
||||
foo = 12345678912345678912345679123456789123456789 ;
|
||||
foo = 12345678912345678912345679123456789123456789123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789 ;
|
||||
|
||||
BEGIN
|
||||
END largeconst.
|
||||
7
gcc/testsuite/gm2/pim/fail/largeconst2.mod
Normal file
7
gcc/testsuite/gm2/pim/fail/largeconst2.mod
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
MODULE largeconst2 ;
|
||||
|
||||
CONST
|
||||
foo = 123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789 ;
|
||||
|
||||
BEGIN
|
||||
END largeconst2.
|
||||
Loading…
Add table
Reference in a new issue