FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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>
This commit is contained in:
Gaius Mulley 2023-11-01 09:05:10 +00:00
parent 084ea7ea5a
commit 9693459e03
9 changed files with 93 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
gcc/m2/gm2-compiler/SymbolTable.mod
View file

@ -76,7 +76,7 @@ FROM M2Base IMPORT MixTypes, InitBase, Char, Integer, LongReal,
Cardinal, LongInt, LongCard, ZType, RType ;
FROM M2System IMPORT Address ;
FROM m2decl IMPORT ConstantStringExceedsZType ;
FROM m2expr IMPORT OverflowZType ;
FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT BuiltinsLocation ;
FROM StrLib IMPORT StrEqual ;
@ -6588,12 +6588,12 @@ BEGIN
loc := TokenToLocation (tok) ;
CASE char (s, -1) OF
'H': overflow := ConstantStringExceedsZType (loc, string (s), 16, issueError) |
'B': overflow := ConstantStringExceedsZType (loc, string (s), 8, issueError) |
'A': overflow := ConstantStringExceedsZType (loc, string (s), 2, issueError)
'H': overflow := OverflowZType (loc, string (s), 16, issueError) |
'B': overflow := OverflowZType (loc, string (s), 8, issueError) |
'A': overflow := OverflowZType (loc, string (s), 2, issueError)
ELSE
overflow := ConstantStringExceedsZType (loc, string (s), 10, issueError)
overflow := OverflowZType (loc, string (s), 10, issueError)
END ;
s := KillString (s) ;
RETURN ZType

31
gcc/m2/gm2-gcc/m2decl.cc
View file

@ -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);
}

9
gcc/m2/gm2-gcc/m2decl.def
View file

@ -160,15 +160,6 @@ PROCEDURE BuildEndFunctionDeclaration (location_begin, location_end: location_t;
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

3
gcc/m2/gm2-gcc/m2decl.h
View file

@ -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 (

66
gcc/m2/gm2-gcc/m2expr.cc
View file

@ -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

9
gcc/m2/gm2-gcc/m2expr.def
View file

@ -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.

2
gcc/m2/gm2-gcc/m2expr.h
View file

@ -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

2
gcc/testsuite/gm2/pim/fail/largeconst.mod
View file

File diff suppressed because one or more lines are too long

7
gcc/testsuite/gm2/pim/fail/largeconst2.mod
View file

@ -1,7 +0,0 @@
MODULE largeconst2 ;
CONST
foo = 123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789123456789123456789123456791234567891234567891234567891234567891234567912345678912345678912345678912345678912345679123456789123456789 ;
BEGIN
END largeconst2.