From 370298f493020eeff48bc2e56463c1097ed67b1d Mon Sep 17 00:00:00 2001 From: Gaius Mulley Date: Mon, 13 Mar 2023 23:03:24 +0000 Subject: [PATCH] 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 --- 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(-) create mode 100644 gcc/testsuite/gm2/pim/fail/largeconst.mod diff --git a/gcc/m2/gm2-compiler/M2ALU.def b/gcc/m2/gm2-compiler/M2ALU.def index e6fe58d..e422211 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 9739c76..324d6a7 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 92f1f1e..2a68636 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 8f814db..a3f9c4b 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 6a19693..314cba5 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 465f7d1..28d5a13 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 95e5d48..920cbaa 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 b65ec88..041dfa6 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 e34477f..9955bd1 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 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 2c4092a..44a6ff0 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 7f5173c..ec49faf 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 ebb8966..9efe6f3 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 #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 e70c9f6..e9e4b99 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 0000000..fa59cf2 --- /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 -- 2.7.4