OSDN Git Service

PR ada/51483
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / misc.c
index 43ed157..d6296b4 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                           C Implementation File                          *
  *                                                                          *
- *          Copyright (C) 1992-2010, Free Software Foundation, Inc.         *
+ *          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- *
  *                                                                          *
  ****************************************************************************/
 
-/* This file contains parts of the compiler that are required for interfacing
-   with GCC but otherwise do nothing and parts of Gigi that need to know
-   about GIMPLE.  */
-
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
@@ -43,6 +39,7 @@
 #include "opts.h"
 #include "options.h"
 #include "plugin.h"
+#include "real.h"
 #include "function.h"  /* For pass_by_reference.  */
 
 #include "ada.h"
 #include "ada-tree.h"
 #include "gigi.h"
 
-static bool gnat_init                  (void);
-static unsigned int gnat_option_lang_mask (void);
-static void gnat_init_options          (unsigned int,
-                                        struct cl_decoded_option *);
-static int gnat_handle_option          (size_t, const char *, int, int);
-static bool gnat_post_options          (const char **);
-static alias_set_type gnat_get_alias_set (tree);
-static void gnat_print_decl            (FILE *, tree, int);
-static void gnat_print_type            (FILE *, tree, int);
-static const char *gnat_printable_name (tree, int);
-static const char *gnat_dwarf_name     (tree, int);
-static tree gnat_return_tree           (tree);
-static void gnat_parse_file            (int);
-static void internal_error_function    (diagnostic_context *,
-                                        const char *, va_list *);
-static tree gnat_type_max_size         (const_tree);
-static void gnat_get_subrange_bounds   (const_tree, tree *, tree *);
-static tree gnat_eh_personality                (void);
-
-/* 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
-#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_HASH_TYPES
-#define LANG_HOOKS_HASH_TYPES          false
-#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_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
-
-struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
-
 /* This symbol needs to be defined for the front-end.  */
 void *callgraph_info_file = NULL;
 
-/* How much we want of our DWARF extensions.  Some of our dwarf+ extensions
-   are incompatible with regular GDB versions, so we must make sure to only
-   produce them on explicit request.  This is eventually reflected into the
-   use_gnu_debug_info_extensions common flag for later processing.  */
-static int gnat_dwarf_extensions = 0;
-
-/* Command-line argc and argv.  These variables are global
-   since they are imported in back_end.adb.  */
+/* 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;
 
@@ -156,16 +69,24 @@ const char **save_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);
+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 (int set_yydebug ATTRIBUTE_UNUSED)
+gnat_parse_file (void)
 {
   int seh[2];
 
@@ -186,50 +107,21 @@ gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 
 /* 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
-   it cannot decode.  Return the number of consecutive arguments from ARGV
-   that have been successfully decoded or 0 on failure.  */
+   are marked as Ada-specific.  Return true on success or false on failure.  */
 
-static int
-gnat_handle_option (size_t scode, const char *arg, int value,
-                   int kind ATTRIBUTE_UNUSED)
+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)
 {
-  const struct cl_option *option = &cl_options[scode];
   enum opt_code code = (enum opt_code) scode;
 
-  if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
-    {
-      error ("missing argument to \"-%s\"", option->opt_text);
-      return 1;
-    }
-
   switch (code)
     {
     case OPT_Wall:
       warn_unused = value;
       warn_uninitialized = value;
-      break;
-
-    case OPT_Wmissing_prototypes:
-    case OPT_Wstrict_prototypes:
-    case OPT_Wwrite_strings:
-    case OPT_Wlong_long:
-    case OPT_Wvariadic_macros:
-    case OPT_Wold_style_definition:
-    case OPT_Wmissing_format_attribute:
-    case OPT_Woverlength_strings:
-      /* These are used in the GCC Makefile.  */
-      break;
-
-    case OPT_feliminate_unused_debug_types:
-      /* We arrange for post_option to be able to only set the corresponding
-        flag to 1 when explicitly requested by the user.  We expect the
-        default flag value to be either 0 or positive, and expose a positive
-        -f as a negative value to post_option.  */
-      flag_eliminate_unused_debug_types = -value;
-      break;
-
-    case OPT_gdwarfplus:
-      gnat_dwarf_extensions = 1;
+      warn_maybe_uninitialized = value;
       break;
 
     case OPT_gant:
@@ -250,7 +142,7 @@ gnat_handle_option (size_t scode, const char *arg, int value,
       gcc_unreachable ();
     }
 
-  return 1;
+  return true;
 }
 
 /* Return language mask for option processing.  */
@@ -261,6 +153,15 @@ gnat_option_lang_mask (void)
   return CL_Ada;
 }
 
+/* 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;
+}
+
 /* Initialize for option processing.  */
 
 static void
