diff options
Diffstat (limited to 'gcc-4.8.3/gcc/ada/gcc-interface/misc.c')
-rw-r--r-- | gcc-4.8.3/gcc/ada/gcc-interface/misc.c | 893 |
1 files changed, 893 insertions, 0 deletions
diff --git a/gcc-4.8.3/gcc/ada/gcc-interface/misc.c b/gcc-4.8.3/gcc/ada/gcc-interface/misc.c new file mode 100644 index 000000000..83620487b --- /dev/null +++ b/gcc-4.8.3/gcc/ada/gcc-interface/misc.c @@ -0,0 +1,893 @@ +/**************************************************************************** + * * + * GNAT COMPILER COMPONENTS * + * * + * M I S C * + * * + * C Implementation File * + * * + * Copyright (C) 1992-2012, 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- * + * ware Foundation; either version 3, or (at your option) any later ver- * + * sion. GNAT is distributed in the hope that it will be useful, but WITH- * + * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * + * 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 COPYING3. If not see * + * <http://www.gnu.org/licenses/>. * + * * + * GNAT was originally developed by the GNAT team at New York University. * + * Extensive contributions were provided by Ada Core Technologies Inc. * + * * + ****************************************************************************/ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "opts.h" +#include "options.h" +#include "tm.h" +#include "tree.h" +#include "diagnostic.h" +#include "target.h" +#include "ggc.h" +#include "flags.h" +#include "debug.h" +#include "toplev.h" +#include "langhooks.h" +#include "langhooks-def.h" +#include "plugin.h" +#include "real.h" +#include "function.h" /* For pass_by_reference. */ + +#include "ada.h" +#include "adadecode.h" +#include "types.h" +#include "atree.h" +#include "elists.h" +#include "namet.h" +#include "nlists.h" +#include "stringt.h" +#include "uintp.h" +#include "fe.h" +#include "sinfo.h" +#include "einfo.h" +#include "ada-tree.h" +#include "gigi.h" + +/* This symbol needs to be defined for the front-end. */ +void *callgraph_info_file = NULL; + +/* Command-line argc and argv. These variables are global since they are + imported in back_end.adb. */ +unsigned int save_argc; +const char **save_argv; + +/* GNAT argc and argv. */ +extern int gnat_argc; +extern char **gnat_argv; + +#ifdef __cplusplus +extern "C" { +#endif + +/* Declare functions we use as part of startup. */ +extern void __gnat_initialize (void *); +extern void __gnat_install_SEH_handler (void *); +extern void adainit (void); +extern void _ada_gnat1drv (void); + +#ifdef __cplusplus +} +#endif + +/* The parser for the language. For us, we process the GNAT tree. */ + +static void +gnat_parse_file (void) +{ + int seh[2]; + + /* Call the target specific initializations. */ + __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 (); + + /* Call the front end. */ + _ada_gnat1drv (); +} + +/* Return language mask for option processing. */ + +static unsigned int +gnat_option_lang_mask (void) +{ + return CL_Ada; +} + +/* Decode all the language specific options that cannot be decoded by GCC. + The option decoding phase of GCC calls this routine on the flags that + are marked as Ada-specific. Return true on success or false on failure. */ + +static bool +gnat_handle_option (size_t scode, const char *arg ATTRIBUTE_UNUSED, int value, + int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED, + const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED) +{ + enum opt_code code = (enum opt_code) scode; + + switch (code) + { + case OPT_Wall: + handle_generated_option (&global_options, &global_options_set, + OPT_Wunused, NULL, value, + gnat_option_lang_mask (), kind, loc, + handlers, global_dc); + warn_uninitialized = value; + warn_maybe_uninitialized = value; + break; + + case OPT_gant: + warning (0, "%<-gnat%> misspelled as %<-gant%>"); + + /* ... fall through ... */ + + case OPT_gnat: + case OPT_gnatO: + case OPT_fRTS_: + case OPT_I: + case OPT_nostdinc: + case OPT_nostdlib: + /* These are handled by the front-end. */ + break; + + default: + gcc_unreachable (); + } + + Ada_handle_option_auto (&global_options, &global_options_set, + scode, arg, value, + gnat_option_lang_mask (), kind, + loc, handlers, global_dc); + return true; +} + +/* Initialize options structure OPTS. */ + +static void +gnat_init_options_struct (struct gcc_options *opts) +{ + /* Uninitialized really means uninitialized in Ada. */ + opts->x_flag_zero_initialized_in_bss = 0; + + /* We can delete dead instructions that may throw exceptions in Ada. */ + opts->x_flag_delete_dead_exceptions = 1; +} + +/* Initialize for option processing. */ + +static void +gnat_init_options (unsigned int decoded_options_count, + struct cl_decoded_option *decoded_options) +{ + /* Reconstruct an argv array for use of back_end.adb. + + ??? back_end.adb should not rely on this; instead, it should work with + decoded options without such reparsing, to ensure consistency in how + options are decoded. */ + unsigned int i; + + save_argv = XNEWVEC (const char *, 2 * decoded_options_count + 1); + save_argc = 0; + for (i = 0; i < decoded_options_count; i++) + { + size_t num_elements = decoded_options[i].canonical_option_num_elements; + + if (decoded_options[i].errors + || decoded_options[i].opt_index == OPT_SPECIAL_unknown + || num_elements == 0) + continue; + + /* Deal with -I- specially since it must be a single switch. */ + if (decoded_options[i].opt_index == OPT_I + && num_elements == 2 + && decoded_options[i].canonical_option[1][0] == '-' + && decoded_options[i].canonical_option[1][1] == '\0') + save_argv[save_argc++] = "-I-"; + else + { + gcc_assert (num_elements >= 1 && num_elements <= 2); + save_argv[save_argc++] = decoded_options[i].canonical_option[0]; + if (num_elements >= 2) + save_argv[save_argc++] = decoded_options[i].canonical_option[1]; + } + } + save_argv[save_argc] = NULL; + + gnat_argv = (char **) xmalloc (sizeof (save_argv[0])); + gnat_argv[0] = xstrdup (save_argv[0]); /* name of the command */ + gnat_argc = 1; +} + +/* Ada code requires variables for these settings rather than elements + of the global_options structure. */ +#undef optimize +#undef optimize_size +#undef flag_compare_debug +#undef flag_stack_check +int optimize; +int optimize_size; +int flag_compare_debug; +enum stack_check_type flag_stack_check = NO_STACK_CHECK; + +/* Settings adjustments after switches processing by the back-end. + Note that the front-end switches processing (Scan_Compiler_Arguments) + has not been done yet at this point! */ + +static bool +gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) +{ + /* Excess precision other than "fast" requires front-end support. */ + if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD + && TARGET_FLT_EVAL_METHOD_NON_DEFAULT) + sorry ("-fexcess-precision=standard for Ada"); + flag_excess_precision_cmdline = EXCESS_PRECISION_FAST; + + /* ??? The warning machinery is outsmarted by Ada. */ + warn_unused_parameter = 0; + + /* No psABI change warnings for Ada. */ + warn_psabi = 0; + + /* No caret by default for Ada. */ + if (!global_options_set.x_flag_diagnostics_show_caret) + global_dc->show_caret = false; + + optimize = global_options.x_optimize; + optimize_size = global_options.x_optimize_size; + flag_compare_debug = global_options.x_flag_compare_debug; + flag_stack_check = global_options.x_flag_stack_check; + + return false; +} + +/* Here is the function to handle the compiler error processing in GCC. */ + +static void +internal_error_function (diagnostic_context *context, + const char *msgid, va_list *ap) +{ + text_info tinfo; + char *buffer, *p, *loc; + String_Template temp, temp_loc; + Fat_Pointer fp, fp_loc; + expanded_location s; + + /* Warn if plugins present. */ + warn_if_plugins (); + + /* Reset the pretty-printer. */ + pp_clear_output_area (context->printer); + + /* Format the message into the pretty-printer. */ + tinfo.format_spec = msgid; + tinfo.args_ptr = ap; + tinfo.err_no = errno; + pp_format_verbatim (context->printer, &tinfo); + + /* Extract a (writable) pointer to the formatted text. */ + buffer = xstrdup (pp_formatted_text (context->printer)); + + /* Go up to the first newline. */ + for (p = buffer; *p; p++) + if (*p == '\n') + { + *p = '\0'; + break; + } + + temp.Low_Bound = 1; + temp.High_Bound = p - buffer; + fp.Bounds = &temp; + fp.Array = buffer; + + s = expand_location (input_location); + if (context->show_column && s.column != 0) + asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column); + else + asprintf (&loc, "%s:%d", s.file, s.line); + temp_loc.Low_Bound = 1; + temp_loc.High_Bound = strlen (loc); + fp_loc.Bounds = &temp_loc; + fp_loc.Array = loc; + + Current_Error_Node = error_gnat_node; + Compiler_Abort (fp, -1, fp_loc); +} + +/* Perform all the initialization steps that are language-specific. */ + +static bool +gnat_init (void) +{ + /* Do little here, most of the standard declarations are set up after the + front-end has been run. Use the same `char' as C, this doesn't really + matter since we'll use the explicit `unsigned char' for Character. */ + build_common_tree_nodes (flag_signed_char, false); + + /* In Ada, we use an unsigned 8-bit type for the default boolean type. */ + boolean_type_node = make_unsigned_type (8); + TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE); + SET_TYPE_RM_MAX_VALUE (boolean_type_node, + build_int_cst (boolean_type_node, 1)); + SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1)); + boolean_true_node = TYPE_MAX_VALUE (boolean_type_node); + boolean_false_node = TYPE_MIN_VALUE (boolean_type_node); + + sbitsize_one_node = sbitsize_int (1); + sbitsize_unit_node = sbitsize_int (BITS_PER_UNIT); + + ptr_void_type_node = build_pointer_type (void_type_node); + + /* Show that REFERENCE_TYPEs are internal and should be Pmode. */ + internal_reference_types (); + + /* Register our internal error function. */ + global_dc->internal_error = &internal_error_function; + + return true; +} + +/* If we are using the GCC mechanism to process exception handling, we + have to register the personality routine for Ada and to initialize + various language dependent hooks. */ + +void +gnat_init_gcc_eh (void) +{ + /* We shouldn't do anything if the No_Exceptions_Handler pragma is set, + though. This could for instance lead to the emission of tables with + references to symbols (such as the Ada eh personality routine) within + libraries we won't link against. */ + if (No_Exception_Handlers_Set ()) + return; + + /* Tell GCC we are handling cleanup actions through exception propagation. + This opens possibilities that we don't take advantage of yet, but is + nonetheless necessary to ensure that fixup code gets assigned to the + right exception regions. */ + using_eh_for_cleanups (); + + /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers + the generation of the necessary exception tables. The second one is + useful for two reasons: 1/ we map some asynchronous signals like SEGV to + exceptions, so we need to ensure that the insns which can lead to such + signals are correctly attached to the exception region they pertain to, + 2/ Some calls to pure subprograms are handled as libcall blocks and then + marked as "cannot trap" if the flag is not set (see emit_libcall_block). + We should not let this be since it is possible for such calls to actually + raise in Ada. */ + flag_exceptions = 1; + flag_non_call_exceptions = 1; + + init_eh (); +} + +/* Print language-specific items in declaration NODE. */ + +static void +gnat_print_decl (FILE *file, tree node, int indent) +{ + switch (TREE_CODE (node)) + { + case CONST_DECL: + print_node (file, "corresponding var", + DECL_CONST_CORRESPONDING_VAR (node), indent + 4); + break; + + case FIELD_DECL: + print_node (file, "original field", DECL_ORIGINAL_FIELD (node), + indent + 4); + break; + + case VAR_DECL: + if (DECL_LOOP_PARM_P (node)) + print_node (file, "induction var", DECL_INDUCTION_VAR (node), + indent + 4); + else + print_node (file, "renamed object", DECL_RENAMED_OBJECT (node), + indent + 4); + break; + + default: + break; + } +} + +/* Print language-specific items in type NODE. */ + +static void +gnat_print_type (FILE *file, tree node, int indent) +{ + switch (TREE_CODE (node)) + { + case FUNCTION_TYPE: + print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4); + break; + + case INTEGER_TYPE: + if (TYPE_MODULAR_P (node)) + print_node_brief (file, "modulus", TYPE_MODULUS (node), indent + 4); + else if (TYPE_HAS_ACTUAL_BOUNDS_P (node)) + print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node), + indent + 4); + else if (TYPE_VAX_FLOATING_POINT_P (node)) + ; + else + print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4); + + /* ... fall through ... */ + + case ENUMERAL_TYPE: + case BOOLEAN_TYPE: + print_node_brief (file, "RM size", TYPE_RM_SIZE (node), indent + 4); + + /* ... fall through ... */ + + case REAL_TYPE: + print_node_brief (file, "RM min", TYPE_RM_MIN_VALUE (node), indent + 4); + print_node_brief (file, "RM max", TYPE_RM_MAX_VALUE (node), indent + 4); + break; + + case ARRAY_TYPE: + print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4); + break; + + case VECTOR_TYPE: + print_node (file,"representative array", + TYPE_REPRESENTATIVE_ARRAY (node), indent + 4); + break; + + case RECORD_TYPE: + if (TYPE_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node)) + print_node (file, "unconstrained array", + TYPE_UNCONSTRAINED_ARRAY (node), indent + 4); + else + print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4); + break; + + case UNION_TYPE: + case QUAL_UNION_TYPE: + print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4); + break; + + default: + break; + } +} + +/* Return the name to be printed for DECL. */ + +static const char * +gnat_printable_name (tree decl, int verbosity) +{ + const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl)); + char *ada_name = (char *) ggc_alloc_atomic (strlen (coded_name) * 2 + 60); + + __gnat_decode (coded_name, ada_name, 0); + + if (verbosity == 2 && !DECL_IS_BUILTIN (decl)) + { + Set_Identifier_Casing (ada_name, DECL_SOURCE_FILE (decl)); + return ggc_strdup (Name_Buffer); + } + + return ada_name; +} + +/* Return the name to be used in DWARF debug info for DECL. */ + +static const char * +gnat_dwarf_name (tree decl, int verbosity ATTRIBUTE_UNUSED) +{ + gcc_assert (DECL_P (decl)); + return (const char *) IDENTIFIER_POINTER (DECL_NAME (decl)); +} + +/* Return the descriptive type associated with TYPE, if any. */ + +static tree +gnat_descriptive_type (const_tree type) +{ + if (TYPE_STUB_DECL (type)) + return DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)); + else + return NULL_TREE; +} + +/* Return true if types T1 and T2 are identical for type hashing purposes. + Called only after doing all language independent checks. At present, + this function is only called when both types are FUNCTION_TYPE. */ + +static bool +gnat_type_hash_eq (const_tree t1, const_tree t2) +{ + gcc_assert (TREE_CODE (t1) == FUNCTION_TYPE); + return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2), + TYPE_RETURN_UNCONSTRAINED_P (t2), + TYPE_RETURN_BY_DIRECT_REF_P (t2), + TREE_ADDRESSABLE (t2)); +} + +/* Do nothing (return the tree node passed). */ + +static tree +gnat_return_tree (tree t) +{ + return t; +} + +/* Get the alias set corresponding to a type or expression. */ + +static alias_set_type +gnat_get_alias_set (tree type) +{ + /* If this is a padding type, use the type of the first field. */ + if (TYPE_IS_PADDING_P (type)) + return get_alias_set (TREE_TYPE (TYPE_FIELDS (type))); + + /* If the type is an unconstrained array, use the type of the + self-referential array we make. */ + else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) + return + get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type))))); + + /* If the type can alias any other types, return the alias set 0. */ + else if (TYPE_P (type) + && TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (type))) + return 0; + + return -1; +} + +/* GNU_TYPE is a type. Return its maximum size in bytes, if known, + as a constant when possible. */ + +static tree +gnat_type_max_size (const_tree gnu_type) +{ + /* First see what we can get from TYPE_SIZE_UNIT, which might not + be constant even for simple expressions if it has already been + elaborated and possibly 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, + which should stay untouched. */ + if (!host_integerp (max_unitsize, 1) + && RECORD_OR_UNION_TYPE_P (gnu_type) + && !TYPE_FAT_POINTER_P (gnu_type) + && TYPE_ADA_SIZE (gnu_type)) + { + tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true); + + /* If we have succeeded in finding a constant, round it up to the + type's alignment and return the result in 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 subtype of an integral type. Set LOWVAL to the low bound + and HIGHVAL to the high bound, respectively. */ + +static void +gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval) +{ + *lowval = TYPE_MIN_VALUE (gnu_type); + *highval = TYPE_MAX_VALUE (gnu_type); +} + +/* GNU_TYPE is the type of a subprogram parameter. Determine if it should be + passed by reference by default. */ + +bool +default_pass_by_ref (tree gnu_type) +{ + /* We pass aggregates by reference if they are sufficiently large for + their alignment. The ratio is somewhat arbitrary. We also pass by + reference if the target machine would either pass or return by + reference. Strictly speaking, we need only check the return if this + is an In Out parameter, but it's probably best to err on the side of + passing more things by reference. */ + + if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true)) + return true; + + if (targetm.calls.return_in_memory (gnu_type, NULL_TREE)) + return true; + + if (AGGREGATE_TYPE_P (gnu_type) + && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type)) + || 0 < compare_tree_int (TYPE_SIZE_UNIT (gnu_type), + TYPE_ALIGN (gnu_type)))) + return true; + + return false; +} + +/* GNU_TYPE is the type of a subprogram parameter. Determine if it must be + passed by reference. */ + +bool +must_pass_by_ref (tree gnu_type) +{ + /* We pass only unconstrained objects, those required by the language + to be passed by reference, and objects of variable size. The latter + is more efficient, avoids problems with variable size temporaries, + and does not produce compatibility problems with C, since C does + not have such objects. */ + return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE + || TYPE_IS_BY_REFERENCE_P (gnu_type) + || (TYPE_SIZE_UNIT (gnu_type) + && TREE_CODE (TYPE_SIZE_UNIT (gnu_type)) != INTEGER_CST)); +} + +/* This function is called by the front-end to enumerate all the supported + modes for the machine, as well as some predefined C types. F is a function + which is called back with the parameters as listed below, first a string, + then seven ints. The name is any arbitrary null-terminated string and has + no particular significance, except for the case of predefined C types, where + it should be the name of the C type. For integer types, only signed types + should be listed, unsigned versions are assumed. The order of types should + be in order of preference, with the smallest/cheapest types first. + + In particular, C predefined types should be listed before other types, + binary floating point types before decimal ones, and narrower/cheaper + type versions before more expensive ones. In type selection the first + matching variant will be used. + + NAME pointer to first char of type name + DIGS number of decimal digits for floating-point modes, else 0 + COMPLEX_P nonzero is this represents a complex mode + COUNT count of number of items, nonzero for vector mode + FLOAT_REP Float_Rep_Kind for FP, otherwise undefined + PRECISION number of bits used to store data + SIZE number of bits occupied by the mode + ALIGN number of bits to which mode is aligned. */ + +void +enumerate_modes (void (*f) (const char *, int, int, int, int, int, int, int)) +{ + const tree c_types[] + = { float_type_node, double_type_node, long_double_type_node }; + const char *const c_names[] + = { "float", "double", "long double" }; + int iloop; + + for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++) + { + enum machine_mode i = (enum machine_mode) iloop; + enum machine_mode inner_mode = i; + bool float_p = false; + bool complex_p = false; + bool vector_p = false; + bool skip_p = false; + int digs = 0; + unsigned int nameloop; + Float_Rep_Kind float_rep = IEEE_Binary; /* Until proven otherwise */ + + switch (GET_MODE_CLASS (i)) + { + case MODE_INT: + break; + case MODE_FLOAT: + float_p = true; + break; + case MODE_COMPLEX_INT: + complex_p = true; + inner_mode = GET_MODE_INNER (i); + break; + case MODE_COMPLEX_FLOAT: + float_p = true; + complex_p = true; + inner_mode = GET_MODE_INNER (i); + break; + case MODE_VECTOR_INT: + vector_p = true; + inner_mode = GET_MODE_INNER (i); + break; + case MODE_VECTOR_FLOAT: + float_p = true; + vector_p = true; + inner_mode = GET_MODE_INNER (i); + break; + default: + skip_p = true; + } + + if (float_p) + { + const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode); + + /* ??? Cope with the ghost XFmode of the ARM port. */ + if (!fmt) + continue; + + if (fmt->b == 2) + digs = (fmt->p - 1) * 1233 / 4096; /* scale by log (2) */ + + else if (fmt->b == 10) + digs = fmt->p; + + else + gcc_unreachable(); + + if (fmt == &vax_f_format + || fmt == &vax_d_format + || fmt == &vax_g_format) + float_rep = VAX_Native; + } + + /* First register any C types for this mode that the front end + may need to know about, unless the mode should be skipped. */ + if (!skip_p && !vector_p) + for (nameloop = 0; nameloop < ARRAY_SIZE (c_types); nameloop++) + { + tree type = c_types[nameloop]; + const char *name = c_names[nameloop]; + + if (TYPE_MODE (type) == i) + { + f (name, digs, complex_p, 0, float_rep, TYPE_PRECISION (type), + TREE_INT_CST_LOW (TYPE_SIZE (type)), TYPE_ALIGN (type)); + skip_p = true; + } + } + + /* If no predefined C types were found, register the mode itself. */ + if (!skip_p) + f (GET_MODE_NAME (i), digs, complex_p, + vector_p ? GET_MODE_NUNITS (i) : 0, float_rep, + GET_MODE_PRECISION (i), GET_MODE_BITSIZE (i), + GET_MODE_ALIGNMENT (i)); + } +} + +/* Return the size of the FP mode with precision PREC. */ + +int +fp_prec_to_size (int prec) +{ + enum machine_mode mode; + + for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode; + mode = GET_MODE_WIDER_MODE (mode)) + if (GET_MODE_PRECISION (mode) == prec) + return GET_MODE_BITSIZE (mode); + + gcc_unreachable (); +} + +/* Return the precision of the FP mode with size SIZE. */ + +int +fp_size_to_prec (int size) +{ + enum machine_mode mode; + + for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode; + mode = GET_MODE_WIDER_MODE (mode)) + if (GET_MODE_BITSIZE (mode) == size) + return GET_MODE_PRECISION (mode); + + gcc_unreachable (); +} + +static GTY(()) tree gnat_eh_personality_decl; + +/* Return the GNAT personality function decl. */ + +static tree +gnat_eh_personality (void) +{ + if (!gnat_eh_personality_decl) + gnat_eh_personality_decl = build_personality_function ("gnat"); + return gnat_eh_personality_decl; +} + +/* Initialize language-specific bits of tree_contains_struct. */ + +static void +gnat_init_ts (void) +{ + MARK_TS_COMMON (UNCONSTRAINED_ARRAY_TYPE); + + MARK_TS_TYPED (UNCONSTRAINED_ARRAY_REF); + MARK_TS_TYPED (NULL_EXPR); + MARK_TS_TYPED (PLUS_NOMOD_EXPR); + MARK_TS_TYPED (MINUS_NOMOD_EXPR); + MARK_TS_TYPED (ATTR_ADDR_EXPR); + MARK_TS_TYPED (STMT_STMT); + MARK_TS_TYPED (LOOP_STMT); + MARK_TS_TYPED (EXIT_STMT); +} + +/* Definitions for our language-specific hooks. */ + +#undef LANG_HOOKS_NAME +#define LANG_HOOKS_NAME "GNU Ada" +#undef LANG_HOOKS_IDENTIFIER_SIZE +#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) +#undef LANG_HOOKS_INIT +#define LANG_HOOKS_INIT gnat_init +#undef LANG_HOOKS_OPTION_LANG_MASK +#define LANG_HOOKS_OPTION_LANG_MASK gnat_option_lang_mask +#undef LANG_HOOKS_INIT_OPTIONS_STRUCT +#define LANG_HOOKS_INIT_OPTIONS_STRUCT gnat_init_options_struct +#undef LANG_HOOKS_INIT_OPTIONS +#define LANG_HOOKS_INIT_OPTIONS gnat_init_options +#undef LANG_HOOKS_HANDLE_OPTION +#define LANG_HOOKS_HANDLE_OPTION gnat_handle_option +#undef LANG_HOOKS_POST_OPTIONS +#define LANG_HOOKS_POST_OPTIONS gnat_post_options +#undef LANG_HOOKS_PARSE_FILE +#define LANG_HOOKS_PARSE_FILE gnat_parse_file +#undef LANG_HOOKS_TYPE_HASH_EQ +#define LANG_HOOKS_TYPE_HASH_EQ gnat_type_hash_eq +#undef LANG_HOOKS_GETDECLS +#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v +#undef LANG_HOOKS_PUSHDECL +#define LANG_HOOKS_PUSHDECL gnat_return_tree +#undef LANG_HOOKS_WRITE_GLOBALS +#define LANG_HOOKS_WRITE_GLOBALS gnat_write_global_declarations +#undef LANG_HOOKS_GET_ALIAS_SET +#define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set +#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_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_GIMPLIFY_EXPR +#define LANG_HOOKS_GIMPLIFY_EXPR gnat_gimplify_expr +#undef LANG_HOOKS_TYPE_FOR_MODE +#define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode +#undef LANG_HOOKS_TYPE_FOR_SIZE +#define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size +#undef LANG_HOOKS_TYPES_COMPATIBLE_P +#define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p +#undef LANG_HOOKS_GET_SUBRANGE_BOUNDS +#define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds +#undef LANG_HOOKS_DESCRIPTIVE_TYPE +#define LANG_HOOKS_DESCRIPTIVE_TYPE gnat_descriptive_type +#undef LANG_HOOKS_ATTRIBUTE_TABLE +#define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table +#undef LANG_HOOKS_BUILTIN_FUNCTION +#define LANG_HOOKS_BUILTIN_FUNCTION gnat_builtin_function +#undef LANG_HOOKS_EH_PERSONALITY +#define LANG_HOOKS_EH_PERSONALITY gnat_eh_personality +#undef LANG_HOOKS_DEEP_UNSHARING +#define LANG_HOOKS_DEEP_UNSHARING true +#undef LANG_HOOKS_INIT_TS +#define LANG_HOOKS_INIT_TS gnat_init_ts + +struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; + +#include "gt-ada-misc.h" |