public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-6649] PR 109103 Modula2 Missing function internal_error_at
@ 2023-03-13 23:03 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-03-13 23:03 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:370298f493020eeff48bc2e56463c1097ed67b1d
commit r13-6649-g370298f493020eeff48bc2e56463c1097ed67b1d
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Mon Mar 13 23:03:24 2023 +0000
PR 109103 Modula2 Missing function internal_error_at
m2expr.cc should call to internal_error_at, but that function
does not exist yet. For symmetry with the other error reporting
functions, it should be added. This patch provides this function
and also corrects obvious bool/int parameter mismatches in
m2options.h and m2expr.h.
gcc/m2/ChangeLog:
PR modula2/109103
* gm2-compiler/M2ALU.def (PushString): New parameter issueError.
* gm2-compiler/M2ALU.mod (PushString): New parameter issueError.
* gm2-compiler/SymbolTable.mod (PushString): New parameter issueError.
* gm2-gcc/m2decl.cc (m2decl_DetermineSizeOfConstant): Pass
location to interpret_m2_integer.
(m2decl_BuildConstLiteralNumber): New parameter issueError.
* gm2-gcc/m2expr.cc (m2expr_IsTrue): Replace int with bool.
(m2expr_IsFalse): Replace int with bool.
(m2expr_AreConstantsEqual): Replace int with bool.
(m2expr_BuildBinaryForeachWordDo): Call m2linemap_internal_error_at.
(append_digit): Ditto.
(m2expr_interpret_integer): Add location parameter.
(append_m2_digit): Call m2linemap_internal_error_at.
(m2expr_interpret_m2_integer): Add location parameter.
(m2expr_GetSizeOf): Replace sizeof with SIZE in error message.
* gm2-gcc/m2expr.h (m2expr_AreRealOrComplexConstantsEqual):
Replace int with bool.
(m2expr_AreConstantsEqual): Ditto.
(m2expr_IsFalse): Ditto.
(m2expr_IsTrue): Ditto.
(m2expr_interpret_integer): Add location parameter.
(m2expr_interpret_m2_integer): Add location parameter.
* gm2-gcc/m2linemap.cc (mformat_value): New function.
(expand_format): New function.
(expand_message): New function.
(gm2_internal_error_at): New function.
(m2linemap_internal_error_at): New function.
* gm2-gcc/m2linemap.h (m2linemap_internal_error_at): New function.
* gm2-gcc/m2options.h (M2Options_SetISO): Replace int with bool.
(M2Options_SetPIM): Ditto.
(M2Options_SetPIM2): Ditto.
(M2Options_SetPIM3): Ditto.
(M2Options_SetPIM4): Ditto.
(M2Options_SetFloatValueCheck): Ditto.
(M2Options_SetWholeValueCheck): Ditto.
(M2Options_GetISO): Ditto.
(M2Options_GetPIM): Ditto.
(M2Options_GetPIM2): Ditto.
(M2Options_GetPIM3): Ditto.
(M2Options_GetPIM4): Ditto.
(M2Options_GetPositiveModFloor): Ditto.
(M2Options_GetFloatValueCheck): Ditto.
(M2Options_GetWholeValueCheck): Ditto.
(M2Options_Setc): Ditto.
(M2Options_Getc): Ditto.
(M2Options_SetPPOnly): Ditto.
(M2Options_GetPPOnly): Ditto.
(M2Options_SetUselist): Ditto.
(M2Options_SetAutoInit): Ditto.
(M2Options_SetPositiveModFloor): Ditto.
(M2Options_SetNilCheck): Ditto.
(M2Options_SetWholeDiv): Ditto.
(M2Options_SetIndex): Ditto.
(M2Options_SetRange): Ditto.
(M2Options_SetReturnCheck): Ditto.
(M2Options_SetCaseCheck): Ditto.
(M2Options_SetCheckAll): Ditto.
(M2Options_SetExceptions): Ditto.
(M2Options_SetStyle): Ditto.
(M2Options_SetPedantic): Ditto.
(M2Options_SetPedanticParamNames): Ditto.
(M2Options_SetPedanticCast): Ditto.
(M2Options_SetExtendedOpaque): Ditto.
(M2Options_SetVerboseUnbounded): Ditto.
(M2Options_SetXCode): Ditto.
(M2Options_SetCompilerDebugging): Ditto.
(M2Options_SetQuadDebugging): Ditto.
(M2Options_SetDebugTraceQuad): Ditto.
(M2Options_SetDebugTraceAPI): Ditto.
(M2Options_SetSources): Ditto.
(M2Options_SetUnboundedByReference): Ditto.
(M2Options_SetDumpSystemExports): Ditto.
(M2Options_SetOptimizing): Ditto.
(M2Options_SetQuiet): Ditto.
(M2Options_SetCC1Quiet): Ditto.
(M2Options_SetCpp): Ditto.
(M2Options_SetSwig): Ditto.
(M2Options_SetWholeProgram): Ditto.
(M2Options_SetDebugFunctionLineNumbers): Ditto.
(M2Options_SetGenerateStatementNote): Ditto.
(M2Options_GetCpp): Ditto.
(M2Options_GetM2g): Ditto.
(M2Options_SetM2g): Ditto.
(M2Options_SetLowerCaseKeywords): Ditto.
(M2Options_SetVerbose): Ditto.
(M2Options_SetUnusedVariableChecking): Ditto.
(M2Options_SetUnusedParameterChecking): Ditto.
(M2Options_SetStrictTypeChecking): Ditto.
(M2Options_SetWall): Ditto.
(M2Options_SetSaveTemps): Ditto.
(M2Options_GetSaveTemps): Ditto.
(M2Options_SetScaffoldStatic): Ditto.
(M2Options_SetScaffoldDynamic): Ditto.
(M2Options_SetScaffoldMain): Ditto.
(M2Options_SetGenModuleList): Ditto.
(M2Options_SetShared): Ditto.
* gm2-libs-ch/M2LINK.c: Ditto.
* gm2-libs-ch/m2rts.h (M2RTS_RequestDependant): Replace
const char * with const void *.
(M2RTS_RegisterModule): Ditto.
(M2RTS_ConstructModules): Ditto.
* gm2-gcc/m2decl.def (DetermineSizeOfConstant): New parameter
issueError.
* gm2-gcc/m2decl.h (DetermineSizeOfConstant): New parameter
issueError.
gcc/testsuite/ChangeLog:
* gm2/pim/fail/largeconst.mod: New test.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2ALU.def | 2 +-
gcc/m2/gm2-compiler/M2ALU.mod | 11 +--
gcc/m2/gm2-compiler/SymbolTable.mod | 32 ++++---
gcc/m2/gm2-gcc/m2decl.cc | 26 +++---
gcc/m2/gm2-gcc/m2decl.def | 6 +-
gcc/m2/gm2-gcc/m2decl.h | 8 +-
gcc/m2/gm2-gcc/m2expr.cc | 37 ++++----
gcc/m2/gm2-gcc/m2expr.h | 14 +--
gcc/m2/gm2-gcc/m2linemap.cc | 124 +++++++++++++++++++++++++++
gcc/m2/gm2-gcc/m2linemap.h | 2 +-
gcc/m2/gm2-gcc/m2options.h | 138 +++++++++++++++---------------
gcc/m2/gm2-libs-ch/M2LINK.c | 3 +-
gcc/m2/gm2-libs-ch/m2rts.h | 6 +-
gcc/testsuite/gm2/pim/fail/largeconst.mod | 7 ++
14 files changed, 286 insertions(+), 130 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2ALU.def b/gcc/m2/gm2-compiler/M2ALU.def
index e6fe58d7fbd..e4222114e96 100644
--- a/gcc/m2/gm2-compiler/M2ALU.def
+++ b/gcc/m2/gm2-compiler/M2ALU.def
@@ -264,7 +264,7 @@ PROCEDURE PushChar (c: CHAR) ;
PushString - pushes the numerical value of the string onto the stack.
*)
-PROCEDURE PushString (tokenno: CARDINAL; s: Name) ;
+PROCEDURE PushString (tokenno: CARDINAL; s: Name; issueError: BOOLEAN) ;
(*
diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod
index 9739c761d64..324d6a71b39 100644
--- a/gcc/m2/gm2-compiler/M2ALU.mod
+++ b/gcc/m2/gm2-compiler/M2ALU.mod
@@ -1171,7 +1171,7 @@ END IsReal ;
PushString - pushes the numerical value of the string onto the stack.
*)
-PROCEDURE PushString (tokenno: CARDINAL; s: Name) ;
+PROCEDURE PushString (tokenno: CARDINAL; s: Name; issueError: BOOLEAN) ;
VAR
ch : CHAR ;
a, b : DynamicStrings.String ;
@@ -1192,26 +1192,27 @@ BEGIN
b := DynamicStrings.Slice (a, 0, -1) ;
PushIntegerTree (BuildConstLiteralNumber (location,
DynamicStrings.string (b),
- 16)) |
+ 16, issueError)) |
'A': (* binary *)
b := DynamicStrings.Slice (a, 0, -1) ;
PushIntegerTree (BuildConstLiteralNumber (location,
DynamicStrings.string (b),
- 2)) |
+ 2, issueError)) |
'C', (* --fixme-- question:
should we type this as a char rather than an int? *)
'B': (* octal *)
b := DynamicStrings.Slice (a, 0, -1) ;
PushIntegerTree (BuildConstLiteralNumber (location,
DynamicStrings.string (b),
- 8))
+ 8, issueError))
ELSE
IF IsReal (a)
THEN
PushRealTree (RealToTree (KeyToCharStar (s)))
ELSE
- PushIntegerTree (BuildConstLiteralNumber (location, KeyToCharStar (s), 10))
+ PushIntegerTree (BuildConstLiteralNumber (location, KeyToCharStar (s),
+ 10, issueError))
END
END
ELSE
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 92f1f1e83f7..2a68636a0bc 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -4758,12 +4758,17 @@ END MakeConstant ;
PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
VAR
- pSym: PtrToSymbol ;
- Sym : CARDINAL ;
+ pSym : PtrToSymbol ;
+ Sym : CARDINAL ;
+ issueError,
+ overflow : BOOLEAN ;
BEGIN
+ issueError := TRUE ;
+ overflow := FALSE ;
IF constType=NulSym
THEN
- constType := GetConstLitType (tok, constName)
+ constType := GetConstLitType (tok, constName, overflow, issueError) ;
+ issueError := NOT overflow
END ;
NewSym (Sym) ;
pSym := GetPsym (Sym) ;
@@ -4773,7 +4778,7 @@ BEGIN
ConstLitSym : ConstLit.name := constName ;
ConstLit.Value := InitValue () ;
- PushString (tok, constName) ;
+ PushString (tok, constName, issueError) ;
PopInto (ConstLit.Value) ;
ConstLit.Type := constType ;
ConstLit.IsSet := FALSE ;
@@ -6368,7 +6373,8 @@ END IsHiddenType ;
depending upon their value.
*)
-PROCEDURE GetConstLitType (tok: CARDINAL; name: Name) : CARDINAL ;
+PROCEDURE GetConstLitType (tok: CARDINAL; name: Name;
+ VAR overflow: BOOLEAN; issueError: BOOLEAN) : CARDINAL ;
VAR
loc : location_t ;
s : String ;
@@ -6389,16 +6395,16 @@ BEGIN
loc := TokenToLocation (tok) ;
CASE char (s, -1) OF
- 'H': DetermineSizeOfConstant (loc, string (s), 16,
- needsLong, needsUnsigned) |
- 'B': DetermineSizeOfConstant (loc, string (s), 8,
- needsLong, needsUnsigned) |
- 'A': DetermineSizeOfConstant (loc, string (s), 2,
- needsLong, needsUnsigned)
+ '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)
ELSE
- DetermineSizeOfConstant (loc, string (s), 10,
- needsLong, needsUnsigned)
+ overflow := DetermineSizeOfConstant (loc, string (s), 10,
+ needsLong, needsUnsigned, issueError)
END ;
s := KillString (s) ;
(*
diff --git a/gcc/m2/gm2-gcc/m2decl.cc b/gcc/m2/gm2-gcc/m2decl.cc
index 8f814dbc5a5..a3f9c4ba0a8 100644
--- a/gcc/m2/gm2-gcc/m2decl.cc
+++ b/gcc/m2/gm2-gcc/m2decl.cc
@@ -283,21 +283,23 @@ m2decl_DeclareModuleCtor (tree decl)
return decl;
}
-
/* DetermineSizeOfConstant - given, str, and, base, fill in needsLong
and needsUnsigned appropriately. */
-void
+bool
m2decl_DetermineSizeOfConstant (location_t location,
const char *str, unsigned int base,
- bool *needsLong, bool *needsUnsigned)
+ bool *needsLong, bool *needsUnsigned,
+ bool issueError)
{
unsigned int ulow;
int high;
- int overflow = m2expr_interpret_m2_integer (str, base, &ulow, &high,
- needsLong, needsUnsigned);
- if (overflow)
+ 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;
}
/* BuildConstLiteralNumber - returns a GCC TREE built from the
@@ -305,13 +307,14 @@ m2decl_DetermineSizeOfConstant (location_t location,
Modula-2. It always returns a positive value. */
tree
-m2decl_BuildConstLiteralNumber (location_t location, const char *str, unsigned int base)
+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 (str, base, &low, &high);
+ bool overflow = m2expr_interpret_integer (location, str, base, &low, &high);
bool needLong, needUnsigned;
ival[0] = low;
@@ -320,8 +323,9 @@ m2decl_BuildConstLiteralNumber (location_t location, const char *str, unsigned i
widest_int wval = widest_int::from_array (ival, 3);
- m2decl_DetermineSizeOfConstant (location, str, base, &needLong, &needUnsigned);
-
+ bool overflow_m2 = m2decl_DetermineSizeOfConstant (location, str, base,
+ &needLong, &needUnsigned,
+ issueError);
if (needUnsigned && needLong)
type = m2type_GetM2LongCardType ();
else
@@ -329,7 +333,7 @@ m2decl_BuildConstLiteralNumber (location_t location, const char *str, unsigned i
value = wide_int_to_tree (type, wval);
- if (overflow || m2expr_TreeOverflow (value))
+ if (issueError && (overflow || overflow_m2 || 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 6a1969336a2..314cba56353 100644
--- a/gcc/m2/gm2-gcc/m2decl.def
+++ b/gcc/m2/gm2-gcc/m2decl.def
@@ -167,7 +167,8 @@ PROCEDURE RememberVariables (l: Tree) ;
PROCEDURE DetermineSizeOfConstant (location: location_t;
str: ADDRESS; base: CARDINAL;
- VAR needsLong, needsUnsigned: BOOLEAN) ;
+ VAR needsLong, needsUnsigned: BOOLEAN;
+ issueError: BOOLEAN) : BOOLEAN ;
(*
@@ -178,7 +179,8 @@ PROCEDURE DetermineSizeOfConstant (location: location_t;
*)
PROCEDURE BuildConstLiteralNumber (location: location_t;
- str: ADDRESS; base: CARDINAL) : Tree ;
+ str: ADDRESS; base: CARDINAL;
+ issueError: BOOLEAN) : Tree ;
(*
diff --git a/gcc/m2/gm2-gcc/m2decl.h b/gcc/m2/gm2-gcc/m2decl.h
index 465f7d13f02..28d5a136511 100644
--- a/gcc/m2/gm2-gcc/m2decl.h
+++ b/gcc/m2/gm2-gcc/m2decl.h
@@ -49,11 +49,13 @@ EXTERN tree m2decl_BuildStringConstant (const char *string, int length);
EXTERN tree m2decl_BuildCStringConstant (const char *string, int length);
EXTERN tree m2decl_BuildConstLiteralNumber (location_t location,
const char *str,
- unsigned int base);
-EXTERN void m2decl_DetermineSizeOfConstant (location_t location,
+ unsigned int base,
+ bool issueError);
+EXTERN bool m2decl_DetermineSizeOfConstant (location_t location,
const char *str, unsigned int base,
bool *needsLong,
- bool *needsUnsigned);
+ bool *needsUnsigned,
+ 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 95e5d489a15..920cbaaa9bb 100644
--- a/gcc/m2/gm2-gcc/m2expr.cc
+++ b/gcc/m2/gm2-gcc/m2expr.cc
@@ -39,6 +39,7 @@ along with GNU Modula-2; see the file COPYING3. If not see
#include "m2tree.h"
#include "m2treelib.h"
#include "m2type.h"
+#include "m2linemap.h"
static void m2expr_checkRealOverflow (location_t location, enum tree_code code,
tree result);
@@ -3504,7 +3505,7 @@ m2expr_BuildIndirect (location_t location ATTRIBUTE_UNUSED, tree target,
/* IsTrue - returns true if, t, is known to be true. */
-int
+bool
m2expr_IsTrue (tree t)
{
return (m2expr_FoldAndStrip (t) == m2type_GetBooleanTrue ());
@@ -3512,7 +3513,7 @@ m2expr_IsTrue (tree t)
/* IsFalse - returns false if, t, is known to be false. */
-int
+bool
m2expr_IsFalse (tree t)
{
return (m2expr_FoldAndStrip (t) == m2type_GetBooleanFalse ());
@@ -3521,7 +3522,7 @@ m2expr_IsFalse (tree t)
/* AreConstantsEqual - maps onto tree.cc (tree_int_cst_equal). It
returns true if the value of e1 is the same as e2. */
-int
+bool
m2expr_AreConstantsEqual (tree e1, tree e2)
{
return tree_int_cst_equal (e1, e2) != 0;
@@ -3531,7 +3532,7 @@ m2expr_AreConstantsEqual (tree e1, tree e2)
e2 are equal according to IEEE rules. This does not perform bit
equivalence for example IEEE states that -0 == 0 and NaN != NaN. */
-int
+bool
m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2)
{
if (TREE_CODE (e1) == COMPLEX_CST)
@@ -3828,9 +3829,9 @@ m2expr_BuildBinaryForeachWordDo (location_t location, tree type, tree op1,
tree field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
if (is_op1const)
- error_at (
+ m2linemap_internal_error_at (
location,
- "internal error: not expecting operand1 to be a constant set");
+ "not expecting operand1 to be a constant set");
while (field1 != NULL && field2 != NULL && field3 != NULL)
{
@@ -3855,7 +3856,8 @@ m2expr_BuildBinaryForeachWordDo (location_t location, tree type, tree op1,
BASE. */
static int
-append_digit (unsigned HOST_WIDE_INT *low, HOST_WIDE_INT *high,
+append_digit (location_t location,
+ unsigned HOST_WIDE_INT *low, HOST_WIDE_INT *high,
unsigned int digit, unsigned int base)
{
unsigned int shift;
@@ -3881,7 +3883,8 @@ append_digit (unsigned HOST_WIDE_INT *low, HOST_WIDE_INT *high,
default:
shift = 3;
- error ("internal error: not expecting this base value for a constant");
+ 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
@@ -3925,7 +3928,7 @@ append_digit (unsigned HOST_WIDE_INT *low, HOST_WIDE_INT *high,
constants. Heavily borrowed from gcc/cppexp.cc. */
int
-m2expr_interpret_integer (const char *str, unsigned int base,
+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;
@@ -3965,7 +3968,7 @@ m2expr_interpret_integer (const char *str, unsigned int base,
*low = (*low) * base + c;
else
{
- overflow = append_digit (low, high, c, base);
+ overflow = append_digit (location, low, high, c, base);
max = 0; /* From now on we always use append_digit. */
}
}
@@ -3977,7 +3980,8 @@ m2expr_interpret_integer (const char *str, unsigned int base,
BASE. */
static int
-append_m2_digit (unsigned int *low, int *high, unsigned int digit,
+append_m2_digit (location_t location,
+ unsigned int *low, int *high, unsigned int digit,
unsigned int base, bool *needsUnsigned)
{
unsigned int shift;
@@ -4004,7 +4008,8 @@ append_m2_digit (unsigned int *low, int *high, unsigned int digit,
default:
shift = 3;
- error ("internal error: not expecting this base value for a constant");
+ 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
@@ -4060,7 +4065,8 @@ append_m2_digit (unsigned int *low, int *high, unsigned int digit,
if an overflow can be avoided by using these techniques. */
int
-m2expr_interpret_m2_integer (const char *str, unsigned int base,
+m2expr_interpret_m2_integer (location_t location,
+ const char *str, unsigned int base,
unsigned int *low, int *high,
bool *needsLong, bool *needsUnsigned)
{
@@ -4103,7 +4109,8 @@ m2expr_interpret_m2_integer (const char *str, unsigned int base,
else
{
*needsLong = true;
- if (append_m2_digit (low, high, c, base,
+ 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. */
@@ -4190,7 +4197,7 @@ m2expr_GetSizeOf (location_t location, tree type)
if (!COMPLETE_TYPE_P (type))
{
- error_at (location, "%qs applied to an incomplete type", "sizeof");
+ error_at (location, "%qs applied to an incomplete type", "SIZE");
return size_zero_node;
}
diff --git a/gcc/m2/gm2-gcc/m2expr.h b/gcc/m2/gm2-gcc/m2expr.h
index b65ec8870c8..041dfa61c37 100644
--- a/gcc/m2/gm2-gcc/m2expr.h
+++ b/gcc/m2/gm2-gcc/m2expr.h
@@ -47,10 +47,10 @@ EXTERN tree m2expr_BuildRe (tree op1);
EXTERN tree m2expr_BuildAbs (location_t location, tree t);
EXTERN tree m2expr_BuildCap (location_t location, tree t);
EXTERN int m2expr_DetermineSign (tree e);
-EXTERN int m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2);
-EXTERN int m2expr_AreConstantsEqual (tree e1, tree e2);
-EXTERN int m2expr_IsFalse (tree t);
-EXTERN int m2expr_IsTrue (tree t);
+EXTERN bool m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2);
+EXTERN bool m2expr_AreConstantsEqual (tree e1, tree e2);
+EXTERN bool m2expr_IsFalse (tree t);
+EXTERN bool m2expr_IsTrue (tree t);
EXTERN tree m2expr_BuildIndirect (location_t location, tree target, tree type);
EXTERN tree m2expr_BuildComponentRef (location_t location, tree record,
tree field);
@@ -124,10 +124,12 @@ EXTERN int m2expr_TreeOverflow (tree t);
EXTERN unsigned int m2expr_StringLength (tree string);
EXTERN tree m2expr_FoldAndStrip (tree t);
-EXTERN int m2expr_interpret_integer (const char *str, unsigned int base,
+EXTERN int m2expr_interpret_integer (location_t location,
+ const char *str, unsigned int base,
unsigned HOST_WIDE_INT *low,
HOST_WIDE_INT *high);
-EXTERN int m2expr_interpret_m2_integer (const char *str, unsigned int base,
+EXTERN int m2expr_interpret_m2_integer (location_t location,
+ const char *str, unsigned int base,
unsigned int *low, int *high,
bool *needsLong, bool *needsUnsigned);
diff --git a/gcc/m2/gm2-gcc/m2linemap.cc b/gcc/m2/gm2-gcc/m2linemap.cc
index e34477f0823..9955bd18175 100644
--- a/gcc/m2/gm2-gcc/m2linemap.cc
+++ b/gcc/m2/gm2-gcc/m2linemap.cc
@@ -35,6 +35,8 @@ along with GNU Modula-2; see the file COPYING3. If not see
#include "m2type.h"
#define m2linemap_c
#include "m2linemap.h"
+#include "m2color.h"
+#include <string>
static int inFile = FALSE;
@@ -251,6 +253,128 @@ m2linemap_internal_error (const char *message)
internal_error ("%s", message);
}
+
+/* Code derived from rust. */
+
+static std::string
+mformat_value ()
+{
+ return std::string (xstrerror (errno));
+}
+
+
+static std::string
+expand_format (const char *fmt)
+{
+ std::string result;
+ for (const char *c = fmt; *c; ++c)
+ {
+ if (*c != '%')
+ {
+ result += *c;
+ continue;
+ }
+ c++;
+ switch (*c)
+ {
+ case '\0': {
+ // malformed format string
+ gcc_unreachable ();
+ }
+ case '%': {
+ result += '%';
+ break;
+ }
+ case 'm': {
+ result += mformat_value ();
+ break;
+ }
+ case '<': {
+ result += m2color_open_quote ();
+ break;
+ }
+ case '>': {
+ result += m2color_close_quote ();
+ break;
+ }
+ case 'q': {
+ result += m2color_open_quote ();
+ c++;
+ if (*c == 'm')
+ result += mformat_value ();
+ else
+ {
+ result += '%';
+ result += *c;
+ }
+ result += m2color_close_quote ();
+ break;
+ }
+ default: {
+ result += '%';
+ result += *c;
+ }
+ }
+ }
+ return result;
+}
+
+static std::string
+expand_message (const char *fmt, va_list ap)
+{
+ char *mbuf = 0;
+ std::string expanded_fmt = expand_format (fmt);
+ int nwr = vasprintf (&mbuf, expanded_fmt.c_str (), ap);
+ if (nwr == -1)
+ {
+ // memory allocation failed
+ error_at (UNKNOWN_LOCATION,
+ "memory allocation failed in vasprintf");
+ gcc_assert (0);
+ }
+ std::string rval = std::string (mbuf);
+ free (mbuf);
+ return rval;
+}
+
+
+static void
+gm2_internal_error_at (location_t location, const std::string &errmsg)
+{
+ expanded_location exp_loc = expand_location (location);
+ std::string loc_str;
+ std::string file_str;
+
+ if (exp_loc.file == NULL)
+ file_str.clear ();
+ else
+ file_str = std::string (exp_loc.file);
+
+ if (! file_str.empty ())
+ {
+ loc_str += file_str;
+ loc_str += ':';
+ loc_str += std::to_string (exp_loc.line);
+ loc_str += ':';
+ loc_str += std::to_string (exp_loc.column);
+ }
+ if (loc_str.empty ())
+ internal_error ("%s", errmsg.c_str ());
+ else
+ internal_error ("at %s, %s", loc_str.c_str (), errmsg.c_str ());
+}
+
+
+void
+m2linemap_internal_error_at (location_t location, const char *fmt, ...)
+{
+ va_list ap;
+
+ va_start (ap, fmt);
+ gm2_internal_error_at (location, expand_message (fmt, ap));
+ va_end (ap);
+}
+
/* UnknownLocation - return the predefined location representing an
unknown location. */
diff --git a/gcc/m2/gm2-gcc/m2linemap.h b/gcc/m2/gm2-gcc/m2linemap.h
index 2c4092a869d..44a6ff0f230 100644
--- a/gcc/m2/gm2-gcc/m2linemap.h
+++ b/gcc/m2/gm2-gcc/m2linemap.h
@@ -59,7 +59,7 @@ EXTERN void m2linemap_ErrorAtf (location_t location, const char *message);
EXTERN void m2linemap_WarningAtf (location_t location, const char *message);
EXTERN void m2linemap_NoteAtf (location_t location, const char *message);
EXTERN void m2linemap_internal_error (const char *message);
-
+EXTERN void m2linemap_internal_error_at (location_t location, const char *fmt, ...);
EXTERN location_t UnknownLocation (void);
EXTERN location_t BuiltinsLocation (void);
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index 7f5173ca474..ec49faf9947 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -42,86 +42,86 @@ EXTERN void M2Options_SetSearchPath (const char *arg);
EXTERN void M2Options_setdefextension (const char *arg);
EXTERN void M2Options_setmodextension (const char *arg);
-EXTERN void M2Options_SetISO (int value);
-EXTERN void M2Options_SetPIM (int value);
-EXTERN void M2Options_SetPIM2 (int value);
-EXTERN void M2Options_SetPIM3 (int value);
-EXTERN void M2Options_SetPIM4 (int value);
-EXTERN void M2Options_SetFloatValueCheck (int value);
-EXTERN void M2Options_SetWholeValueCheck (int value);
+EXTERN void M2Options_SetISO (bool value);
+EXTERN void M2Options_SetPIM (bool value);
+EXTERN void M2Options_SetPIM2 (bool value);
+EXTERN void M2Options_SetPIM3 (bool value);
+EXTERN void M2Options_SetPIM4 (bool value);
+EXTERN void M2Options_SetFloatValueCheck (bool value);
+EXTERN void M2Options_SetWholeValueCheck (bool value);
-EXTERN int M2Options_GetISO (void);
-EXTERN int M2Options_GetPIM (void);
-EXTERN int M2Options_GetPIM2 (void);
-EXTERN int M2Options_GetPIM3 (void);
-EXTERN int M2Options_GetPIM4 (void);
-EXTERN int M2Options_GetPositiveModFloor (void);
-EXTERN int M2Options_GetFloatValueCheck (void);
-EXTERN int M2Options_GetWholeValueCheck (void);
+EXTERN bool M2Options_GetISO (void);
+EXTERN bool M2Options_GetPIM (void);
+EXTERN bool M2Options_GetPIM2 (void);
+EXTERN bool M2Options_GetPIM3 (void);
+EXTERN bool M2Options_GetPIM4 (void);
+EXTERN bool M2Options_GetPositiveModFloor (void);
+EXTERN bool M2Options_GetFloatValueCheck (void);
+EXTERN bool M2Options_GetWholeValueCheck (void);
-EXTERN void M2Options_Setc (int value);
-EXTERN int M2Options_Getc (void);
-EXTERN void M2Options_SetPPOnly (int value);
-EXTERN int M2Options_GetPPOnly (void);
+EXTERN void M2Options_Setc (bool value);
+EXTERN bool M2Options_Getc (void);
+EXTERN void M2Options_SetPPOnly (bool value);
+EXTERN bool M2Options_GetPPOnly (void);
-EXTERN void M2Options_SetUselist (int value, const char *filename);
-EXTERN void M2Options_SetAutoInit (int value);
-EXTERN void M2Options_SetPositiveModFloor (int value);
-EXTERN void M2Options_SetNilCheck (int value);
-EXTERN void M2Options_SetWholeDiv (int value);
-EXTERN void M2Options_SetIndex (int value);
-EXTERN void M2Options_SetRange (int value);
-EXTERN void M2Options_SetReturnCheck (int value);
-EXTERN void M2Options_SetCaseCheck (int value);
-EXTERN void M2Options_SetCheckAll (int value);
-EXTERN void M2Options_SetExceptions (int value);
-EXTERN void M2Options_SetStyle (int value);
-EXTERN void M2Options_SetPedantic (int value);
-EXTERN void M2Options_SetPedanticParamNames (int value);
-EXTERN void M2Options_SetPedanticCast (int value);
-EXTERN void M2Options_SetExtendedOpaque (int value);
-EXTERN void M2Options_SetVerboseUnbounded (int value);
-EXTERN void M2Options_SetXCode (int value);
-EXTERN void M2Options_SetCompilerDebugging (int value);
-EXTERN void M2Options_SetQuadDebugging (int value);
-EXTERN void M2Options_SetDebugTraceQuad (int value);
-EXTERN void M2Options_SetDebugTraceAPI (int value);
-EXTERN void M2Options_SetSources (int value);
-EXTERN void M2Options_SetUnboundedByReference (int value);
-EXTERN void M2Options_SetDumpSystemExports (int value);
-EXTERN void M2Options_SetOptimizing (int value);
-EXTERN void M2Options_SetQuiet (int value);
-EXTERN void M2Options_SetCC1Quiet (int value);
-EXTERN void M2Options_SetCpp (int value);
-EXTERN void M2Options_SetSwig (int value);
+EXTERN void M2Options_SetUselist (bool value, const char *filename);
+EXTERN void M2Options_SetAutoInit (bool value);
+EXTERN void M2Options_SetPositiveModFloor (bool value);
+EXTERN void M2Options_SetNilCheck (bool value);
+EXTERN void M2Options_SetWholeDiv (bool value);
+EXTERN void M2Options_SetIndex (bool value);
+EXTERN void M2Options_SetRange (bool value);
+EXTERN void M2Options_SetReturnCheck (bool value);
+EXTERN void M2Options_SetCaseCheck (bool value);
+EXTERN void M2Options_SetCheckAll (bool value);
+EXTERN void M2Options_SetExceptions (bool value);
+EXTERN void M2Options_SetStyle (bool value);
+EXTERN void M2Options_SetPedantic (bool value);
+EXTERN void M2Options_SetPedanticParamNames (bool value);
+EXTERN void M2Options_SetPedanticCast (bool value);
+EXTERN void M2Options_SetExtendedOpaque (bool value);
+EXTERN void M2Options_SetVerboseUnbounded (bool value);
+EXTERN void M2Options_SetXCode (bool value);
+EXTERN void M2Options_SetCompilerDebugging (bool value);
+EXTERN void M2Options_SetQuadDebugging (bool value);
+EXTERN void M2Options_SetDebugTraceQuad (bool value);
+EXTERN void M2Options_SetDebugTraceAPI (bool value);
+EXTERN void M2Options_SetSources (bool value);
+EXTERN void M2Options_SetUnboundedByReference (bool value);
+EXTERN void M2Options_SetDumpSystemExports (bool value);
+EXTERN void M2Options_SetOptimizing (bool value);
+EXTERN void M2Options_SetQuiet (bool value);
+EXTERN void M2Options_SetCC1Quiet (bool value);
+EXTERN void M2Options_SetCpp (bool value);
+EXTERN void M2Options_SetSwig (bool value);
EXTERN void M2Options_SetForcedLocation (location_t location);
EXTERN location_t M2Options_OverrideLocation (location_t location);
EXTERN void M2Options_SetStatistics (int on);
EXTERN void M2Options_CppProg (const char *program);
-EXTERN void M2Options_CppArg (const char *opt, const char *arg, int joined);
-EXTERN void M2Options_SetWholeProgram (int value);
+EXTERN void M2Options_CppArg (const char *opt, const char *arg, bool joined);
+EXTERN void M2Options_SetWholeProgram (bool value);
EXTERN void M2Options_FinaliseOptions (void);
-EXTERN void M2Options_SetDebugFunctionLineNumbers (int value);
-EXTERN void M2Options_SetGenerateStatementNote (int value);
-EXTERN int M2Options_GetCpp (void);
-EXTERN int M2Options_GetM2g (void);
-EXTERN void M2Options_SetM2g (int value);
-EXTERN void M2Options_SetLowerCaseKeywords (int value);
-EXTERN void M2Options_SetVerbose (int value);
-EXTERN void M2Options_SetUnusedVariableChecking (int value);
-EXTERN void M2Options_SetUnusedParameterChecking (int value);
-EXTERN void M2Options_SetStrictTypeChecking (int value);
-EXTERN void M2Options_SetWall (int value);
-EXTERN void M2Options_SetSaveTemps (int value);
+EXTERN void M2Options_SetDebugFunctionLineNumbers (bool value);
+EXTERN void M2Options_SetGenerateStatementNote (bool value);
+EXTERN bool M2Options_GetCpp (void);
+EXTERN bool M2Options_GetM2g (void);
+EXTERN void M2Options_SetM2g (bool value);
+EXTERN void M2Options_SetLowerCaseKeywords (bool value);
+EXTERN void M2Options_SetVerbose (bool value);
+EXTERN void M2Options_SetUnusedVariableChecking (bool value);
+EXTERN void M2Options_SetUnusedParameterChecking (bool value);
+EXTERN void M2Options_SetStrictTypeChecking (bool value);
+EXTERN void M2Options_SetWall (bool value);
+EXTERN void M2Options_SetSaveTemps (bool value);
EXTERN void M2Options_SetSaveTempsDir (const char *arg);
EXTERN void M2Options_SetDumpDir (const char *arg);
-EXTERN int M2Options_GetSaveTemps (void);
-EXTERN void M2Options_SetScaffoldStatic (int value);
-EXTERN void M2Options_SetScaffoldDynamic (int value);
-EXTERN void M2Options_SetScaffoldMain (int value);
+EXTERN bool M2Options_GetSaveTemps (void);
+EXTERN void M2Options_SetScaffoldStatic (bool value);
+EXTERN void M2Options_SetScaffoldDynamic (bool value);
+EXTERN void M2Options_SetScaffoldMain (bool value);
EXTERN void M2Options_SetRuntimeModuleOverride (const char *override);
-EXTERN void M2Options_SetGenModuleList (int value, const char *filename);
-EXTERN void M2Options_SetShared (int value);
+EXTERN void M2Options_SetGenModuleList (bool value, const char *filename);
+EXTERN void M2Options_SetShared (bool value);
EXTERN void M2Options_SetB (const char *arg);
EXTERN char *M2Options_GetB (void);
EXTERN void M2Options_SetMD (const char *arg);
diff --git a/gcc/m2/gm2-libs-ch/M2LINK.c b/gcc/m2/gm2-libs-ch/M2LINK.c
index ebb8966b7bc..9efe6f34895 100644
--- a/gcc/m2/gm2-libs-ch/M2LINK.c
+++ b/gcc/m2/gm2-libs-ch/M2LINK.c
@@ -28,6 +28,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "system.h"
#include "ansidecl.h"
#include "math.h"
+#include <stdbool.h>
#include "gm2-libs-host.h"
@@ -39,6 +40,6 @@ extern "C" {
initialization features of M2RTS. */
char *M2LINK_ForcedModuleInitOrder = NULL;
- int M2LINK_StaticInitialization = 1;
+ bool M2LINK_StaticInitialization = true;
}
diff --git a/gcc/m2/gm2-libs-ch/m2rts.h b/gcc/m2/gm2-libs-ch/m2rts.h
index e70c9f63f7b..e9e4b995d2e 100644
--- a/gcc/m2/gm2-libs-ch/m2rts.h
+++ b/gcc/m2/gm2-libs-ch/m2rts.h
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
typedef void (*proc_con) (int, char **, char **);
typedef void (*proc_dep) (void);
-extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
-extern "C" void M2RTS_RegisterModule (const char *modulename, const char *libname,
+extern "C" void M2RTS_RequestDependant (const void *modulename, const void *dependancy);
+extern "C" void M2RTS_RegisterModule (const void *modulename, const void *libname,
proc_con init, proc_con fini, proc_dep dependencies);
extern "C" void _M2_M2RTS_init (void);
-extern "C" void M2RTS_ConstructModules (const char *,
+extern "C" void M2RTS_ConstructModules (const void *,
int argc, char *argv[], char *envp[]);
extern "C" void M2RTS_Terminate (void);
extern "C" void M2RTS_DeconstructModules (void);
diff --git a/gcc/testsuite/gm2/pim/fail/largeconst.mod b/gcc/testsuite/gm2/pim/fail/largeconst.mod
new file mode 100644
index 00000000000..fa59cf29d19
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/largeconst.mod
@@ -0,0 +1,7 @@
+MODULE largeconst ;
+
+CONST
+ foo = 12345678912345678912345679123456789123456789 ;
+
+BEGIN
+END largeconst.
\ No newline at end of file
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-03-13 23:03 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-03-13 23:03 [gcc r13-6649] PR 109103 Modula2 Missing function internal_error_at 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).