@@ -269,36 +170,60 @@ gnat_init_options (unsigned int decoded_options_count,
 {
   /* 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.  */
+     ??? 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++)
     {
-      save_argv[save_argc++] = decoded_options[i].canonical_option[0];
-      if (decoded_options[i].canonical_option[1] != NULL)
-       save_argv[save_argc++] = decoded_options[i].canonical_option[1];
+      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;
-
-  /* Uninitialized really means uninitialized in Ada.  */
-  flag_zero_initialized_in_bss = 0;
 }
 
+/* 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;
+
 /* Post-switch processing.  */
 
-bool
+static bool
 gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
 {
-  /* Excess precision other than "fast" requires front-end
-     support.  */
+  /* 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");
@@ -310,18 +235,10 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
   /* No psABI change warnings for Ada.  */
   warn_psabi = 0;
 
-  /* Force eliminate_unused_debug_types to 0 unless an explicit positive
-     -f has been passed.  This forces the default to 0 for Ada, which might
-     differ from the common default.  */
-  if (flag_eliminate_unused_debug_types < 0)
-    flag_eliminate_unused_debug_types = 1;
-  else
-    flag_eliminate_unused_debug_types = 0;
-
-  /* Reflect the explicit request of DWARF extensions into the common
-     flag for use by later passes.  */
-  if (write_symbols == DWARF2_DEBUG)
-    use_gnu_debug_info_extensions = gnat_dwarf_extensions > 0;
+  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;
 }
@@ -388,18 +305,7 @@ 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);
-
-  /* In Ada, we use the unsigned type corresponding to the width of Pmode as
-     SIZETYPE.  In most cases when ptr_mode and Pmode differ, C will use the
-     width of ptr_mode for SIZETYPE, but we get better code using the width
-     of Pmode.  Note that, although we manipulate negative offsets for some
-     internal constructs and rely on compile time overflow detection in size
-     computations, using unsigned types for SIZETYPEs is fine since they are
-     treated specially by the middle-end, in particular sign-extended.  */
-  size_type_node = gnat_type_for_mode (Pmode, 1);
-  set_sizetype (size_type_node);
-  TYPE_NAME (sizetype) = get_identifier ("size_type");
+  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);
@@ -407,11 +313,11 @@ gnat_init (void)
   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);
 
-  build_common_tree_nodes_2 (0);
   sbitsize_one_node = sbitsize_int (1);
   sbitsize_unit_node = sbitsize_int (BITS_PER_UNIT);
-  boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
 
   ptr_void_type_node = build_pointer_type (void_type_node);
 
@@ -431,11 +337,6 @@ gnat_init (void)
 void
 gnat_init_gcc_eh (void)
 {
-#ifdef DWARF2_UNWIND_INFO
-  /* lang_dependent_init already called dwarf2out_frame_init if true.  */
-  int dwarf2out_frame_initialized = dwarf2out_do_frame ();
-#endif
-
   /* 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
@@ -462,10 +363,6 @@ gnat_init_gcc_eh (void)
   flag_non_call_exceptions = 1;
 
   init_eh ();
-#ifdef DWARF2_UNWIND_INFO
-  if (!dwarf2out_frame_initialized && dwarf2out_do_frame ())
-    dwarf2out_frame_init ();
-#endif
 }
 
 /* Print language-specific items in declaration NODE.  */
@@ -486,8 +383,12 @@ gnat_print_decl (FILE *file, tree node, int indent)
       break;
 
     case VAR_DECL:
-      print_node (file, "renamed object", DECL_RENAMED_OBJECT (node),
-                 indent + 4);
+      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:
@@ -585,6 +486,31 @@ gnat_dwarf_name (tree decl, int verbosity ATTRIBUTE_UNUSED)
   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
@@ -630,9 +556,8 @@ gnat_type_max_size (const_tree gnu_type)
   /* 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)
-      && (TREE_CODE (gnu_type) == RECORD_TYPE
-         || TREE_CODE (gnu_type) == UNION_TYPE
-         || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
+      && 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);
@@ -659,8 +584,8 @@ gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
   *highval = TYPE_MAX_VALUE (gnu_type);
 }
 
-/* GNU_TYPE is a type. Determine if it should be passed by reference by
-   default.  */
+/* 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)
@@ -672,7 +597,7 @@ default_pass_by_ref (tree gnu_type)
      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, 1))
+  if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true))
     return true;
 
   if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
@@ -687,8 +612,8 @@ default_pass_by_ref (tree gnu_type)
   return false;
 }
 
-/* GNU_TYPE is the type of a subprogram parameter.  Determine from the type if
-   it should be passed by reference. */
+/* 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)
@@ -699,11 +624,132 @@ must_pass_by_ref (tree gnu_type)
      and does not produce compatibility problems with C, since C does
      not have such objects.  */
   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
-         || TREE_ADDRESSABLE (gnu_type)
+         || TYPE_IS_BY_REFERENCE_P (gnu_type)
          || (TYPE_SIZE (gnu_type)
              && TREE_CODE (TYPE_SIZE (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
@@ -736,16 +782,96 @@ fp_size_to_prec (int size)
 
 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 (USING_SJLJ_EXCEPTIONS
-                                   ? "__gnat_eh_personality_sj"
-                                   : "__gnat_eh_personality");
-
+    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"