* *
* C Implementation File *
* *
- * Copyright (C) 1992-2004 Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
* for more details. You should have received a copy of the GNU General *
* Public License distributed with GNAT; see file COPYING. If not, write *
- * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
- * MA 02111-1307, USA. *
+ * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
+ * Boston, MA 02110-1301, USA. *
* *
* As a special exception, if you link this file with other files to *
* produce an executable, this file does not by itself cause the resulting *
#include "tree.h"
#include "real.h"
#include "rtl.h"
-#include "errors.h"
#include "diagnostic.h"
#include "expr.h"
#include "libfuncs.h"
static HOST_WIDE_INT gnat_get_alias_set (tree);
static void gnat_print_decl (FILE *, tree, int);
static void gnat_print_type (FILE *, tree, int);
-static int gnat_types_compatible_p (tree, tree);
static const char *gnat_printable_name (tree, int);
+static const char *gnat_dwarf_name (tree, int);
static tree gnat_eh_runtime_type (tree);
static int gnat_eh_type_covers (tree, tree);
static void gnat_parse_file (int);
#define LANG_HOOKS_PUSHDECL lhd_return_tree
#undef LANG_HOOKS_FINISH_INCOMPLETE_DECL
#define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
+#undef LANG_HOOKS_REDUCE_BIT_FIELD_OPERATIONS
+#define LANG_HOOKS_REDUCE_BIT_FIELD_OPERATIONS true
#undef LANG_HOOKS_GET_ALIAS_SET
#define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set
#undef LANG_HOOKS_EXPAND_EXPR
#define LANG_HOOKS_EXPAND_EXPR gnat_expand_expr
#undef LANG_HOOKS_MARK_ADDRESSABLE
#define LANG_HOOKS_MARK_ADDRESSABLE gnat_mark_addressable
-#undef LANG_HOOKS_TRUTHVALUE_CONVERSION
-#define LANG_HOOKS_TRUTHVALUE_CONVERSION gnat_truthvalue_conversion
#undef LANG_HOOKS_PRINT_DECL
#define LANG_HOOKS_PRINT_DECL gnat_print_decl
#undef LANG_HOOKS_PRINT_TYPE
#define LANG_HOOKS_PRINT_TYPE gnat_print_type
-#undef LANG_HOOKS_TYPES_COMPATIBLE_P
-#define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p
#undef LANG_HOOKS_TYPE_MAX_SIZE
#define LANG_HOOKS_TYPE_MAX_SIZE gnat_type_max_size
#undef LANG_HOOKS_DECL_PRINTABLE_NAME
#define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name
+#undef LANG_HOOKS_DWARF_NAME
+#define LANG_HOOKS_DWARF_NAME gnat_dwarf_name
#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gnat_expand_body
#undef LANG_HOOKS_GIMPLIFY_EXPR
\f
/* Declare functions we use as part of startup. */
-extern void __gnat_initialize (void);
-extern void adainit (void);
-extern void _ada_gnat1drv (void);
+extern void __gnat_initialize (void *);
+extern void __gnat_install_SEH_handler (void *);
+extern void adainit (void);
+extern void _ada_gnat1drv (void);
/* The parser for the language. For us, we process the GNAT tree. */
static void
gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
{
+ int seh[2];
+
/* call the target specific initializations */
- __gnat_initialize();
+ __gnat_initialize (NULL);
+
+ /* ??? call the SEH initialization routine, this is to workaround a
+ bootstrap path problem. The call below should be removed at some point and
+ the seh pointer passed to __gnat_initialize() above. */
+
+ __gnat_install_SEH_handler((void *)seh);
/* Call the front-end elaboration procedures */
adainit ();
const struct cl_option *option = &cl_options[scode];
enum opt_code code = (enum opt_code) scode;
char *q;
- unsigned int i;
if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
{
case OPT_Wstrict_prototypes:
case OPT_Wwrite_strings:
case OPT_Wlong_long:
+ case OPT_Wvariadic_macros:
+ case OPT_Wold_style_definition:
+ case OPT_Wmissing_format_attribute:
+ case OPT_Woverlength_strings:
break;
/* This is handled by the front-end. */
gnat_argc++;
break;
- case OPT_fRTS:
+ case OPT_fRTS_:
gnat_argv[gnat_argc] = xstrdup ("-fRTS");
gnat_argc++;
break;
case OPT_gant:
- warning ("`-gnat' misspelled as `-gant'");
+ warning (0, "%<-gnat%> misspelled as %<-gant%>");
/* ... fall through ... */
gnat_argv[gnat_argc][0] = '-';
strcpy (gnat_argv[gnat_argc] + 1, arg);
gnat_argc++;
+ break;
- if (arg[0] == 'O')
- for (i = 1; i < save_argc - 1; i++)
- if (!strncmp (save_argv[i], "-gnatO", 6))
- if (save_argv[++i][0] != '-')
- {
- /* Preserve output filename as GCC doesn't save it for GNAT. */
- gnat_argv[gnat_argc] = xstrdup (save_argv[i]);
- gnat_argc++;
- break;
- }
+ case OPT_gnatO:
+ gnat_argv[gnat_argc] = xstrdup ("-O");
+ gnat_argc++;
+ gnat_argv[gnat_argc] = xstrdup (arg);
+ gnat_argc++;
break;
}
if (!flag_no_inline)
flag_no_inline = 1;
if (flag_inline_functions)
- {
- flag_inline_trees = 2;
- flag_inline_functions = 0;
- }
+ flag_inline_trees = 2;
+
+ flag_tree_salias = 0;
return false;
}
static void
internal_error_function (const char *msgid, va_list *ap)
{
- char buffer[1000]; /* Assume this is big enough. */
+ text_info tinfo;
+ char *buffer;
char *p;
String_Template temp;
Fat_Pointer fp;
- vsprintf (buffer, msgid, *ap);
+ /* Reset the pretty-printer. */
+ pp_clear_output_area (global_dc->printer);
+
+ /* Format the message into the pretty-printer. */
+ tinfo.format_spec = msgid;
+ tinfo.args_ptr = ap;
+ tinfo.err_no = errno;
+ pp_format_verbatim (global_dc->printer, &tinfo);
+
+ /* Extract a (writable) pointer to the formatted text. */
+ buffer = (char*) pp_formatted_text (global_dc->printer);
/* Go up to the first newline. */
for (p = buffer; *p; p++)
break;
}
- temp.Low_Bound = 1, temp.High_Bound = strlen (buffer);
- fp.Array = buffer, fp.Bounds = &temp;
+ temp.Low_Bound = 1;
+ temp.High_Bound = p - buffer;
+ fp.Bounds = &temp;
+ fp.Array = buffer;
Current_Error_Node = error_gnat_node;
Compiler_Abort (fp, -1);
eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
lang_eh_type_covers = gnat_eh_type_covers;
lang_eh_runtime_type = gnat_eh_runtime_type;
+ default_init_unwind_resume_libfunc ();
/* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
the generation of the necessary exception runtime tables. The second one
break;
case FIELD_DECL:
- print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
+ print_node (file, "original_field", DECL_ORIGINAL_FIELD (node),
+ indent + 4);
+ break;
+
+ case VAR_DECL:
+ print_node (file, "renamed_object", DECL_RENAMED_OBJECT (node),
indent + 4);
break;
}
}
-/* We consider two types compatible if they have the same main variant,
- but we also consider two array types compatible if they have the same
- component type and bounds.
-
- ??? We may also want to generalize to considering lots of integer types
- compatible, but we need to understand the effects of alias sets first. */
-
-static int
-gnat_types_compatible_p (tree x, tree y)
-{
- if (TREE_CODE (x) == ARRAY_TYPE && TREE_CODE (y) == ARRAY_TYPE
- && gnat_types_compatible_p (TREE_TYPE (x), TREE_TYPE (y))
- && operand_equal_p (TYPE_MIN_VALUE (TYPE_DOMAIN (x)),
- TYPE_MIN_VALUE (TYPE_DOMAIN (y)), 0)
- && operand_equal_p (TYPE_MAX_VALUE (TYPE_DOMAIN (x)),
- TYPE_MAX_VALUE (TYPE_DOMAIN (y)), 0))
- return 1;
- else
- return TYPE_MAIN_VARIANT (x) == TYPE_MAIN_VARIANT (y);
-}
-
static const char *
gnat_printable_name (tree decl, int verbosity)
{
return (const char *) ada_name;
}
+static const char *
+gnat_dwarf_name (tree t, int verbosity ATTRIBUTE_UNUSED)
+{
+ gcc_assert (DECL_P (t));
+
+ return (const char *) IDENTIFIER_POINTER (DECL_NAME (t));
+}
+
/* Expands GNAT-specific GCC tree nodes. The only ones we support
here are and NULL_EXPR. */
return;
tree_rest_of_compilation (gnu_decl);
+
+ if (DECL_STATIC_CONSTRUCTOR (gnu_decl) && targetm.have_ctors_dtors)
+ targetm.asm_out.constructor (XEXP (DECL_RTL (gnu_decl), 0),
+ DEFAULT_INIT_PRIORITY);
+
+ if (DECL_STATIC_DESTRUCTOR (gnu_decl) && targetm.have_ctors_dtors)
+ targetm.asm_out.destructor (XEXP (DECL_RTL (gnu_decl), 0),
+ DEFAULT_INIT_PRIORITY);
}
/* Adjusts the RLI used to layout a record after all the fields have been
return -1;
}
-/* GNU_TYPE is a type. Return its maxium size in bytes, if known. */
+/* GNU_TYPE is a type. Return its maxium size in bytes, if known,
+ as a constant when possible. */
static tree
-gnat_type_max_size (gnu_type)
- tree gnu_type;
+gnat_type_max_size (tree gnu_type)
{
- return max_size (TYPE_SIZE_UNIT (gnu_type), true);
+ /* First see what we can get from TYPE_SIZE_UNIT, which might not be
+ constant even for simple expressions if it has already been gimplified
+ and replaced by a VAR_DECL. */
+
+ tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
+
+ /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
+ typically not gimplified. */
+
+ if (!host_integerp (max_unitsize, 1)
+ && (TREE_CODE (gnu_type) == RECORD_TYPE
+ || TREE_CODE (gnu_type) == UNION_TYPE
+ || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
+ && TYPE_ADA_SIZE (gnu_type))
+ {
+ tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
+
+ /* If we have succeded in finding a constant, round it up to the
+ type's alignment and return the result in byte units. */
+
+ if (host_integerp (max_adasize, 1))
+ max_unitsize
+ = size_binop (CEIL_DIV_EXPR,
+ round_up (max_adasize, TYPE_ALIGN (gnu_type)),
+ bitsize_unit_node);
+ }
+
+ return max_unitsize;
}
/* GNU_TYPE is a type. Determine if it should be passed by reference by
OSDN Git Service
