diff options
Diffstat (limited to 'gcc/ada/gcc-interface/misc.cc')
| -rw-r--r-- | gcc/ada/gcc-interface/misc.cc | 1421 |
1 files changed, 1421 insertions, 0 deletions
diff --git a/gcc/ada/gcc-interface/misc.cc b/gcc/ada/gcc-interface/misc.cc new file mode 100644 index 0000000..2caa83f --- /dev/null +++ b/gcc/ada/gcc-interface/misc.cc @@ -0,0 +1,1421 @@ +/**************************************************************************** + * * + * 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" |