[m-dev.] diff: GCC back-end bug fixes
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Jan 18 22:59:04 AEDT 2001
Estimated hours taken: 1.5
gcc/mercury/mercury-gcc.c:
Fix a bug where I was using the spec1() macro on a non-atomic
type, namely MR_String (which is `char *').
This is very similar to a bug that I fixed earlier
where I was using spec1() for __builtin_jmpbuf.
Change spec1() to be a function rather than a macro,
renaming it as merc_build_atomic_type_decl(),
and define a new function merc_build_type_decl()
for use with non-atomic types.
Promote function arguments to `int', just like we do for
function return values, to ensure binary compatibility with C.
Workspace: /home/hg/fjh/gcc-cvs/gcc
Index: gcc/mercury/mercury-gcc.c
===================================================================
RCS file: /home/mercury1/repository/gcc/mercury/mercury-gcc.c,v
retrieving revision 1.21
diff -u -d -r1.21 mercury-gcc.c
--- gcc/mercury/mercury-gcc.c 2001/01/17 02:45:44 1.21
+++ gcc/mercury/mercury-gcc.c 2001/01/18 10:22:27
@@ -68,10 +68,12 @@
/* Declarations of functions defined in this file. */
static tree merc_convert PARAMS((tree type, tree expr));
-static tree merc_promote_return_type PARAMS((tree type));
+static tree merc_promote_type PARAMS((tree type));
static void merc_init_builtin_functions PARAMS((void));
static void merc_handle_fatal_error PARAMS((const char *msg, va_list *args));
static int merc_call_mercury_compiler PARAMS((void));
+static void merc_push_type_decl PARAMS((tree id, tree type));
+static void merc_push_atomic_type_decl PARAMS((tree id, tree type));
/*---------------------------------------------------------------------------*/
@@ -152,7 +154,7 @@
{
tree parm_decl = build_decl (PARM_DECL, get_identifier (param_name),
param_type);
- DECL_ARG_TYPE (parm_decl) = param_type;
+ DECL_ARG_TYPE (parm_decl) = merc_promote_type (param_type);
return parm_decl;
}
@@ -246,10 +248,11 @@
}
/* For binary compatibility with C, we must promote
- function return values that are smaller than `int' to `int'. */
+ function parameters and return values that are smaller than `int'
+ to `int'. */
static tree
-merc_promote_return_type (type)
+merc_promote_type (type)
tree type;
{
enum tree_code code = TREE_CODE (type);
@@ -291,7 +294,7 @@
DECL_ARGUMENTS (fndecl) = param_list;
DECL_RESULT (fndecl)
= build_decl (RESULT_DECL, NULL_TREE,
- merc_promote_return_type (return_type));
+ merc_promote_type (return_type));
DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
rest_of_decl_compilation (fndecl, NULL_PTR, 1, 0);
@@ -406,7 +409,11 @@
tree arg;
tree arg_list;
{
- return tree_cons (NULL_TREE, arg, arg_list);
+ /* For binary compatibility with C, we need to promote arguments
+ which are smaller than `int' to `int'. */
+ tree promoted_arg_type = merc_promote_type (TREE_TYPE (arg));
+ tree promoted_arg = convert (promoted_arg_type, arg);
+ return tree_cons (NULL_TREE, promoted_arg, arg_list);
}
/* Make an empty initializer list. */
@@ -1188,6 +1195,30 @@
#undef SIZE_TYPE
#define SIZE_TYPE "long unsigned int"
+static void
+merc_push_type_decl(id, type_node)
+ tree id;
+ tree type_node;
+{
+ tree decl = build_decl (TYPE_DECL, id, type_node);
+ TYPE_NAME (type_node) = decl;
+ TYPE_STUB_DECL (type_node) = decl;
+ pushdecl (decl);
+}
+
+/* push_atomic_type_decl() ensures that the type's type is itself.
+ Needed for DBX. Must only be used for atomic types,
+ not for e.g. pointer or array types. */
+
+static void
+merc_push_atomic_type_decl(id, type_node)
+ tree id;
+ tree type_node;
+{
+ TREE_TYPE (type_node) = type_node;
+ merc_push_type_decl (id, type_node);
+}
+
/* Create the predefined scalar types of C,
and some nodes representing standard constants (0, 1, (void *) 0).
Initialize the global binding level.
@@ -1243,72 +1274,67 @@
ridpointers[(int) RID_ONEWAY] = get_identifier ("oneway");
/* Define `int' and `char' first so that dbx will output them first. */
-
- /* spec1() ensures that the type's type is itself. Needed for DBX.
- Should only be used for atomic types.
- For the C front-end this is done in pushdecl with a kludge. */
-
-#define spec1(id, type_node) \
- { \
- tree spec1_decl; \
- TREE_TYPE (type_node) = type_node; \
- spec1_decl = build_decl (TYPE_DECL, id, type_node); \
- TYPE_NAME (type_node) = spec1_decl; \
- TYPE_STUB_DECL (type_node) = spec1_decl; \
- pushdecl (spec1_decl); \
- }
- spec1(ridpointers[(int) RID_INT], integer_type_node);
- spec1(get_identifier ("char"), char_type_node);
- spec1(get_identifier ("long int"), long_integer_type_node);
- spec1(get_identifier ("unsigned int"), unsigned_type_node);
- spec1(get_identifier ("long unsigned int"), long_unsigned_type_node);
- spec1(get_identifier ("long long int"), long_long_integer_type_node);
- spec1(get_identifier ("long long unsigned int"), long_long_unsigned_type_node);
- spec1(get_identifier ("short int"), short_integer_type_node);
- spec1(get_identifier ("short unsigned int"), short_unsigned_type_node);
- spec1(get_identifier ("signed char"), signed_char_type_node);
- spec1(get_identifier ("unsigned char"), unsigned_char_type_node);
- spec1(NULL_TREE, intQI_type_node);
- spec1(NULL_TREE, intHI_type_node);
- spec1(NULL_TREE, intSI_type_node);
- spec1(NULL_TREE, intDI_type_node);
+ merc_push_atomic_type_decl (ridpointers[(int) RID_INT], integer_type_node);
+ merc_push_atomic_type_decl (get_identifier ("char"), char_type_node);
+ merc_push_atomic_type_decl (get_identifier ("long int"),
+ long_integer_type_node);
+ merc_push_atomic_type_decl (get_identifier ("unsigned int"),
+ unsigned_type_node);
+ merc_push_atomic_type_decl (get_identifier ("long unsigned int"),
+ long_unsigned_type_node);
+ merc_push_atomic_type_decl (get_identifier ("long long int"),
+ long_long_integer_type_node);
+ merc_push_atomic_type_decl (get_identifier ("long long unsigned int"),
+ long_long_unsigned_type_node);
+ merc_push_atomic_type_decl (get_identifier ("short int"),
+ short_integer_type_node);
+ merc_push_atomic_type_decl (get_identifier ("short unsigned int"),
+ short_unsigned_type_node);
+ merc_push_atomic_type_decl (get_identifier ("signed char"),
+ signed_char_type_node);
+ merc_push_atomic_type_decl (get_identifier ("unsigned char"),
+ unsigned_char_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, intQI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, intHI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, intSI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, intDI_type_node);
#if HOST_BITS_PER_WIDE_INT >= 64
- spec1(NULL_TREE, intTI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, intTI_type_node);
#endif
- spec1(NULL_TREE, unsigned_intQI_type_node);
- spec1(NULL_TREE, unsigned_intHI_type_node);
- spec1(NULL_TREE, unsigned_intSI_type_node);
- spec1(NULL_TREE, unsigned_intDI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, unsigned_intQI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, unsigned_intHI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, unsigned_intSI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, unsigned_intDI_type_node);
#if HOST_BITS_PER_WIDE_INT >= 64
- spec1(NULL_TREE, unsigned_intTI_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, unsigned_intTI_type_node);
#endif
- /* Create the widest literal types. */
+ /* Create the widest literal types. */
widest_integer_literal_type_node = make_signed_type (HOST_BITS_PER_WIDE_INT * 2);
widest_unsigned_literal_type_node = make_unsigned_type (HOST_BITS_PER_WIDE_INT * 2);
- spec1(NULL_TREE, widest_integer_literal_type_node);
- spec1(NULL_TREE, widest_unsigned_literal_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, widest_integer_literal_type_node);
+ merc_push_atomic_type_decl (NULL_TREE, widest_unsigned_literal_type_node);
merc_int8_type_node = make_signed_type (8);
merc_int16_type_node = make_signed_type (16);
merc_int32_type_node = make_signed_type (32);
merc_int64_type_node = make_signed_type (64);
merc_intptr_type_node = make_signed_type (POINTER_SIZE);
- spec1(get_identifier ("MR_int8_t"), merc_int8_type_node);
- spec1(get_identifier ("MR_int16_t"), merc_int16_type_node);
- spec1(get_identifier ("MR_int32_t"), merc_int32_type_node);
- spec1(get_identifier ("MR_int64_t"), merc_int64_type_node);
- spec1(get_identifier ("MR_intptr_t"), merc_intptr_type_node);
+ merc_push_atomic_type_decl (get_identifier ("MR_int8_t"), merc_int8_type_node);
+ merc_push_atomic_type_decl (get_identifier ("MR_int16_t"), merc_int16_type_node);
+ merc_push_atomic_type_decl (get_identifier ("MR_int32_t"), merc_int32_type_node);
+ merc_push_atomic_type_decl (get_identifier ("MR_int64_t"), merc_int64_type_node);
+ merc_push_atomic_type_decl (get_identifier ("MR_intptr_t"), merc_intptr_type_node);
set_sizetype (merc_intptr_type_node);
build_common_tree_nodes_2 (merc_flag_short_double);
- spec1(ridpointers[(int) RID_FLOAT], float_type_node);
- spec1(ridpointers[(int) RID_DOUBLE], double_type_node);
- spec1(get_identifier ("long double"), long_double_type_node);
- spec1(ridpointers[(int) RID_VOID], void_type_node);
+ merc_push_atomic_type_decl (ridpointers[(int) RID_FLOAT], float_type_node);
+ merc_push_atomic_type_decl (ridpointers[(int) RID_DOUBLE], double_type_node);
+ merc_push_atomic_type_decl (get_identifier ("long double"), long_double_type_node);
+ merc_push_atomic_type_decl (ridpointers[(int) RID_VOID], void_type_node);
#ifdef MD_INIT_BUILTINS
MD_INIT_BUILTINS;
@@ -1328,7 +1354,7 @@
boolean_type_node = make_node (BOOLEAN_TYPE);
TYPE_PRECISION (boolean_type_node) = 1;
fixup_unsigned_type (boolean_type_node);
- spec1(get_identifier ("boolean"), boolean_type_node);
+ merc_push_atomic_type_decl (get_identifier ("boolean"), boolean_type_node);
boolean_false_node = TYPE_MIN_VALUE (boolean_type_node);
boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
#endif
@@ -1336,8 +1362,9 @@
string_type_node = build_pointer_type (char_type_node);
const_string_type_node
= build_pointer_type (build_type_variant (char_type_node, 1, 0));
- spec1(get_identifier ("MR_String"), string_type_node);
- spec1(get_identifier ("MR_ConstString"), const_string_type_node);
+ merc_push_type_decl (get_identifier ("MR_String"), string_type_node);
+ merc_push_type_decl (get_identifier ("MR_ConstString"),
+ const_string_type_node);
/* Make a type to be the domain of a few array types
whose domains don't really matter.
@@ -1355,10 +1382,11 @@
/* The documentation in builtins.c says that __builtin_setjmp expects its
argument to be a pointer to an array of five words. */
jmpbuf_domain_type = build_index_type (build_int_2 (4, 0));
- spec1(get_identifier ("__builtin_jmpbuf_index"), jmpbuf_domain_type);
+ merc_push_atomic_type_decl (get_identifier ("__builtin_jmpbuf_index"),
+ jmpbuf_domain_type);
merc_jmpbuf_type_node = build_array_type (ptr_type_node, jmpbuf_domain_type);
- spec1(get_identifier ("__builtin_jmpbuf"), merc_jmpbuf_type_node);
- TREE_TYPE (merc_jmpbuf_type_node) = ptr_type_node;
+ merc_push_type_decl (get_identifier ("__builtin_jmpbuf"),
+ merc_jmpbuf_type_node);
merc_init_builtin_functions ();
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
| of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list