diff options
Diffstat (limited to 'gcc/ada/gcc-interface/misc.c')
| -rw-r--r-- | gcc/ada/gcc-interface/misc.c | 1421 |
1 files changed, 0 insertions, 1421 deletions
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c deleted file mode 100644 index 2caa83f..0000000 --- a/gcc/ada/gcc-interface/misc.c +++ /dev/null @@ -1,1421 +0,0 @@ -/**************************************************************************** - * * - * GNAT COMPILER COMPONENTS * - * * - * M I S C * - * * - * C Implementation File * - * * - * Copyright (C) 1992-2021, 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 "target.h" -#include "tree.h" -#include "diagnostic.h" -#include "opts.h" -#include "alias.h" -#include "fold-const.h" -#include "stor-layout.h" -#include "print-tree.h" -#include "toplev.h" -#include "tree-pass.h" -#include "langhooks.h" -#include "langhooks-def.h" -#include "plugin.h" -#include "calls.h" /* For pass_by_reference. */ -#include "dwarf2out.h" - -#include "ada.h" -#include "adadecode.h" -#include "types.h" -#include "atree.h" -#include "namet.h" -#include "nlists.h" -#include "snames.h" -#include "uintp.h" -#include "fe.h" -#include "sinfo.h" -#include "einfo.h" -#include "ada-tree.h" -#include "gigi.h" - -/* 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 generated by the binder for all Ada programs. */ -extern int gnat_argc; -extern char **gnat_argv; - -/* Ada code requires variables for these settings rather than elements - of the global_options structure because they are imported. */ -#undef gnat_encodings -enum dwarf_gnat_encodings gnat_encodings = DWARF_GNAT_ENCODINGS_DEFAULT; - -#undef optimize -int optimize; - -#undef optimize_size -int optimize_size; - -#undef flag_short_enums -int flag_short_enums; - -#undef flag_stack_check -enum stack_check_type flag_stack_check = NO_STACK_CHECK; - -#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 (); - - /* Write the global declarations. */ - gnat_write_global_declarations (); -} - -/* 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, HOST_WIDE_INT value, - int kind, location_t loc, - const struct cl_option_handlers *handlers) -{ - 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, true, 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_fdump_scos: - case OPT_nostdinc: - case OPT_nostdlib: - /* These are handled by the front-end. */ - break; - - case OPT_fshort_enums: - case OPT_fsigned_char: - case OPT_funsigned_char: - /* These are handled by the middle-end. */ - break; - - case OPT_fbuiltin_printf: - /* This is ignored in Ada but needs to be accepted so it can be - defaulted. */ - 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 don't care about errno in Ada and it causes __builtin_sqrt to - call the libm function rather than do it inline. */ - opts->x_flag_errno_math = 0; - opts->frontend_set_flag_errno_math = true; -} - -/* 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. */ - save_argv = XNEWVEC (const char *, 2 * decoded_options_count + 1); - save_argc = 0; - for (unsigned int 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; - - /* Pass just the name of the command through the regular channel. */ - gnat_argv = (char **) xmalloc (sizeof (char *)); - gnat_argv[0] = xstrdup (save_argv[0]); - gnat_argc = 1; -} - -/* 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 == EXCESS_PRECISION_STANDARD) - sorry ("%<-fexcess-precision=standard%> for Ada"); - else if (flag_excess_precision == EXCESS_PRECISION_FLOAT16) - sorry ("%<-fexcess-precision=16%> for Ada"); - - flag_excess_precision = EXCESS_PRECISION_FAST; - - /* No psABI change warnings for Ada. */ - warn_psabi = 0; - - /* No return type warnings for Ada. */ - warn_return_type = 0; - - /* No string overflow warnings for Ada. */ - warn_stringop_overflow = 0; - - /* No caret by default for Ada. */ - if (!OPTION_SET_P (flag_diagnostics_show_caret)) - global_dc->show_caret = false; - - /* Copy global settings to local versions. */ - gnat_encodings = global_options.x_gnat_encodings; - optimize = global_options.x_optimize; - optimize_size = global_options.x_optimize_size; - flag_stack_check = global_options.x_flag_stack_check; - flag_short_enums = global_options.x_flag_short_enums; - - /* Unfortunately the post_options hook is called before the value of - flag_short_enums is autodetected, if need be. Mimic the process - for our private flag_short_enums. */ - if (flag_short_enums == 2) - flag_short_enums = targetm.default_short_enums (); - - 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; - String_Pointer sp, sp_loc; - expanded_location xloc; - - /* Warn if plugins present. */ - warn_if_plugins (); - - /* Dump the representation of the function. */ - emergency_dump_function (); - - /* 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; - sp.Bounds = &temp; - sp.Array = buffer; - - xloc = expand_location (input_location); - if (context->show_column && xloc.column != 0) - loc = xasprintf ("%s:%d:%d", xloc.file, xloc.line, xloc.column); - else - loc = xasprintf ("%s:%d", xloc.file, xloc.line); - temp_loc.Low_Bound = 1; - temp_loc.High_Bound = strlen (loc); - sp_loc.Bounds = &temp_loc; - sp_loc.Array = loc; - - Compiler_Abort (sp, sp_loc, true); -} - -/* 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 for Interfaces.C. */ - build_common_tree_nodes (flag_signed_char); - - /* 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); - - /* In Ada, we do not use location ranges. */ - line_table->default_range_bits = 0; - - /* Register our internal error function. */ - global_dc->internal_error = &internal_error_function; - - return true; -} - -/* Initialize the GCC support for exception handling. */ - -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, -fnon-call-exceptions and -fdelete-dead-exceptions. - The first one activates the support for exceptions in the compiler. - 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. - The third one is an optimization that makes it possible to delete dead - instructions that may throw exceptions, most notably loads and stores, - as permitted in Ada. - Turn off -faggressive-loop-optimizations because it may optimize away - out-of-bound array accesses that we want to be able to catch. - If checks are disabled, we use the same settings as the C++ compiler, - except for the runtime on platforms where S'Machine_Overflow is true - because the runtime depends on FP (hardware) checks being properly - handled despite being compiled in -gnatp mode. */ - flag_exceptions = 1; - flag_delete_dead_exceptions = 1; - if (Suppress_Checks) - { - if (!OPTION_SET_P (flag_non_call_exceptions)) - flag_non_call_exceptions = Machine_Overflows_On_Target && GNAT_Mode; - } - else - { - if (!OPTION_SET_P (flag_non_call_exceptions)) - flag_non_call_exceptions = 1; - flag_aggressive_loop_optimizations = 0; - warn_aggressive_loop_optimizations = 0; - } - - init_eh (); -} - -/* Initialize the GCC support for floating-point operations. */ - -void -gnat_init_gcc_fp (void) -{ - /* Disable FP optimizations that ignore the signedness of zero if - S'Signed_Zeros is true, but don't override the user if not. */ - if (Signed_Zeros_On_Target) - flag_signed_zeros = 1; - else if (!OPTION_SET_P (flag_signed_zeros)) - flag_signed_zeros = 0; - - /* Assume that FP operations can trap if S'Machine_Overflow is true, - but don't override the user if not. */ - if (Machine_Overflows_On_Target) - flag_trapping_math = 1; - else if (!OPTION_SET_P (flag_trapping_math)) - flag_trapping_math = 0; -} - -/* 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); - 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: - case METHOD_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_FIXED_POINT_P (node)) - print_node (file, "scale factor", TYPE_SCALE_FACTOR (node), - indent + 4); - else if (TYPE_HAS_ACTUAL_BOUNDS_P (node)) - print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node), - indent + 4); - 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; - } - - if (TYPE_CAN_HAVE_DEBUG_TYPE_P (node) && TYPE_DEBUG_TYPE (node)) - print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), indent + 4); - - if (TYPE_IMPL_PACKED_ARRAY_P (node) && TYPE_ORIGINAL_PACKED_ARRAY (node)) - print_node_brief (file, "original packed array", - TYPE_ORIGINAL_PACKED_ARRAY (node), indent + 4); -} - -/* 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_UNDECLARED_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 the underlying base type of an enumeration type. */ - -static tree -gnat_enum_underlying_base_type (const_tree) -{ - /* Enumeration types are base types in Ada. */ - return void_type_node; -} - -/* Return the type to be used for debugging information instead of TYPE or - NULL_TREE if TYPE is fine. */ - -static tree -gnat_get_debug_type (const_tree type) -{ - if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type)) - return TYPE_DEBUG_TYPE (type); - else - return NULL_TREE; -} - -/* Provide information in INFO for debugging output about the TYPE fixed-point - type. Return whether TYPE is handled. */ - -static bool -gnat_get_fixed_point_type_info (const_tree type, - struct fixed_point_type_info *info) -{ - tree scale_factor; - - /* Do nothing if the GNAT encodings are used. */ - if (!TYPE_IS_FIXED_POINT_P (type) - || gnat_encodings == DWARF_GNAT_ENCODINGS_ALL) - return false; - - scale_factor = TYPE_SCALE_FACTOR (type); - - /* We expect here only a finite set of pattern. See fixed-point types - handling in gnat_to_gnu_entity. */ - - if (TREE_CODE (scale_factor) == RDIV_EXPR) - { - tree num = TREE_OPERAND (scale_factor, 0); - tree den = TREE_OPERAND (scale_factor, 1); - - /* See if we have a binary or decimal scale. */ - if (TREE_CODE (den) == POWER_EXPR) - { - tree base = TREE_OPERAND (den, 0); - tree exponent = TREE_OPERAND (den, 1); - - /* We expect the scale factor to be 1 / 2 ** N or 1 / 10 ** N. */ - gcc_assert (num == integer_one_node - && TREE_CODE (base) == INTEGER_CST - && TREE_CODE (exponent) == INTEGER_CST); - - switch (tree_to_shwi (base)) - { - case 2: - info->scale_factor_kind = fixed_point_scale_factor_binary; - info->scale_factor.binary = -tree_to_shwi (exponent); - return true; - - case 10: - info->scale_factor_kind = fixed_point_scale_factor_decimal; - info->scale_factor.decimal = -tree_to_shwi (exponent); - return true; - - default: - gcc_unreachable (); - } - } - - /* If we reach this point, we are handling an arbitrary scale factor. We - expect N / D with constant operands. */ - gcc_assert (TREE_CODE (num) == INTEGER_CST - && TREE_CODE (den) == INTEGER_CST); - - info->scale_factor_kind = fixed_point_scale_factor_arbitrary; - info->scale_factor.arbitrary.numerator = num; - info->scale_factor.arbitrary.denominator = den; - return true; - } - - gcc_unreachable (); -} - -/* Return true if types T1 and T2 are identical for type hashing purposes. - Called only after doing all language independent checks. At present, - this is only called when both types are FUNCTION_TYPE or METHOD_TYPE. */ - -static bool -gnat_type_hash_eq (const_tree t1, const_tree t2) -{ - gcc_assert (FUNC_OR_METHOD_TYPE_P (t1) && TREE_CODE (t1) == TREE_CODE (t2)); - 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 this is an extra subtype, use the base type. */ - else if (TYPE_IS_EXTRA_SUBTYPE_P (type)) - return get_alias_set (get_base_type (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_IS_DUMMY_P (type) - && TYPE_UNIVERSAL_ALIASING_P (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_size_unit = 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 (!tree_fits_uhwi_p (max_size_unit) - && RECORD_OR_UNION_TYPE_P (gnu_type) - && !TYPE_FAT_POINTER_P (gnu_type) - && TYPE_ADA_SIZE (gnu_type)) - { - tree max_ada_size = 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 (tree_fits_uhwi_p (max_ada_size)) - max_size_unit - = size_binop (EXACT_DIV_EXPR, - round_up (max_ada_size, TYPE_ALIGN (gnu_type)), - bitsize_unit_node); - } - - return max_size_unit; -} - -static tree get_array_bit_stride (tree); - -/* Provide information in INFO for debug output about the TYPE array type. - Return whether TYPE is handled. */ - -static bool -gnat_get_array_descr_info (const_tree const_type, - struct array_descr_info *info) -{ - tree type = const_cast<tree> (const_type); - tree first_dimen, dimen; - bool is_packed_array, is_array; - int i; - - /* Temporaries created in the first pass and used in the second one for thin - pointers. The first one is an expression that yields the template record - from the base address (i.e. the PLACEHOLDER_EXPR). The second one is just - a cursor through this record's fields. */ - tree thinptr_template_expr = NULL_TREE; - tree thinptr_bound_field = NULL_TREE; - - /* If we have an implementation type for a packed array, get the orignial - array type. */ - if (TYPE_IMPL_PACKED_ARRAY_P (type) && TYPE_ORIGINAL_PACKED_ARRAY (type)) - { - type = TYPE_ORIGINAL_PACKED_ARRAY (type); - is_packed_array = true; - } - else - is_packed_array = false; - - /* First pass: gather all information about this array except everything - related to dimensions. */ - - /* Only handle ARRAY_TYPE nodes that come from GNAT. */ - if (TREE_CODE (type) == ARRAY_TYPE - && TYPE_DOMAIN (type) - && TYPE_INDEX_TYPE (TYPE_DOMAIN (type))) - { - is_array = true; - first_dimen = type; - } - - /* As well as array types embedded in a record type with their bounds. */ - else if (TREE_CODE (type) == RECORD_TYPE - && TYPE_CONTAINS_TEMPLATE_P (type) - && gnat_encodings != DWARF_GNAT_ENCODINGS_ALL) - { - /* This will be our base object address. Note that we assume that - pointers to this will actually point to the array field (thin - pointers are shifted). */ - tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type); - tree placeholder_addr - = build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr); - - tree bounds_field = TYPE_FIELDS (type); - tree bounds_type = TREE_TYPE (bounds_field); - tree array_field = DECL_CHAIN (bounds_field); - tree array_type = TREE_TYPE (array_field); - - /* Shift back the address to get the address of the template. */ - tree shift_amount - = fold_build1 (NEGATE_EXPR, sizetype, byte_position (array_field)); - tree template_addr - = build_binary_op (POINTER_PLUS_EXPR, TREE_TYPE (placeholder_addr), - placeholder_addr, shift_amount); - template_addr - = fold_convert (TYPE_POINTER_TO (bounds_type), template_addr); - - thinptr_template_expr - = build_unary_op (INDIRECT_REF, NULL_TREE, template_addr); - thinptr_bound_field = TYPE_FIELDS (bounds_type); - - is_array = false; - first_dimen = array_type; - } - - else - return false; - - /* Second pass: compute the remaining information: dimensions and - corresponding bounds. */ - - /* If this array has fortran convention, it's arranged in column-major - order, so our view here has reversed dimensions. */ - const bool convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen); - - if (TYPE_PACKED (first_dimen)) - is_packed_array = true; - - /* ??? For row major ordering, we probably want to emit nothing and - instead specify it as the default in Dw_TAG_compile_unit. */ - info->ordering = (convention_fortran_p - ? array_descr_ordering_column_major - : array_descr_ordering_row_major); - info->rank = NULL_TREE; - - /* Count the number of dimensions and determine the element type. */ - i = 1; - dimen = TREE_TYPE (first_dimen); - while (TREE_CODE (dimen) == ARRAY_TYPE && TYPE_MULTI_ARRAY_P (dimen)) - { - i++; - dimen = TREE_TYPE (dimen); - } - info->ndimensions = i; - info->element_type = dimen; - - /* Too many dimensions? Give up generating proper description: yield instead - nested arrays. Note that in this case, this hook is invoked once on each - intermediate array type: be consistent and output nested arrays for all - dimensions. */ - if (info->ndimensions > DWARF2OUT_ARRAY_DESCR_INFO_MAX_DIMEN - || TYPE_MULTI_ARRAY_P (first_dimen)) - { - info->ndimensions = 1; - info->element_type = TREE_TYPE (first_dimen); - } - - /* Now iterate over all dimensions in source order and fill the info - structure. */ - for (i = (convention_fortran_p ? info->ndimensions - 1 : 0), - dimen = first_dimen; - IN_RANGE (i, 0, info->ndimensions - 1); - i += (convention_fortran_p ? -1 : 1), - dimen = TREE_TYPE (dimen)) - { - /* We are interested in the stored bounds for the debug info. */ - tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen)); - - if (is_array) - { - /* GDB does not handle very well the self-referencial bound - expressions we are able to generate here for XUA types (they are - used only by XUP encodings) so avoid them in this case. Note that - there are two cases where we generate self-referencial bound - expressions: arrays that are constrained by record discriminants - and XUA types. */ - if (TYPE_CONTEXT (first_dimen) - && TREE_CODE (TYPE_CONTEXT (first_dimen)) != RECORD_TYPE - && CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (index_type)) - && gnat_encodings == DWARF_GNAT_ENCODINGS_ALL) - { - info->dimen[i].lower_bound = NULL_TREE; - info->dimen[i].upper_bound = NULL_TREE; - } - else - { - info->dimen[i].lower_bound - = maybe_character_value (TYPE_MIN_VALUE (index_type)); - info->dimen[i].upper_bound - = maybe_character_value (TYPE_MAX_VALUE (index_type)); - } - } - - /* This is a thin pointer. */ - else - { - info->dimen[i].lower_bound - = build_component_ref (thinptr_template_expr, thinptr_bound_field, - false); - thinptr_bound_field = DECL_CHAIN (thinptr_bound_field); - - info->dimen[i].upper_bound - = build_component_ref (thinptr_template_expr, thinptr_bound_field, - false); - thinptr_bound_field = DECL_CHAIN (thinptr_bound_field); - } - - /* The DWARF back-end will output BOUNDS_TYPE as the base type of - the array index, so get to the base type of INDEX_TYPE. */ - while (TREE_TYPE (index_type)) - index_type = TREE_TYPE (index_type); - - info->dimen[i].bounds_type = maybe_debug_type (index_type); - info->dimen[i].stride = NULL_TREE; - } - - /* These are Fortran-specific fields. They make no sense here. */ - info->allocated = NULL_TREE; - info->associated = NULL_TREE; - info->data_location = NULL_TREE; - - if (gnat_encodings != DWARF_GNAT_ENCODINGS_ALL) - { - /* When arrays contain dynamically-sized elements, we usually wrap them - in padding types, or we create constrained types for them. Then, if - such types are stripped in the debugging information output, the - debugger needs a way to know the size that is reserved for each - element. This is why we emit a stride in such situations. */ - tree source_element_type = info->element_type; - - while (true) - { - if (TYPE_DEBUG_TYPE (source_element_type)) - source_element_type = TYPE_DEBUG_TYPE (source_element_type); - else if (TYPE_IS_PADDING_P (source_element_type)) - source_element_type - = TREE_TYPE (TYPE_FIELDS (source_element_type)); - else - break; - } - - if (TREE_CODE (TYPE_SIZE_UNIT (source_element_type)) != INTEGER_CST) - { - info->stride = TYPE_SIZE_UNIT (info->element_type); - info->stride_in_bits = false; - } - - /* We need to specify a bit stride when it does not correspond to the - natural size of the contained elements. ??? Note that we do not - support packed records and nested packed arrays. */ - else if (is_packed_array) - { - info->stride = get_array_bit_stride (info->element_type); - info->stride_in_bits = true; - } - } - - return true; -} - -/* Given the component type COMP_TYPE of a packed array, return an expression - that computes the bit stride of this packed array. Return NULL_TREE when - unsuccessful. */ - -static tree -get_array_bit_stride (tree comp_type) -{ - struct array_descr_info info; - tree stride; - - /* Simple case: the array contains an integral type: return its RM size. */ - if (INTEGRAL_TYPE_P (comp_type)) - return TYPE_RM_SIZE (comp_type); - - /* Likewise for record or union types. */ - if (RECORD_OR_UNION_TYPE_P (comp_type) && !TYPE_FAT_POINTER_P (comp_type)) - return TYPE_ADA_SIZE (comp_type); - - /* The gnat_get_array_descr_info debug hook expects a debug tyoe. */ - comp_type = maybe_debug_type (comp_type); - - /* Otherwise, see if this is an array we can analyze; if it's not, punt. */ - memset (&info, 0, sizeof (info)); - if (!gnat_get_array_descr_info (comp_type, &info) || !info.stride) - return NULL_TREE; - - /* Otherwise, the array stride is the inner array's stride multiplied by the - number of elements it contains. Note that if the inner array is not - packed, then the stride is "natural" and thus does not deserve an - attribute. */ - stride = info.stride; - if (!info.stride_in_bits) - { - stride = fold_convert (bitsizetype, stride); - stride = build_binary_op (MULT_EXPR, bitsizetype, - stride, build_int_cst (bitsizetype, 8)); - } - - for (int i = 0; i < info.ndimensions; ++i) - { - tree count; - - if (!info.dimen[i].lower_bound || !info.dimen[i].upper_bound) - return NULL_TREE; - - /* Put in count an expression that computes the length of this - dimension. */ - count = build_binary_op (MINUS_EXPR, sbitsizetype, - fold_convert (sbitsizetype, - info.dimen[i].upper_bound), - fold_convert (sbitsizetype, - info.dimen[i].lower_bound)), - count = build_binary_op (PLUS_EXPR, sbitsizetype, - count, build_int_cst (sbitsizetype, 1)); - count = build_binary_op (MAX_EXPR, sbitsizetype, - count, - build_int_cst (sbitsizetype, 0)); - count = fold_convert (bitsizetype, count); - stride = build_binary_op (MULT_EXPR, bitsizetype, stride, count); - } - - return stride; -} - -/* 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); -} - -/* Return the bias of GNU_TYPE, if any. */ - -static tree -gnat_get_type_bias (const_tree gnu_type) -{ - if (TREE_CODE (gnu_type) == INTEGER_TYPE - && TYPE_BIASED_REPRESENTATION_P (gnu_type) - && gnat_encodings != DWARF_GNAT_ENCODINGS_ALL) - return TYPE_RM_MIN_VALUE (gnu_type); - - return NULL_TREE; -} - -/* 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 (AGGREGATE_TYPE_P (gnu_type) - && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type)) - || compare_tree_int (TYPE_SIZE_UNIT (gnu_type), - TYPE_ALIGN (gnu_type)) > 0)) - return true; - - if (pass_by_reference (NULL, function_arg_info (gnu_type, /*named=*/true))) - return true; - - if (targetm.calls.return_in_memory (gnu_type, NULL_TREE)) - 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)) -{ - tree const c_types[] - = { float_type_node, double_type_node, long_double_type_node }; - const char *const c_names[] - = { "float", "double", "long double" }; - int iloop; - - /* We are going to compute it below. */ - fp_arith_may_widen = false; - - for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++) - { - machine_mode i = (machine_mode) iloop; - 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; - - /* Be conservative and consider that floating-point arithmetics may - use wider intermediate results as soon as there is an extended - Motorola or Intel mode supported by the machine. */ - if (fmt == &ieee_extended_motorola_format - || fmt == &ieee_extended_intel_96_format - || fmt == &ieee_extended_intel_96_round_53_format - || fmt == &ieee_extended_intel_128_format) - { -#ifdef TARGET_FPMATH_DEFAULT - if (TARGET_FPMATH_DEFAULT == FPMATH_387) -#endif - fp_arith_may_widen = true; - } - - 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 (); - } - - /* 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. */ - int nunits, precision, bitsize; - if (!skip_p - && GET_MODE_NUNITS (i).is_constant (&nunits) - && GET_MODE_PRECISION (i).is_constant (&precision) - && GET_MODE_BITSIZE (i).is_constant (&bitsize)) - f (GET_MODE_NAME (i), digs, complex_p, - vector_p ? nunits : 0, float_rep, - precision, bitsize, GET_MODE_ALIGNMENT (i)); - } -} - -/* Return the size of the FP mode with precision PREC. */ - -int -fp_prec_to_size (int prec) -{ - opt_scalar_float_mode opt_mode; - - FOR_EACH_MODE_IN_CLASS (opt_mode, MODE_FLOAT) - { - scalar_float_mode mode = opt_mode.require (); - 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) -{ - opt_scalar_float_mode opt_mode; - - FOR_EACH_MODE_IN_CLASS (opt_mode, MODE_FLOAT) - { - scalar_mode mode = opt_mode.require (); - 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 (POWER_EXPR); - MARK_TS_TYPED (ATTR_ADDR_EXPR); - MARK_TS_TYPED (STMT_STMT); - MARK_TS_TYPED (LOOP_STMT); - MARK_TS_TYPED (EXIT_STMT); -} - -/* Return the size of a tree with CODE, which is a language-specific tree code - in category tcc_constant, tcc_exceptional or tcc_type. The default expects - never to be called. */ - -static size_t -gnat_tree_size (enum tree_code code) -{ - gcc_checking_assert (code >= NUM_TREE_CODES); - switch (code) - { - case UNCONSTRAINED_ARRAY_TYPE: - return sizeof (tree_type_non_common); - default: - gcc_unreachable (); - } -} - -/* Return the lang specific structure attached to NODE. Allocate it (cleared) - if needed. */ - -struct lang_type * -get_lang_specific (tree node) -{ - if (!TYPE_LANG_SPECIFIC (node)) - TYPE_LANG_SPECIFIC (node) = ggc_cleared_alloc<struct lang_type> (); - return TYPE_LANG_SPECIFIC (node); -} - -/* 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_TREE_SIZE -#define LANG_HOOKS_TREE_SIZE gnat_tree_size -#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 hook_tree_void_null -#undef LANG_HOOKS_PUSHDECL -#define LANG_HOOKS_PUSHDECL gnat_return_tree -#undef LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL -#define LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL hook_bool_const_tree_false -#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_ARRAY_DESCR_INFO -#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gnat_get_array_descr_info -#undef LANG_HOOKS_GET_SUBRANGE_BOUNDS -#define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds -#undef LANG_HOOKS_GET_TYPE_BIAS -#define LANG_HOOKS_GET_TYPE_BIAS gnat_get_type_bias -#undef LANG_HOOKS_DESCRIPTIVE_TYPE -#define LANG_HOOKS_DESCRIPTIVE_TYPE gnat_descriptive_type -#undef LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE -#define LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE gnat_enum_underlying_base_type -#undef LANG_HOOKS_GET_DEBUG_TYPE -#define LANG_HOOKS_GET_DEBUG_TYPE gnat_get_debug_type -#undef LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO -#define LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO gnat_get_fixed_point_type_info -#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_INIT_TS -#define LANG_HOOKS_INIT_TS gnat_init_ts -#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_CUSTOM_FUNCTION_DESCRIPTORS -#define LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS true - -struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; - -#include "gt-ada-misc.h" |