OSDN Git Service

PR middle-end/42068
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / utils.c
index 3375c40..5175654 100644 (file)
  *                                                                          *
  ****************************************************************************/
 
  *                                                                          *
  ****************************************************************************/
 
-/* We have attribute handlers using C specific format specifiers in warning
-   messages.  Make sure they are properly recognized.  */
-#define GCC_DIAG_STYLE __gcc_cdiag__
-
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
 #include "tm.h"
 #include "tree.h"
 #include "flags.h"
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
 #include "tm.h"
 #include "tree.h"
 #include "flags.h"
-#include "defaults.h"
 #include "toplev.h"
 #include "toplev.h"
+#include "rtl.h"
 #include "output.h"
 #include "ggc.h"
 #include "debug.h"
 #include "convert.h"
 #include "target.h"
 #include "function.h"
 #include "output.h"
 #include "ggc.h"
 #include "debug.h"
 #include "convert.h"
 #include "target.h"
 #include "function.h"
+#include "langhooks.h"
+#include "pointer-set.h"
 #include "cgraph.h"
 #include "cgraph.h"
+#include "tree-dump.h"
 #include "tree-inline.h"
 #include "tree-iterator.h"
 #include "gimple.h"
 #include "tree-inline.h"
 #include "tree-iterator.h"
 #include "gimple.h"
-#include "tree-dump.h"
-#include "pointer-set.h"
-#include "langhooks.h"
-#include "rtl.h"
 
 #include "ada.h"
 #include "types.h"
 
 #include "ada.h"
 #include "types.h"
 #include "ada-tree.h"
 #include "gigi.h"
 
 #include "ada-tree.h"
 #include "gigi.h"
 
-#ifndef MAX_FIXED_MODE_SIZE
-#define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode)
-#endif
-
 #ifndef MAX_BITS_PER_WORD
 #define MAX_BITS_PER_WORD  BITS_PER_WORD
 #endif
 #ifndef MAX_BITS_PER_WORD
 #define MAX_BITS_PER_WORD  BITS_PER_WORD
 #endif
 /* If nonzero, pretend we are allocating at global level.  */
 int force_global;
 
 /* If nonzero, pretend we are allocating at global level.  */
 int force_global;
 
+/* The default alignment of "double" floating-point types, i.e. floating
+   point types whose size is equal to 64 bits, or 0 if this alignment is
+   not specifically capped.  */
+int double_float_alignment;
+
+/* The default alignment of "double" or larger scalar types, i.e. scalar
+   types whose size is greater or equal to 64 bits, or 0 if this alignment
+   is not specifically capped.  */
+int double_scalar_alignment;
+
 /* Tree nodes for the various types and decls we create.  */
 tree gnat_std_decls[(int) ADT_LAST];
 
 /* Tree nodes for the various types and decls we create.  */
 tree gnat_std_decls[(int) ADT_LAST];
 
@@ -91,6 +92,8 @@ static tree handle_sentinel_attribute (tree *, tree, tree, int, bool *);
 static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *);
 static tree handle_malloc_attribute (tree *, tree, tree, int, bool *);
 static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *);
 static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *);
 static tree handle_malloc_attribute (tree *, tree, tree, int, bool *);
 static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *);
+static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *);
+static tree handle_vector_type_attribute (tree *, tree, tree, int, bool *);
 
 /* Fake handler for attributes we don't properly support, typically because
    they'd require dragging a lot of the common-c front-end circuitry.  */
 
 /* Fake handler for attributes we don't properly support, typically because
    they'd require dragging a lot of the common-c front-end circuitry.  */
@@ -109,7 +112,11 @@ const struct attribute_spec gnat_internal_attribute_table[] =
   { "sentinel",     0, 1,  false, true,  true,  handle_sentinel_attribute },
   { "noreturn",     0, 0,  true,  false, false, handle_noreturn_attribute },
   { "malloc",       0, 0,  true,  false, false, handle_malloc_attribute },
   { "sentinel",     0, 1,  false, true,  true,  handle_sentinel_attribute },
   { "noreturn",     0, 0,  true,  false, false, handle_noreturn_attribute },
   { "malloc",       0, 0,  true,  false, false, handle_malloc_attribute },
-  { "type generic", 0, 0, false, true, true, handle_type_generic_attribute },
+  { "type generic", 0, 0,  false, true, true, handle_type_generic_attribute },
+
+  { "vector_size",  1, 1,  false, true, false,  handle_vector_size_attribute },
+  { "vector_type",  0, 0,  false, true, false,  handle_vector_type_attribute },
+  { "may_alias",    0, 0, false, true, false, NULL },
 
   /* ??? format and format_arg are heavy and not supported, which actually
      prevents support for stdio builtins, which we however declare as part
 
   /* ??? format and format_arg are heavy and not supported, which actually
      prevents support for stdio builtins, which we however declare as part
@@ -160,8 +167,7 @@ static GTY(()) tree float_types[NUM_MACHINE_MODES];
 /* For each binding contour we allocate a binding_level structure to indicate
    the binding depth.  */
 
 /* For each binding contour we allocate a binding_level structure to indicate
    the binding depth.  */
 
-struct gnat_binding_level GTY((chain_next ("%h.chain")))
-{
+struct GTY((chain_next ("%h.chain"))) gnat_binding_level {
   /* The binding level containing this one (the enclosing binding level). */
   struct gnat_binding_level *chain;
   /* The BLOCK node for this level.  */
   /* The binding level containing this one (the enclosing binding level). */
   struct gnat_binding_level *chain;
   /* The BLOCK node for this level.  */
@@ -192,7 +198,6 @@ static GTY((deletable)) tree free_block_chain;
 static tree merge_sizes (tree, tree, tree, bool, bool);
 static tree compute_related_constant (tree, tree);
 static tree split_plus (tree, tree *);
 static tree merge_sizes (tree, tree, tree, bool, bool);
 static tree compute_related_constant (tree, tree);
 static tree split_plus (tree, tree *);
-static void gnat_gimplify_function (tree);
 static tree float_type_for_precision (int, enum machine_mode);
 static tree convert_to_fat_pointer (tree, tree);
 static tree convert_to_thin_pointer (tree, tree);
 static tree float_type_for_precision (int, enum machine_mode);
 static tree convert_to_fat_pointer (tree, tree);
 static tree convert_to_thin_pointer (tree, tree);
@@ -308,7 +313,7 @@ global_bindings_p (void)
 /* Enter a new binding level. */
 
 void
 /* Enter a new binding level. */
 
 void
-gnat_pushlevel ()
+gnat_pushlevel (void)
 {
   struct gnat_binding_level *newlevel = NULL;
 
 {
   struct gnat_binding_level *newlevel = NULL;
 
@@ -368,7 +373,7 @@ set_block_jmpbuf_decl (tree decl)
 /* Get the jmpbuf_decl, if any, for the current binding level.  */
 
 tree
 /* Get the jmpbuf_decl, if any, for the current binding level.  */
 
 tree
-get_block_jmpbuf_decl ()
+get_block_jmpbuf_decl (void)
 {
   return current_binding_level->jmpbuf_decl;
 }
 {
   return current_binding_level->jmpbuf_decl;
 }
@@ -376,7 +381,7 @@ get_block_jmpbuf_decl ()
 /* Exit a binding level. Set any BLOCK into the current code group.  */
 
 void
 /* Exit a binding level. Set any BLOCK into the current code group.  */
 
 void
-gnat_poplevel ()
+gnat_poplevel (void)
 {
   struct gnat_binding_level *level = current_binding_level;
   tree block = level->block;
 {
   struct gnat_binding_level *level = current_binding_level;
   tree block = level->block;
@@ -428,9 +433,12 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
     {
       DECL_CONTEXT (decl) = current_function_decl;
 
     {
       DECL_CONTEXT (decl) = current_function_decl;
 
-      /* Functions imported in another function are not really nested.  */
-      if (TREE_CODE (decl) == FUNCTION_DECL && TREE_PUBLIC (decl))
-       DECL_NO_STATIC_CHAIN (decl) = 1;
+      /* Functions imported in another function are not really nested.
+        For really nested functions mark them initially as needing
+        a static chain for uses of that flag before unnesting;
+        lower_nested_functions will then recompute it.  */
+      if (TREE_CODE (decl) == FUNCTION_DECL && !TREE_PUBLIC (decl))
+       DECL_STATIC_CHAIN (decl) = 1;
     }
 
   TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node));
     }
 
   TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node));
@@ -478,14 +486,18 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
 
       if (!(TYPE_NAME (t) && TREE_CODE (TYPE_NAME (t)) == TYPE_DECL))
        ;
 
       if (!(TYPE_NAME (t) && TREE_CODE (TYPE_NAME (t)) == TYPE_DECL))
        ;
-      else if (TYPE_FAT_POINTER_P (t))
+      else if (TYPE_IS_FAT_POINTER_P (t))
        {
          tree tt = build_variant_type_copy (t);
          TYPE_NAME (tt) = decl;
          TREE_USED (tt) = TREE_USED (t);
          TREE_TYPE (decl) = tt;
        {
          tree tt = build_variant_type_copy (t);
          TYPE_NAME (tt) = decl;
          TREE_USED (tt) = TREE_USED (t);
          TREE_TYPE (decl) = tt;
-         DECL_ORIGINAL_TYPE (decl) = t;
+         if (DECL_ORIGINAL_TYPE (TYPE_NAME (t)))
+           DECL_ORIGINAL_TYPE (decl) = DECL_ORIGINAL_TYPE (TYPE_NAME (t));
+         else
+           DECL_ORIGINAL_TYPE (decl) = t;
          t = NULL_TREE;
          t = NULL_TREE;
+         DECL_ARTIFICIAL (decl) = 0;
        }
       else if (DECL_ARTIFICIAL (TYPE_NAME (t)) && !DECL_ARTIFICIAL (decl))
        ;
        }
       else if (DECL_ARTIFICIAL (TYPE_NAME (t)) && !DECL_ARTIFICIAL (decl))
        ;
@@ -522,12 +534,14 @@ gnat_init_decl_processing (void)
   set_sizetype (size_type_node);
 
   /* In Ada, we use an unsigned 8-bit type for the default boolean type.  */
   set_sizetype (size_type_node);
 
   /* In Ada, we use an unsigned 8-bit type for the default boolean type.  */
-  boolean_type_node = make_node (BOOLEAN_TYPE);
-  TYPE_PRECISION (boolean_type_node) = 1;
-  fixup_unsigned_type (boolean_type_node);
-  TYPE_RM_SIZE (boolean_type_node) = bitsize_int (1);
+  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));
 
   build_common_tree_nodes_2 (0);
 
   build_common_tree_nodes_2 (0);
+  boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
 
   ptr_void_type_node = build_pointer_type (void_type_node);
 }
 
   ptr_void_type_node = build_pointer_type (void_type_node);
 }
@@ -537,7 +551,8 @@ gnat_init_decl_processing (void)
 void
 record_builtin_type (const char *name, tree type)
 {
 void
 record_builtin_type (const char *name, tree type)
 {
-  tree type_decl = build_decl (TYPE_DECL, get_identifier (name), type);
+  tree type_decl = build_decl (input_location,
+                              TYPE_DECL, get_identifier (name), type);
 
   gnat_pushdecl (type_decl, Empty);
 
 
   gnat_pushdecl (type_decl, Empty);
 
@@ -545,19 +560,18 @@ record_builtin_type (const char *name, tree type)
     debug_hooks->type_decl (type_decl, false);
 }
 \f
     debug_hooks->type_decl (type_decl, false);
 }
 \f
-/* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST,
+/* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST,
    finish constructing the record or union type.  If REP_LEVEL is zero, this
    record has no representation clause and so will be entirely laid out here.
    If REP_LEVEL is one, this record has a representation clause and has been
    laid out already; only set the sizes and alignment.  If REP_LEVEL is two,
    this record is derived from a parent record and thus inherits its layout;
    finish constructing the record or union type.  If REP_LEVEL is zero, this
    record has no representation clause and so will be entirely laid out here.
    If REP_LEVEL is one, this record has a representation clause and has been
    laid out already; only set the sizes and alignment.  If REP_LEVEL is two,
    this record is derived from a parent record and thus inherits its layout;
-   only make a pass on the fields to finalize them.  If DO_NOT_FINALIZE is
-   true, the record type is expected to be modified afterwards so it will
-   not be sent to the back-end for finalization.  */
+   only make a pass on the fields to finalize them.  DEBUG_INFO_P is true if
+   we need to write debug information about this type.  */
 
 void
 
 void
-finish_record_type (tree record_type, tree fieldlist, int rep_level,
-                   bool do_not_finalize)
+finish_record_type (tree record_type, tree field_list, int rep_level,
+                   bool debug_info_p)
 {
   enum tree_code code = TREE_CODE (record_type);
   tree name = TYPE_NAME (record_type);
 {
   enum tree_code code = TREE_CODE (record_type);
   tree name = TYPE_NAME (record_type);
@@ -568,7 +582,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
   bool had_align = TYPE_ALIGN (record_type) != 0;
   tree field;
 
   bool had_align = TYPE_ALIGN (record_type) != 0;
   tree field;
 
-  TYPE_FIELDS (record_type) = fieldlist;
+  TYPE_FIELDS (record_type) = field_list;
 
   /* Always attach the TYPE_STUB_DECL for a record type.  It is required to
      generate debug info and have a parallel type.  */
 
   /* Always attach the TYPE_STUB_DECL for a record type.  It is required to
      generate debug info and have a parallel type.  */
@@ -612,9 +626,9 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
      handled yet, and adjust DECL_NONADDRESSABLE_P accordingly.  */
 
   if (code == QUAL_UNION_TYPE)
      handled yet, and adjust DECL_NONADDRESSABLE_P accordingly.  */
 
   if (code == QUAL_UNION_TYPE)
-    fieldlist = nreverse (fieldlist);
+    field_list = nreverse (field_list);
 
 
-  for (field = fieldlist; field; field = TREE_CHAIN (field))
+  for (field = field_list; field; field = TREE_CHAIN (field))
     {
       tree type = TREE_TYPE (field);
       tree pos = bit_position (field);
     {
       tree type = TREE_TYPE (field);
       tree pos = bit_position (field);
@@ -624,7 +638,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
       if ((TREE_CODE (type) == RECORD_TYPE
           || TREE_CODE (type) == UNION_TYPE
           || TREE_CODE (type) == QUAL_UNION_TYPE)
       if ((TREE_CODE (type) == RECORD_TYPE
           || TREE_CODE (type) == UNION_TYPE
           || TREE_CODE (type) == QUAL_UNION_TYPE)
-         && !TYPE_IS_FAT_POINTER_P (type)
+         && !TYPE_FAT_POINTER_P (type)
          && !TYPE_CONTAINS_TEMPLATE_P (type)
          && TYPE_ADA_SIZE (type))
        this_ada_size = TYPE_ADA_SIZE (type);
          && !TYPE_CONTAINS_TEMPLATE_P (type)
          && TYPE_ADA_SIZE (type))
        this_ada_size = TYPE_ADA_SIZE (type);
@@ -666,12 +680,13 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
            DECL_BIT_FIELD (field) = 0;
        }
 
            DECL_BIT_FIELD (field) = 0;
        }
 
-      /* If we still have DECL_BIT_FIELD set at this point, we know the field
-        is technically not addressable.  Except that it can actually be
-        addressed if the field is BLKmode and happens to be properly
-        aligned.  */
-      DECL_NONADDRESSABLE_P (field)
-       |= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
+      /* If we still have DECL_BIT_FIELD set at this point, we know that the
+        field is technically not addressable.  Except that it can actually
+        be addressed if it is BLKmode and happens to be properly aligned.  */
+      if (DECL_BIT_FIELD (field)
+         && !(DECL_MODE (field) == BLKmode
+              && value_factor_p (pos, BITS_PER_UNIT)))
+       DECL_NONADDRESSABLE_P (field) = 1;
 
       /* A type must be as aligned as its most aligned field that is not
         a bit-field.  But this is already enforced by layout_type.  */
 
       /* A type must be as aligned as its most aligned field that is not
         a bit-field.  But this is already enforced by layout_type.  */
@@ -717,23 +732,17 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
     }
 
   if (code == QUAL_UNION_TYPE)
     }
 
   if (code == QUAL_UNION_TYPE)
-    nreverse (fieldlist);
-
-  /* If the type is discriminated, it can be used to access all its
-     constrained subtypes, so force structural equality checks.  */
-  if (CONTAINS_PLACEHOLDER_P (size))
-    SET_TYPE_STRUCTURAL_EQUALITY (record_type);
+    nreverse (field_list);
 
   if (rep_level < 2)
     {
       /* If this is a padding record, we never want to make the size smaller
         than what was specified in it, if any.  */
 
   if (rep_level < 2)
     {
       /* If this is a padding record, we never want to make the size smaller
         than what was specified in it, if any.  */
-      if (TREE_CODE (record_type) == RECORD_TYPE
-         && TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type))
+      if (TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type))
        size = TYPE_SIZE (record_type);
 
       /* Now set any of the values we've just computed that apply.  */
        size = TYPE_SIZE (record_type);
 
       /* Now set any of the values we've just computed that apply.  */
-      if (!TYPE_IS_FAT_POINTER_P (record_type)
+      if (!TYPE_FAT_POINTER_P (record_type)
          && !TYPE_CONTAINS_TEMPLATE_P (record_type))
        SET_TYPE_ADA_SIZE (record_type, ada_size);
 
          && !TYPE_CONTAINS_TEMPLATE_P (record_type))
        SET_TYPE_ADA_SIZE (record_type, ada_size);
 
@@ -754,24 +763,24 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
        }
     }
 
        }
     }
 
-  if (!do_not_finalize)
+  if (debug_info_p)
     rest_of_record_type_compilation (record_type);
 }
 
     rest_of_record_type_compilation (record_type);
 }
 
-/* Wrap up compilation of RECORD_TYPE, i.e. most notably output all
-   the debug information associated with it.  It need not be invoked
-   directly in most cases since finish_record_type takes care of doing
-   so, unless explicitly requested not to through DO_NOT_FINALIZE.  */
+/* Wrap up compilation of RECORD_TYPE, i.e. output all the debug information
+   associated with it.  It need not be invoked directly in most cases since
+   finish_record_type takes care of doing so, but this can be necessary if
+   a parallel type is to be attached to the record type.  */
 
 void
 rest_of_record_type_compilation (tree record_type)
 {
 
 void
 rest_of_record_type_compilation (tree record_type)
 {
-  tree fieldlist = TYPE_FIELDS (record_type);
+  tree field_list = TYPE_FIELDS (record_type);
   tree field;
   enum tree_code code = TREE_CODE (record_type);
   bool var_size = false;
 
   tree field;
   enum tree_code code = TREE_CODE (record_type);
   bool var_size = false;
 
-  for (field = fieldlist; field; field = TREE_CHAIN (field))
+  for (field = field_list; field; field = TREE_CHAIN (field))
     {
       /* We need to make an XVE/XVU record if any field has variable size,
         whether or not the record does.  For example, if we have a union,
     {
       /* We need to make an XVE/XVU record if any field has variable size,
         whether or not the record does.  For example, if we have a union,
@@ -795,29 +804,25 @@ rest_of_record_type_compilation (tree record_type)
      that tells the debugger how the record is laid out.  See
      exp_dbug.ads.  But don't do this for records that are padding
      since they confuse GDB.  */
      that tells the debugger how the record is laid out.  See
      exp_dbug.ads.  But don't do this for records that are padding
      since they confuse GDB.  */
-  if (var_size
-      && !(TREE_CODE (record_type) == RECORD_TYPE
-          && TYPE_IS_PADDING_P (record_type)))
+  if (var_size && !TYPE_IS_PADDING_P (record_type))
     {
       tree new_record_type
        = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
                     ? UNION_TYPE : TREE_CODE (record_type));
     {
       tree new_record_type
        = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
                     ? UNION_TYPE : TREE_CODE (record_type));
-      tree orig_name = TYPE_NAME (record_type);
-      tree orig_id
-       = (TREE_CODE (orig_name) == TYPE_DECL ? DECL_NAME (orig_name)
-          : orig_name);
-      tree new_id
-       = concat_id_with_name (orig_id,
-                              TREE_CODE (record_type) == QUAL_UNION_TYPE
-                              ? "XVU" : "XVE");
+      tree orig_name = TYPE_NAME (record_type), new_name;
       tree last_pos = bitsize_zero_node;
       tree last_pos = bitsize_zero_node;
-      tree old_field;
-      tree prev_old_field = 0;
+      tree old_field, prev_old_field = NULL_TREE;
 
 
-      TYPE_NAME (new_record_type) = new_id;
+      if (TREE_CODE (orig_name) == TYPE_DECL)
+       orig_name = DECL_NAME (orig_name);
+
+      new_name
+       = concat_name (orig_name, TREE_CODE (record_type) == QUAL_UNION_TYPE
+                                 ? "XVU" : "XVE");
+      TYPE_NAME (new_record_type) = new_name;
       TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
       TYPE_STUB_DECL (new_record_type)
       TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
       TYPE_STUB_DECL (new_record_type)
-       = create_type_stub_decl (new_id, new_record_type);
+       = create_type_stub_decl (new_name, new_record_type);
       DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
        = DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
       TYPE_SIZE (new_record_type) = size_int (TYPE_ALIGN (record_type));
       DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
        = DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
       TYPE_SIZE (new_record_type) = size_int (TYPE_ALIGN (record_type));
@@ -937,7 +942,7 @@ rest_of_record_type_compilation (tree record_type)
              else
                strcpy (suffix, "XVL");
 
              else
                strcpy (suffix, "XVL");
 
-             field_name = concat_id_with_name (field_name, suffix);
+             field_name = concat_name (field_name, suffix);
            }
 
          new_field = create_field_decl (field_name, field_type,
            }
 
          new_field = create_field_decl (field_name, field_type,
@@ -1004,33 +1009,33 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special,
             bool has_rep)
 {
   tree type = TREE_TYPE (last_size);
             bool has_rep)
 {
   tree type = TREE_TYPE (last_size);
-  tree new;
+  tree new_size;
 
   if (!special || TREE_CODE (size) != COND_EXPR)
     {
 
   if (!special || TREE_CODE (size) != COND_EXPR)
     {
-      new = size_binop (PLUS_EXPR, first_bit, size);
+      new_size = size_binop (PLUS_EXPR, first_bit, size);
       if (has_rep)
       if (has_rep)
-       new = size_binop (MAX_EXPR, last_size, new);
+       new_size = size_binop (MAX_EXPR, last_size, new_size);
     }
 
   else
     }
 
   else
-    new = fold_build3 (COND_EXPR, type, TREE_OPERAND (size, 0),
-                      integer_zerop (TREE_OPERAND (size, 1))
-                      ? last_size : merge_sizes (last_size, first_bit,
-                                                 TREE_OPERAND (size, 1),
-                                                 1, has_rep),
-                      integer_zerop (TREE_OPERAND (size, 2))
-                      ? last_size : merge_sizes (last_size, first_bit,
-                                                 TREE_OPERAND (size, 2),
-                                                 1, has_rep));
+    new_size = fold_build3 (COND_EXPR, type, TREE_OPERAND (size, 0),
+                           integer_zerop (TREE_OPERAND (size, 1))
+                           ? last_size : merge_sizes (last_size, first_bit,
+                                                      TREE_OPERAND (size, 1),
+                                                      1, has_rep),
+                           integer_zerop (TREE_OPERAND (size, 2))
+                           ? last_size : merge_sizes (last_size, first_bit,
+                                                      TREE_OPERAND (size, 2),
+                                                      1, has_rep));
 
   /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially
      when fed through substitute_in_expr) into thinking that a constant
      size is not constant.  */
 
   /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially
      when fed through substitute_in_expr) into thinking that a constant
      size is not constant.  */
-  while (TREE_CODE (new) == NON_LVALUE_EXPR)
-    new = TREE_OPERAND (new, 0);
+  while (TREE_CODE (new_size) == NON_LVALUE_EXPR)
+    new_size = TREE_OPERAND (new_size, 0);
 
 
-  return new;
+  return new_size;
 }
 
 /* Utility function of above to see if OP0 and OP1, both of SIZETYPE, are
 }
 
 /* Utility function of above to see if OP0 and OP1, both of SIZETYPE, are
@@ -1150,23 +1155,40 @@ create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
 tree
 copy_type (tree type)
 {
 tree
 copy_type (tree type)
 {
-  tree new = copy_node (type);
+  tree new_type = copy_node (type);
+
+  /* Unshare the language-specific data.  */
+  if (TYPE_LANG_SPECIFIC (type))
+    {
+      TYPE_LANG_SPECIFIC (new_type) = NULL;
+      SET_TYPE_LANG_SPECIFIC (new_type, GET_TYPE_LANG_SPECIFIC (type));
+    }
+
+  /* And the contents of the language-specific slot if needed.  */
+  if ((INTEGRAL_TYPE_P (type) || TREE_CODE (type) == REAL_TYPE)
+      && TYPE_RM_VALUES (type))
+    {
+      TYPE_RM_VALUES (new_type) = NULL_TREE;
+      SET_TYPE_RM_SIZE (new_type, TYPE_RM_SIZE (type));
+      SET_TYPE_RM_MIN_VALUE (new_type, TYPE_RM_MIN_VALUE (type));
+      SET_TYPE_RM_MAX_VALUE (new_type, TYPE_RM_MAX_VALUE (type));
+    }
 
   /* copy_node clears this field instead of copying it, because it is
      aliased with TREE_CHAIN.  */
 
   /* copy_node clears this field instead of copying it, because it is
      aliased with TREE_CHAIN.  */
-  TYPE_STUB_DECL (new) = TYPE_STUB_DECL (type);
+  TYPE_STUB_DECL (new_type) = TYPE_STUB_DECL (type);
 
 
-  TYPE_POINTER_TO (new) = 0;
-  TYPE_REFERENCE_TO (new) = 0;
-  TYPE_MAIN_VARIANT (new) = new;
-  TYPE_NEXT_VARIANT (new) = 0;
+  TYPE_POINTER_TO (new_type) = 0;
+  TYPE_REFERENCE_TO (new_type) = 0;
+  TYPE_MAIN_VARIANT (new_type) = new_type;
+  TYPE_NEXT_VARIANT (new_type) = 0;
 
 
-  return new;
+  return new_type;
 }
 \f
 }
 \f
-/* Return an INTEGER_TYPE of SIZETYPE with range MIN to MAX and whose
-   TYPE_INDEX_TYPE is INDEX.  GNAT_NODE is used for the position of
-   the decl.  */
+/* Return a subtype of sizetype with range MIN to MAX and whose
+   TYPE_INDEX_TYPE is INDEX.  GNAT_NODE is used for the position
+   of the associated TYPE_DECL.  */
 
 tree
 create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
 
 tree
 create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
@@ -1174,20 +1196,56 @@ create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
   /* First build a type for the desired range.  */
   tree type = build_index_2_type (min, max);
 
   /* First build a type for the desired range.  */
   tree type = build_index_2_type (min, max);
 
-  /* If this type has the TYPE_INDEX_TYPE we want, return it.  Otherwise, if it
-     doesn't have TYPE_INDEX_TYPE set, set it to INDEX.  If TYPE_INDEX_TYPE
-     is set, but not to INDEX, make a copy of this type with the requested
-     index type.  Note that we have no way of sharing these types, but that's
-     only a small hole.  */
+  /* If this type has the TYPE_INDEX_TYPE we want, return it.  */
   if (TYPE_INDEX_TYPE (type) == index)
     return type;
   if (TYPE_INDEX_TYPE (type) == index)
     return type;
-  else if (TYPE_INDEX_TYPE (type))
+
+  /* Otherwise, if TYPE_INDEX_TYPE is set, make a copy.  Note that we have
+     no way of sharing these types, but that's only a small hole.  */
+  if (TYPE_INDEX_TYPE (type))
     type = copy_type (type);
 
   SET_TYPE_INDEX_TYPE (type, index);
   create_type_decl (NULL_TREE, type, NULL, true, false, gnat_node);
     type = copy_type (type);
 
   SET_TYPE_INDEX_TYPE (type, index);
   create_type_decl (NULL_TREE, type, NULL, true, false, gnat_node);
+
   return type;
 }
   return type;
 }
+
+/* Return a subtype of TYPE with range MIN to MAX.  If TYPE is NULL,
+   sizetype is used.  */
+
+tree
+create_range_type (tree type, tree min, tree max)
+{
+  tree range_type;
+
+  if (type == NULL_TREE)
+    type = sizetype;
+
+  /* First build a type with the base range.  */
+  range_type
+    = build_range_type (type, TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type));
+
+  min = convert (type, min);
+  max = convert (type, max);
+
+  /* If this type has the TYPE_RM_{MIN,MAX}_VALUE we want, return it.  */
+  if (TYPE_RM_MIN_VALUE (range_type)
+      && TYPE_RM_MAX_VALUE (range_type)
+      && operand_equal_p (TYPE_RM_MIN_VALUE (range_type), min, 0)
+      && operand_equal_p (TYPE_RM_MAX_VALUE (range_type), max, 0))
+    return range_type;
+
+  /* Otherwise, if TYPE_RM_{MIN,MAX}_VALUE is set, make a copy.  */
+  if (TYPE_RM_MIN_VALUE (range_type) || TYPE_RM_MAX_VALUE (range_type))
+    range_type = copy_type (range_type);
+
+  /* Then set the actual range.  */
+  SET_TYPE_RM_MIN_VALUE (range_type, min);
+  SET_TYPE_RM_MAX_VALUE (range_type, max);
+
+  return range_type;
+}
 \f
 /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of a type.
    TYPE_NAME gives the name of the type and TYPE is a ..._TYPE node giving
 \f
 /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of a type.
    TYPE_NAME gives the name of the type and TYPE is a ..._TYPE node giving
@@ -1199,7 +1257,8 @@ create_type_stub_decl (tree type_name, tree type)
   /* Using a named TYPE_DECL ensures that a type name marker is emitted in
      STABS while setting DECL_ARTIFICIAL ensures that no DW_TAG_typedef is
      emitted in DWARF.  */
   /* Using a named TYPE_DECL ensures that a type name marker is emitted in
      STABS while setting DECL_ARTIFICIAL ensures that no DW_TAG_typedef is
      emitted in DWARF.  */
-  tree type_decl = build_decl (TYPE_DECL, type_name, type);
+  tree type_decl = build_decl (input_location,
+                              TYPE_DECL, type_name, type);
   DECL_ARTIFICIAL (type_decl) = 1;
   return type_decl;
 }
   DECL_ARTIFICIAL (type_decl) = 1;
   return type_decl;
 }
@@ -1229,7 +1288,8 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
       DECL_NAME (type_decl) = type_name;
     }
   else
       DECL_NAME (type_decl) = type_name;
     }
   else
-    type_decl = build_decl (TYPE_DECL, type_name, type);
+    type_decl = build_decl (input_location,
+                           TYPE_DECL, type_name, type);
 
   DECL_ARTIFICIAL (type_decl) = artificial_p;
   gnat_pushdecl (type_decl, gnat_node);
 
   DECL_ARTIFICIAL (type_decl) = artificial_p;
   gnat_pushdecl (type_decl, gnat_node);
@@ -1250,7 +1310,7 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
   if (code == UNCONSTRAINED_ARRAY_TYPE || !debug_info_p)
     DECL_IGNORED_P (type_decl) = 1;
   else if (code != ENUMERAL_TYPE
   if (code == UNCONSTRAINED_ARRAY_TYPE || !debug_info_p)
     DECL_IGNORED_P (type_decl) = 1;
   else if (code != ENUMERAL_TYPE
-          && (code != RECORD_TYPE || TYPE_IS_FAT_POINTER_P (type))
+          && (code != RECORD_TYPE || TYPE_FAT_POINTER_P (type))
           && !((code == POINTER_TYPE || code == REFERENCE_TYPE)
                && TYPE_IS_DUMMY_P (TREE_TYPE (type)))
           && !(code == RECORD_TYPE
           && !((code == POINTER_TYPE || code == REFERENCE_TYPE)
                && TYPE_IS_DUMMY_P (TREE_TYPE (type)))
           && !(code == RECORD_TYPE
@@ -1307,7 +1367,8 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
   /* The actual DECL node.  CONST_DECL was initially intended for enumerals
      and may be used for scalars in general but not for aggregates.  */
   tree var_decl
   /* The actual DECL node.  CONST_DECL was initially intended for enumerals
      and may be used for scalars in general but not for aggregates.  */
   tree var_decl
-    = build_decl ((constant_p && const_decl_allowed_p
+    = build_decl (input_location,
+                 (constant_p && const_decl_allowed_p
                   && !AGGREGATE_TYPE_P (type)) ? CONST_DECL : VAR_DECL,
                  var_name, type);
 
                   && !AGGREGATE_TYPE_P (type)) ? CONST_DECL : VAR_DECL,
                  var_name, type);
 
@@ -1326,6 +1387,13 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
      that is, not violating a No_Elaboration_Code restriction.  */
   if (global_bindings_p () && var_init != 0 && ! init_const)
     Check_Elaboration_Code_Allowed (gnat_node);
      that is, not violating a No_Elaboration_Code restriction.  */
   if (global_bindings_p () && var_init != 0 && ! init_const)
     Check_Elaboration_Code_Allowed (gnat_node);
+  DECL_INITIAL  (var_decl) = var_init;
+  TREE_READONLY (var_decl) = const_flag;
+  DECL_EXTERNAL (var_decl) = extern_flag;
+  TREE_PUBLIC   (var_decl) = public_flag || extern_flag;
+  TREE_CONSTANT (var_decl) = constant_p;
+  TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl)
+    = TYPE_VOLATILE (type);
 
   /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't
      try to fiddle with DECL_COMMON.  However, on platforms that don't
 
   /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't
      try to fiddle with DECL_COMMON.  However, on platforms that don't
@@ -1333,15 +1401,9 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
      go in DATA instead, thus increasing the size of the executable.  */
   if (!flag_no_common
       && TREE_CODE (var_decl) == VAR_DECL
      go in DATA instead, thus increasing the size of the executable.  */
   if (!flag_no_common
       && TREE_CODE (var_decl) == VAR_DECL
+      && TREE_PUBLIC   (var_decl)
       && !have_global_bss_p ())
     DECL_COMMON (var_decl) = 1;
       && !have_global_bss_p ())
     DECL_COMMON (var_decl) = 1;
-  DECL_INITIAL  (var_decl) = var_init;
-  TREE_READONLY (var_decl) = const_flag;
-  DECL_EXTERNAL (var_decl) = extern_flag;
-  TREE_PUBLIC   (var_decl) = public_flag || extern_flag;
-  TREE_CONSTANT (var_decl) = constant_p;
-  TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl)
-    = TYPE_VOLATILE (type);
 
   /* If it's public and not external, always allocate storage for it.
      At the global binding level we need to allocate static storage for the
 
   /* If it's public and not external, always allocate storage for it.
      At the global binding level we need to allocate static storage for the
@@ -1350,10 +1412,21 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
   TREE_STATIC (var_decl)
     = !extern_flag && (public_flag || static_flag || global_bindings_p ());
 
   TREE_STATIC (var_decl)
     = !extern_flag && (public_flag || static_flag || global_bindings_p ());
 
-  if (asm_name && VAR_OR_FUNCTION_DECL_P (var_decl))
-    SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
+  /* For an external constant whose initializer is not absolute, do not emit
+     debug info.  In DWARF this would mean a global relocation in a read-only
+     section which runs afoul of the PE-COFF runtime relocation mechanism.  */
+  if (extern_flag
+      && constant_p
+      && initializer_constant_valid_p (var_init, TREE_TYPE (var_init))
+          != null_pointer_node)
+    DECL_IGNORED_P (var_decl) = 1;
 
 
-  process_attributes (var_decl, attr_list);
+  if (TREE_CODE (var_decl) == VAR_DECL)
+    {
+      if (asm_name)
+       SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
+      process_attributes (var_decl, attr_list);
+    }
 
   /* Add this decl to the current binding level.  */
   gnat_pushdecl (var_decl, gnat_node);
 
   /* Add this decl to the current binding level.  */
   gnat_pushdecl (var_decl, gnat_node);
@@ -1399,19 +1472,20 @@ aggregate_type_contains_array_p (tree type)
     }
 }
 
     }
 }
 
-/* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
-   type, and RECORD_TYPE is the type of the parent.  PACKED is nonzero if
-   this field is in a record type with a "pragma pack".  If SIZE is nonzero
-   it is the specified size for this field.  If POS is nonzero, it is the bit
-   position.  If ADDRESSABLE is nonzero, it means we are allowed to take
-   the address of this field for aliasing purposes. If it is negative, we
-   should not make a bitfield, which is used by make_aligning_type.   */
+/* Return a FIELD_DECL node.  FIELD_NAME is the field's name, FIELD_TYPE is
+   its type and RECORD_TYPE is the type of the enclosing record.  PACKED is
+   1 if the enclosing record is packed, -1 if it has Component_Alignment of
+   Storage_Unit.  If SIZE is nonzero, it is the specified size of the field.
+   If POS is nonzero, it is the bit position.  If ADDRESSABLE is nonzero, it
+   means we are allowed to take the address of the field; if it is negative,
+   we should not make a bitfield, which is used by make_aligning_type.  */
 
 tree
 create_field_decl (tree field_name, tree field_type, tree record_type,
                    int packed, tree size, tree pos, int addressable)
 {
 
 tree
 create_field_decl (tree field_name, tree field_type, tree record_type,
                    int packed, tree size, tree pos, int addressable)
 {
-  tree field_decl = build_decl (FIELD_DECL, field_name, field_type);
+  tree field_decl = build_decl (input_location,
+                               FIELD_DECL, field_name, field_type);
 
   DECL_CONTEXT (field_decl) = record_type;
   TREE_READONLY (field_decl) = TYPE_READONLY (field_type);
 
   DECL_CONTEXT (field_decl) = record_type;
   TREE_READONLY (field_decl) = TYPE_READONLY (field_type);
@@ -1438,12 +1512,8 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
   else if (packed == 1)
     {
       size = rm_size (field_type);
   else if (packed == 1)
     {
       size = rm_size (field_type);
-
-      /* For a constant size larger than MAX_FIXED_MODE_SIZE, round up to
-         byte.  */
-      if (TREE_CODE (size) == INTEGER_CST
-          && compare_tree_int (size, MAX_FIXED_MODE_SIZE) > 0)
-        size = round_up (size, BITS_PER_UNIT);
+      if (TYPE_MODE (field_type) == BLKmode)
+       size = round_up (size, BITS_PER_UNIT);
     }
 
   /* If we may, according to ADDRESSABLE, make a bitfield if a size is
     }
 
   /* If we may, according to ADDRESSABLE, make a bitfield if a size is
@@ -1474,10 +1544,13 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
       DECL_BIT_FIELD (field_decl) = 1;
       DECL_SIZE (field_decl) = size;
       if (!packed && !pos)
       DECL_BIT_FIELD (field_decl) = 1;
       DECL_SIZE (field_decl) = size;
       if (!packed && !pos)
-       DECL_ALIGN (field_decl)
-         = (TYPE_ALIGN (record_type) != 0
-            ? MIN (TYPE_ALIGN (record_type), TYPE_ALIGN (field_type))
-            : TYPE_ALIGN (field_type));
+       {
+         if (TYPE_ALIGN (record_type) != 0
+             && TYPE_ALIGN (record_type) < TYPE_ALIGN (field_type))
+           DECL_ALIGN (field_decl) = TYPE_ALIGN (record_type);
+         else
+           DECL_ALIGN (field_decl) = TYPE_ALIGN (field_type);
+       }
     }
 
   DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed;
     }
 
   DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed;
@@ -1542,22 +1615,20 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
   return field_decl;
 }
 \f
   return field_decl;
 }
 \f
-/* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
-   PARAM_TYPE is its type.  READONLY is true if the parameter is
-   readonly (either an In parameter or an address of a pass-by-ref
-   parameter). */
+/* Return a PARM_DECL node.  PARAM_NAME is the name of the parameter and
+   PARAM_TYPE is its type.  READONLY is true if the parameter is readonly
+   (either an In parameter or an address of a pass-by-ref parameter).  */
 
 tree
 create_param_decl (tree param_name, tree param_type, bool readonly)
 {
 
 tree
 create_param_decl (tree param_name, tree param_type, bool readonly)
 {
-  tree param_decl = build_decl (PARM_DECL, param_name, param_type);
-
-  /* Honor targetm.calls.promote_prototypes(), as not doing so can
-     lead to various ABI violations.  */
-  if (targetm.calls.promote_prototypes (param_type)
-      && (TREE_CODE (param_type) == INTEGER_TYPE
-         || TREE_CODE (param_type) == ENUMERAL_TYPE
-         || TREE_CODE (param_type) == BOOLEAN_TYPE)
+  tree param_decl = build_decl (input_location,
+                               PARM_DECL, param_name, param_type);
+
+  /* Honor TARGET_PROMOTE_PROTOTYPES like the C compiler, as not doing so
+     can lead to various ABI violations.  */
+  if (targetm.calls.promote_prototypes (NULL_TREE)
+      && INTEGRAL_TYPE_P (param_type)
       && TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
     {
       /* We have to be careful about biased types here.  Make a subtype
       && TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
     {
       /* We have to be careful about biased types here.  Make a subtype
@@ -1565,12 +1636,13 @@ create_param_decl (tree param_name, tree param_type, bool readonly)
       if (TREE_CODE (param_type) == INTEGER_TYPE
          && TYPE_BIASED_REPRESENTATION_P (param_type))
        {
       if (TREE_CODE (param_type) == INTEGER_TYPE
          && TYPE_BIASED_REPRESENTATION_P (param_type))
        {
-         param_type
-           = copy_type (build_range_type (integer_type_node,
-                                          TYPE_MIN_VALUE (param_type),
-                                          TYPE_MAX_VALUE (param_type)));
-
-         TYPE_BIASED_REPRESENTATION_P (param_type) = 1;
+         tree subtype
+           = make_unsigned_type (TYPE_PRECISION (integer_type_node));
+         TREE_TYPE (subtype) = integer_type_node;
+         TYPE_BIASED_REPRESENTATION_P (subtype) = 1;
+         SET_TYPE_RM_MIN_VALUE (subtype, TYPE_MIN_VALUE (param_type));
+         SET_TYPE_RM_MAX_VALUE (subtype, TYPE_MAX_VALUE (param_type));
+         param_type = subtype;
        }
       else
        param_type = integer_type_node;
        }
       else
        param_type = integer_type_node;
@@ -1641,7 +1713,7 @@ process_attributes (tree decl, struct attrib *attr_list)
       }
 }
 \f
       }
 }
 \f
-/* Record a global renaming pointer.  */
+/* Record DECL as a global renaming pointer.  */
 
 void
 record_global_renaming_pointer (tree decl)
 
 void
 record_global_renaming_pointer (tree decl)
@@ -1731,7 +1803,8 @@ potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
 tree
 create_label_decl (tree label_name)
 {
 tree
 create_label_decl (tree label_name)
 {
-  tree label_decl = build_decl (LABEL_DECL, label_name, void_type_node);
+  tree label_decl = build_decl (input_location,
+                               LABEL_DECL, label_name, void_type_node);
 
   DECL_CONTEXT (label_decl)     = current_function_decl;
   DECL_MODE (label_decl)        = VOIDmode;
 
   DECL_CONTEXT (label_decl)     = current_function_decl;
   DECL_MODE (label_decl)        = VOIDmode;
@@ -1755,7 +1828,8 @@ create_subprog_decl (tree subprog_name, tree asm_name,
                      struct attrib *attr_list, Node_Id gnat_node)
 {
   tree return_type  = TREE_TYPE (subprog_type);
                      struct attrib *attr_list, Node_Id gnat_node)
 {
   tree return_type  = TREE_TYPE (subprog_type);
-  tree subprog_decl = build_decl (FUNCTION_DECL, subprog_name, subprog_type);
+  tree subprog_decl = build_decl (input_location,
+                                 FUNCTION_DECL, subprog_name, subprog_type);
 
   /* If this is a non-inline function nested inside an inlined external
      function, we cannot honor both requests without cloning the nested
 
   /* If this is a non-inline function nested inside an inlined external
      function, we cannot honor both requests without cloning the nested
@@ -1776,7 +1850,8 @@ create_subprog_decl (tree subprog_name, tree asm_name,
   TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type);
   DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag;
   DECL_ARGUMENTS (subprog_decl) = param_decl_list;
   TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type);
   DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag;
   DECL_ARGUMENTS (subprog_decl) = param_decl_list;
-  DECL_RESULT (subprog_decl)    = build_decl (RESULT_DECL, 0, return_type);
+  DECL_RESULT (subprog_decl)    = build_decl (input_location,
+                                             RESULT_DECL, 0, return_type);
   DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
   DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
 
   DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
   DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
 
@@ -1802,9 +1877,9 @@ create_subprog_decl (tree subprog_name, tree asm_name,
         to be declared as the "main" function literally by default.  Ada
         program entry points are typically declared with a different name
         within the binder generated file, exported as 'main' to satisfy the
         to be declared as the "main" function literally by default.  Ada
         program entry points are typically declared with a different name
         within the binder generated file, exported as 'main' to satisfy the
-        system expectations.  Redirect main_identifier_node in this case.  */
+        system expectations.  Force main_identifier_node in this case.  */
       if (asm_name == main_identifier_node)
       if (asm_name == main_identifier_node)
-       main_identifier_node = DECL_NAME (subprog_decl);
+       DECL_NAME (subprog_decl) = main_identifier_node;
     }
 
   process_attributes (subprog_decl, attr_list);
     }
 
   process_attributes (subprog_decl, attr_list);
@@ -2002,12 +2077,10 @@ gnat_genericize (tree fndecl)
   pointer_set_destroy (p_set);
 }
 
   pointer_set_destroy (p_set);
 }
 
-/* Finish the definition of the current subprogram BODY and compile it all the
-   way to assembler language output.  ELAB_P tells if this is called for an
-   elaboration routine, to be entirely discarded if empty.  */
+/* Finish the definition of the current subprogram BODY and finalize it.  */
 
 void
 
 void
-end_subprog_body (tree body, bool elab_p)
+end_subprog_body (tree body)
 {
   tree fndecl = current_function_decl;
 
 {
   tree fndecl = current_function_decl;
 
@@ -2040,44 +2113,18 @@ end_subprog_body (tree body, bool elab_p)
   /* Perform the required pre-gimplification transformations on the tree.  */
   gnat_genericize (fndecl);
 
   /* Perform the required pre-gimplification transformations on the tree.  */
   gnat_genericize (fndecl);
 
-  /* We do different things for nested and non-nested functions.
-     ??? This should be in cgraph.  */
-  if (!DECL_CONTEXT (fndecl))
-    {
-      gnat_gimplify_function (fndecl);
+  /* Dump functions before gimplification.  */
+  dump_function (TDI_original, fndecl);
 
 
-      /* If this is an empty elaboration proc, just discard the node.
-        Otherwise, compile further.  */
-      if (elab_p && empty_body_p (gimple_body (fndecl)))
-       cgraph_remove_node (cgraph_node (fndecl));
-      else
-       cgraph_finalize_function (fndecl, false);
-    }
+  /* ??? This special handling of nested functions is probably obsolete.  */
+  if (!DECL_CONTEXT (fndecl))
+    cgraph_finalize_function (fndecl, false);
   else
     /* Register this function with cgraph just far enough to get it
        added to our parent's nested function list.  */
     (void) cgraph_node (fndecl);
 }
 
   else
     /* Register this function with cgraph just far enough to get it
        added to our parent's nested function list.  */
     (void) cgraph_node (fndecl);
 }
 
-/* Convert FNDECL's code to GIMPLE and handle any nested functions.  */
-
-static void
-gnat_gimplify_function (tree fndecl)
-{
-  struct cgraph_node *cgn;
-
-  dump_function (TDI_original, fndecl);
-  gimplify_function_tree (fndecl);
-  dump_function (TDI_generic, fndecl);
-
-  /* Convert all nested functions to GIMPLE now.  We do things in this order
-     so that items like VLA sizes are expanded properly in the context of the
-     correct function.  */
-  cgn = cgraph_node (fndecl);
-  for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
-    gnat_gimplify_function (cgn->decl);
-}
-
 tree
 gnat_builtin_function (tree decl)
 {
 tree
 gnat_builtin_function (tree decl)
 {
@@ -2149,16 +2196,28 @@ gnat_type_for_mode (enum machine_mode mode, int unsignedp)
 {
   if (mode == BLKmode)
     return NULL_TREE;
 {
   if (mode == BLKmode)
     return NULL_TREE;
-  else if (mode == VOIDmode)
+
+  if (mode == VOIDmode)
     return void_type_node;
     return void_type_node;
-  else if (COMPLEX_MODE_P (mode))
+
+  if (COMPLEX_MODE_P (mode))
     return NULL_TREE;
     return NULL_TREE;
-  else if (SCALAR_FLOAT_MODE_P (mode))
+
+  if (SCALAR_FLOAT_MODE_P (mode))
     return float_type_for_precision (GET_MODE_PRECISION (mode), mode);
     return float_type_for_precision (GET_MODE_PRECISION (mode), mode);
-  else if (SCALAR_INT_MODE_P (mode))
+
+  if (SCALAR_INT_MODE_P (mode))
     return gnat_type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
     return gnat_type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
-  else
-    return NULL_TREE;
+
+  if (VECTOR_MODE_P (mode))
+    {
+      enum machine_mode inner_mode = GET_MODE_INNER (mode);
+      tree inner_type = gnat_type_for_mode (inner_mode, unsignedp);
+      if (inner_type)
+       return build_vector_type_for_mode (inner_type, mode);
+    }
+
+  return NULL_TREE;
 }
 
 /* Return the unsigned version of a TYPE_NODE, a scalar type.  */
 }
 
 /* Return the unsigned version of a TYPE_NODE, a scalar type.  */
@@ -2223,6 +2282,14 @@ gnat_types_compatible_p (tree t1, tree t2)
   if ((code = TREE_CODE (t1)) != TREE_CODE (t2))
     return 0;
 
   if ((code = TREE_CODE (t1)) != TREE_CODE (t2))
     return 0;
 
+  /* Vector types are also compatible if they have the same number of subparts
+     and the same form of (scalar) element type.  */
+  if (code == VECTOR_TYPE
+      && TYPE_VECTOR_SUBPARTS (t1) == TYPE_VECTOR_SUBPARTS (t2)
+      && TREE_CODE (TREE_TYPE (t1)) == TREE_CODE (TREE_TYPE (t2))
+      && TYPE_PRECISION (TREE_TYPE (t1)) == TYPE_PRECISION (TREE_TYPE (t2)))
+    return 1;
+
   /* Array types are also compatible if they are constrained and have
      the same component type and the same domain.  */
   if (code == ARRAY_TYPE
   /* Array types are also compatible if they are constrained and have
      the same component type and the same domain.  */
   if (code == ARRAY_TYPE
@@ -2239,7 +2306,7 @@ gnat_types_compatible_p (tree t1, tree t2)
   /* Padding record types are also compatible if they pad the same
      type and have the same constant size.  */
   if (code == RECORD_TYPE
   /* Padding record types are also compatible if they pad the same
      type and have the same constant size.  */
   if (code == RECORD_TYPE
-      && TYPE_IS_PADDING_P (t1) && TYPE_IS_PADDING_P (t2)
+      && TYPE_PADDING_P (t1) && TYPE_PADDING_P (t2)
       && TREE_TYPE (TYPE_FIELDS (t1)) == TREE_TYPE (TYPE_FIELDS (t2))
       && tree_int_cst_equal (TYPE_SIZE (t1), TYPE_SIZE (t2)))
     return 1;
       && TREE_TYPE (TYPE_FIELDS (t1)) == TREE_TYPE (TYPE_FIELDS (t2))
       && tree_int_cst_equal (TYPE_SIZE (t1), TYPE_SIZE (t2)))
     return 1;
@@ -2266,10 +2333,15 @@ max_size (tree exp, bool max_p)
     case tcc_vl_exp:
       if (code == CALL_EXPR)
        {
     case tcc_vl_exp:
       if (code == CALL_EXPR)
        {
-         tree *argarray;
-         int i, n = call_expr_nargs (exp);
-         gcc_assert (n > 0);
+         tree t, *argarray;
+         int n, i;
 
 
+         t = maybe_inline_call_in_expr (exp);
+         if (t)
+           return max_size (t, max_p);
+
+         n = call_expr_nargs (exp);
+         gcc_assert (n > 0);
          argarray = (tree *) alloca (n * sizeof (tree));
          for (i = 0; i < n; i++)
            argarray[i] = max_size (CALL_EXPR_ARG (exp, i), max_p);
          argarray = (tree *) alloca (n * sizeof (tree));
          for (i = 0; i < n; i++)
            argarray[i] = max_size (CALL_EXPR_ARG (exp, i), max_p);
@@ -2384,7 +2456,7 @@ build_template (tree template_type, tree array_type, tree expr)
   tree field;
 
   while (TREE_CODE (array_type) == RECORD_TYPE
   tree field;
 
   while (TREE_CODE (array_type) == RECORD_TYPE
-        && (TYPE_IS_PADDING_P (array_type)
+        && (TYPE_PADDING_P (array_type)
             || TYPE_JUSTIFIED_MODULAR_P (array_type)))
     array_type = TREE_TYPE (TYPE_FIELDS (array_type));
 
             || TYPE_JUSTIFIED_MODULAR_P (array_type)))
     array_type = TREE_TYPE (TYPE_FIELDS (array_type));
 
@@ -2448,7 +2520,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
   tree record_type = make_node (RECORD_TYPE);
   tree pointer32_type;
   tree field_list = 0;
   tree record_type = make_node (RECORD_TYPE);
   tree pointer32_type;
   tree field_list = 0;
-  int class;
+  int klass;
   int dtype = 0;
   tree inner_type;
   int ndim;
   int dtype = 0;
   tree inner_type;
   int ndim;
@@ -2560,22 +2632,22 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     {
     case By_Descriptor_A:
     case By_Short_Descriptor_A:
     {
     case By_Descriptor_A:
     case By_Short_Descriptor_A:
-      class = 4;
+      klass = 4;
       break;
     case By_Descriptor_NCA:
     case By_Short_Descriptor_NCA:
       break;
     case By_Descriptor_NCA:
     case By_Short_Descriptor_NCA:
-      class = 10;
+      klass = 10;
       break;
     case By_Descriptor_SB:
     case By_Short_Descriptor_SB:
       break;
     case By_Descriptor_SB:
     case By_Short_Descriptor_SB:
-      class = 15;
+      klass = 15;
       break;
     case By_Descriptor:
     case By_Short_Descriptor:
     case By_Descriptor_S:
     case By_Short_Descriptor_S:
     default:
       break;
     case By_Descriptor:
     case By_Short_Descriptor:
     case By_Descriptor_S:
     case By_Short_Descriptor_S:
     default:
-      class = 1;
+      klass = 1;
       break;
     }
 
       break;
     }
 
@@ -2597,7 +2669,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
   field_list = chainon (field_list,
                        make_descriptor_field ("CLASS",
                                               gnat_type_for_size (8, 1),
   field_list = chainon (field_list,
                        make_descriptor_field ("CLASS",
                                               gnat_type_for_size (8, 1),
-                                              record_type, size_int (class)));
+                                              record_type, size_int (klass)));
 
   /* Of course this will crash at run-time if the address space is not
      within the low 32 bits, but there is nothing else we can do.  */
 
   /* Of course this will crash at run-time if the address space is not
      within the low 32 bits, but there is nothing else we can do.  */
@@ -2746,7 +2818,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     }
 
   TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC");
     }
 
   TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC");
-  finish_record_type (record_type, field_list, 0, true);
+  finish_record_type (record_type, field_list, 0, false);
   return record_type;
 }
 
   return record_type;
 }
 
@@ -2763,7 +2835,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
   tree record64_type = make_node (RECORD_TYPE);
   tree pointer64_type;
   tree field_list64 = 0;
   tree record64_type = make_node (RECORD_TYPE);
   tree pointer64_type;
   tree field_list64 = 0;
-  int class;
+  int klass;
   int dtype = 0;
   tree inner_type;
   int ndim;
   int dtype = 0;
   tree inner_type;
   int ndim;
@@ -2874,18 +2946,18 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
   switch (mech)
     {
     case By_Descriptor_A:
   switch (mech)
     {
     case By_Descriptor_A:
-      class = 4;
+      klass = 4;
       break;
     case By_Descriptor_NCA:
       break;
     case By_Descriptor_NCA:
-      class = 10;
+      klass = 10;
       break;
     case By_Descriptor_SB:
       break;
     case By_Descriptor_SB:
-      class = 15;
+      klass = 15;
       break;
     case By_Descriptor:
     case By_Descriptor_S:
     default:
       break;
     case By_Descriptor:
     case By_Descriptor_S:
     default:
-      class = 1;
+      klass = 1;
       break;
     }
 
       break;
     }
 
@@ -2904,7 +2976,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
   field_list64 = chainon (field_list64,
                        make_descriptor_field ("CLASS",
                                               gnat_type_for_size (8, 1),
   field_list64 = chainon (field_list64,
                        make_descriptor_field ("CLASS",
                                               gnat_type_for_size (8, 1),
-                                              record64_type, size_int (class)));
+                                              record64_type, size_int (klass)));
 
   field_list64 = chainon (field_list64,
                        make_descriptor_field ("MBMO",
 
   field_list64 = chainon (field_list64,
                        make_descriptor_field ("MBMO",
@@ -3060,7 +3132,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     }
 
   TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64");
     }
 
   TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64");
-  finish_record_type (record64_type, field_list64, 0, true);
+  finish_record_type (record64_type, field_list64, 0, false);
   return record64_type;
 }
 
   return record64_type;
 }
 
@@ -3087,9 +3159,9 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
   tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
   tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
   /* The CLASS field is the 3rd field in the descriptor.  */
   tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
   tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
   /* The CLASS field is the 3rd field in the descriptor.  */
-  tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
+  tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
   /* The POINTER field is the 6th field in the descriptor.  */
   /* The POINTER field is the 6th field in the descriptor.  */
-  tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (class)));
+  tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
 
   /* Retrieve the value of the POINTER field.  */
   tree gnu_expr64
 
   /* Retrieve the value of the POINTER field.  */
   tree gnu_expr64
@@ -3098,43 +3170,43 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
   if (POINTER_TYPE_P (gnu_type))
     return convert (gnu_type, gnu_expr64);
 
   if (POINTER_TYPE_P (gnu_type))
     return convert (gnu_type, gnu_expr64);
 
-  else if (TYPE_FAT_POINTER_P (gnu_type))
+  else if (TYPE_IS_FAT_POINTER_P (gnu_type))
     {
       tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
       tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
       tree template_type = TREE_TYPE (p_bounds_type);
       tree min_field = TYPE_FIELDS (template_type);
       tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
     {
       tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
       tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
       tree template_type = TREE_TYPE (p_bounds_type);
       tree min_field = TYPE_FIELDS (template_type);
       tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
-      tree template, template_addr, aflags, dimct, t, u;
+      tree template_tree, template_addr, aflags, dimct, t, u;
       /* See the head comment of build_vms_descriptor.  */
       /* See the head comment of build_vms_descriptor.  */
-      int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
+      int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
       tree lfield, ufield;
 
       /* Convert POINTER to the type of the P_ARRAY field.  */
       gnu_expr64 = convert (p_array_type, gnu_expr64);
 
       tree lfield, ufield;
 
       /* Convert POINTER to the type of the P_ARRAY field.  */
       gnu_expr64 = convert (p_array_type, gnu_expr64);
 
-      switch (iclass)
+      switch (iklass)
        {
        case 1:  /* Class S  */
        case 15: /* Class SB */
          /* Build {1, LENGTH} template; LENGTH64 is the 5th field.  */
        {
        case 1:  /* Class S  */
        case 15: /* Class SB */
          /* Build {1, LENGTH} template; LENGTH64 is the 5th field.  */
-         t = TREE_CHAIN (TREE_CHAIN (class));
+         t = TREE_CHAIN (TREE_CHAIN (klass));
          t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
          t = tree_cons (min_field,
                         convert (TREE_TYPE (min_field), integer_one_node),
                         tree_cons (max_field,
                                    convert (TREE_TYPE (max_field), t),
                                    NULL_TREE));
          t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
          t = tree_cons (min_field,
                         convert (TREE_TYPE (min_field), integer_one_node),
                         tree_cons (max_field,
                                    convert (TREE_TYPE (max_field), t),
                                    NULL_TREE));
-         template = gnat_build_constructor (template_type, t);
-         template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
+         template_tree = gnat_build_constructor (template_type, t);
+         template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree);
 
          /* For class S, we are done.  */
 
          /* For class S, we are done.  */
-         if (iclass == 1)
+         if (iklass == 1)
            break;
 
          /* Test that we really have a SB descriptor, like DEC Ada.  */
            break;
 
          /* Test that we really have a SB descriptor, like DEC Ada.  */
-         t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL);
-         u = convert (TREE_TYPE (class), DECL_INITIAL (class));
+         t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL);
+         u = convert (TREE_TYPE (klass), DECL_INITIAL (klass));
          u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
          /* If so, there is already a template in the descriptor and
             it is located right after the POINTER field.  The fields are
          u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
          /* If so, there is already a template in the descriptor and
             it is located right after the POINTER field.  The fields are
@@ -3152,12 +3224,12 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
          t = tree_cons (TYPE_FIELDS (template_type), lfield,
                         tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
                                     ufield, NULL_TREE));
          t = tree_cons (TYPE_FIELDS (template_type), lfield,
                         tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
                                     ufield, NULL_TREE));
-         template = gnat_build_constructor (template_type, t);
+         template_tree = gnat_build_constructor (template_type, t);
 
          /* Otherwise use the {1, LENGTH} template we build above.  */
          template_addr = build3 (COND_EXPR, p_bounds_type, u,
                                  build_unary_op (ADDR_EXPR, p_bounds_type,
 
          /* Otherwise use the {1, LENGTH} template we build above.  */
          template_addr = build3 (COND_EXPR, p_bounds_type, u,
                                  build_unary_op (ADDR_EXPR, p_bounds_type,
-                                                template),
+                                                template_tree),
                                  template_addr);
          break;
 
                                  template_addr);
          break;
 
@@ -3199,12 +3271,13 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
          t = tree_cons (TYPE_FIELDS (template_type), lfield,
                         tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
                                     ufield, NULL_TREE));
          t = tree_cons (TYPE_FIELDS (template_type), lfield,
                         tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
                                     ufield, NULL_TREE));
-         template = gnat_build_constructor (template_type, t);
-         template = build3 (COND_EXPR, p_bounds_type, u,
+         template_tree = gnat_build_constructor (template_type, t);
+         template_tree = build3 (COND_EXPR, template_type, u,
                            build_call_raise (CE_Length_Check_Failed, Empty,
                                              N_Raise_Constraint_Error),
                            build_call_raise (CE_Length_Check_Failed, Empty,
                                              N_Raise_Constraint_Error),
-                           template);
-         template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
+                           template_tree);
+         template_addr
+           = build_unary_op (ADDR_EXPR, p_bounds_type, template_tree);
          break;
 
        case 10: /* Class NCA */
          break;
 
        case 10: /* Class NCA */
@@ -3235,9 +3308,9 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
   tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
   tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
   /* The CLASS field is the 3rd field in the descriptor.  */
   tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
   tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
   /* The CLASS field is the 3rd field in the descriptor.  */
-  tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
+  tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
   /* The POINTER field is the 4th field in the descriptor.  */
   /* The POINTER field is the 4th field in the descriptor.  */
-  tree pointer = TREE_CHAIN (class);
+  tree pointer = TREE_CHAIN (klass);
 
   /* Retrieve the value of the POINTER field.  */
   tree gnu_expr32
 
   /* Retrieve the value of the POINTER field.  */
   tree gnu_expr32
@@ -3246,21 +3319,21 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
   if (POINTER_TYPE_P (gnu_type))
     return convert (gnu_type, gnu_expr32);
 
   if (POINTER_TYPE_P (gnu_type))
     return convert (gnu_type, gnu_expr32);
 
-  else if (TYPE_FAT_POINTER_P (gnu_type))
+  else if (TYPE_IS_FAT_POINTER_P (gnu_type))
     {
       tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
       tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
       tree template_type = TREE_TYPE (p_bounds_type);
       tree min_field = TYPE_FIELDS (template_type);
       tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
     {
       tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
       tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
       tree template_type = TREE_TYPE (p_bounds_type);
       tree min_field = TYPE_FIELDS (template_type);
       tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
-      tree template, template_addr, aflags, dimct, t, u;
+      tree template_tree, template_addr, aflags, dimct, t, u;
       /* See the head comment of build_vms_descriptor.  */
       /* See the head comment of build_vms_descriptor.  */
-      int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
+      int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
 
       /* Convert POINTER to the type of the P_ARRAY field.  */
       gnu_expr32 = convert (p_array_type, gnu_expr32);
 
 
       /* Convert POINTER to the type of the P_ARRAY field.  */
       gnu_expr32 = convert (p_array_type, gnu_expr32);
 
-      switch (iclass)
+      switch (iklass)
        {
        case 1:  /* Class S  */
        case 15: /* Class SB */
        {
        case 1:  /* Class S  */
        case 15: /* Class SB */
@@ -3272,25 +3345,26 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
                         tree_cons (max_field,
                                    convert (TREE_TYPE (max_field), t),
                                    NULL_TREE));
                         tree_cons (max_field,
                                    convert (TREE_TYPE (max_field), t),
                                    NULL_TREE));
-         template = gnat_build_constructor (template_type, t);
-         template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
+         template_tree = gnat_build_constructor (template_type, t);
+         template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree);
 
          /* For class S, we are done.  */
 
          /* For class S, we are done.  */
-         if (iclass == 1)
+         if (iklass == 1)
            break;
 
          /* Test that we really have a SB descriptor, like DEC Ada.  */
            break;
 
          /* Test that we really have a SB descriptor, like DEC Ada.  */
-         t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL);
-         u = convert (TREE_TYPE (class), DECL_INITIAL (class));
+         t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL);
+         u = convert (TREE_TYPE (klass), DECL_INITIAL (klass));
          u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
          /* If so, there is already a template in the descriptor and
             it is located right after the POINTER field.  */
          t = TREE_CHAIN (pointer);
          u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
          /* If so, there is already a template in the descriptor and
             it is located right after the POINTER field.  */
          t = TREE_CHAIN (pointer);
-         template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+         template_tree
+           = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
          /* Otherwise use the {1, LENGTH} template we build above.  */
          template_addr = build3 (COND_EXPR, p_bounds_type, u,
                                  build_unary_op (ADDR_EXPR, p_bounds_type,
          /* Otherwise use the {1, LENGTH} template we build above.  */
          template_addr = build3 (COND_EXPR, p_bounds_type, u,
                                  build_unary_op (ADDR_EXPR, p_bounds_type,
-                                                template),
+                                                template_tree),
                                  template_addr);
          break;
 
                                  template_addr);
          break;
 
@@ -3317,12 +3391,14 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
          /* There is already a template in the descriptor and it is
             located at the start of block 3 (12th field).  */
          t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
          /* There is already a template in the descriptor and it is
             located at the start of block 3 (12th field).  */
          t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
-         template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
-         template = build3 (COND_EXPR, p_bounds_type, u,
+         template_tree
+           = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+         template_tree = build3 (COND_EXPR, TREE_TYPE (t), u,
                            build_call_raise (CE_Length_Check_Failed, Empty,
                                              N_Raise_Constraint_Error),
                            build_call_raise (CE_Length_Check_Failed, Empty,
                                              N_Raise_Constraint_Error),
-                           template);
-         template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
+                           template_tree);
+         template_addr
+           = build_unary_op (ADDR_EXPR, p_bounds_type, template_tree);
          break;
 
        case 10: /* Class NCA */
          break;
 
        case 10: /* Class NCA */
@@ -3444,7 +3520,7 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
   gnat_poplevel ();
 
   allocate_struct_function (gnu_stub_decl, false);
   gnat_poplevel ();
 
   allocate_struct_function (gnu_stub_decl, false);
-  end_subprog_body (gnu_body, false);
+  end_subprog_body (gnu_body);
 }
 \f
 /* Build a type to be used to represent an aliased object whose nominal
 }
 \f
 /* Build a type to be used to represent an aliased object whose nominal
@@ -3468,7 +3544,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name)
   finish_record_type (type,
                      chainon (chainon (NULL_TREE, template_field),
                               array_field),
   finish_record_type (type,
                      chainon (chainon (NULL_TREE, template_field),
                               array_field),
-                     0, false);
+                     0, true);
 
   return type;
 }
 
   return type;
 }
@@ -3481,10 +3557,10 @@ build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type,
 {
   tree template_type;
 
 {
   tree template_type;
 
-  gcc_assert (TYPE_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type));
+  gcc_assert (TYPE_IS_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type));
 
   template_type
 
   template_type
-    = (TYPE_FAT_POINTER_P (thin_fat_ptr_type)
+    = (TYPE_IS_FAT_POINTER_P (thin_fat_ptr_type)
        ? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type))))
        : TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type))));
   return build_unc_object_type (template_type, object_type, name);
        ? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type))))
        : TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type))));
   return build_unc_object_type (template_type, object_type, name);
@@ -3580,7 +3656,7 @@ update_pointer_to (tree old_type, tree new_type)
   /* Now deal with the unconstrained array case.  In this case the "pointer"
      is actually a RECORD_TYPE where both fields are pointers to dummy nodes.
      Turn them into pointers to the correct types using update_pointer_to.  */
   /* Now deal with the unconstrained array case.  In this case the "pointer"
      is actually a RECORD_TYPE where both fields are pointers to dummy nodes.
      Turn them into pointers to the correct types using update_pointer_to.  */
-  else if (!TYPE_FAT_POINTER_P (ptr))
+  else if (!TYPE_IS_FAT_POINTER_P (ptr))
     gcc_unreachable ();
 
   else
     gcc_unreachable ();
 
   else
@@ -3617,6 +3693,18 @@ update_pointer_to (tree old_type, tree new_type)
       TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
        = TREE_TYPE (new_type) = ptr;
 
       TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
        = TREE_TYPE (new_type) = ptr;
 
+      /* And show the original pointer NEW_PTR to the debugger.  This is the
+        counterpart of the equivalent processing in gnat_pushdecl when the
+        unconstrained array type is frozen after access types to it.  Note
+        that update_pointer_to can be invoked multiple times on the same
+        couple of types because of the type variants.  */
+      if (TYPE_NAME (ptr)
+         && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL
+         && !DECL_ORIGINAL_TYPE (TYPE_NAME (ptr)))
+       {
+         DECL_ORIGINAL_TYPE (TYPE_NAME (ptr)) = new_ptr;
+         DECL_ARTIFICIAL (TYPE_NAME (ptr)) = 0;
+       }
       for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
        SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
 
       for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
        SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
 
@@ -3653,7 +3741,7 @@ convert_to_fat_pointer (tree type, tree expr)
   tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))));
   tree p_array_type = TREE_TYPE (TYPE_FIELDS (type));
   tree etype = TREE_TYPE (expr);
   tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))));
   tree p_array_type = TREE_TYPE (TYPE_FIELDS (type));
   tree etype = TREE_TYPE (expr);
-  tree template;
+  tree template_tree;
 
   /* If EXPR is null, make a fat pointer that contains null pointers to the
      template and array.  */
 
   /* If EXPR is null, make a fat pointer that contains null pointers to the
      template and array.  */
@@ -3669,7 +3757,7 @@ convert_to_fat_pointer (tree type, tree expr)
                               NULL_TREE)));
 
   /* If EXPR is a thin pointer, make template and data from the record..  */
                               NULL_TREE)));
 
   /* If EXPR is a thin pointer, make template and data from the record..  */
-  else if (TYPE_THIN_POINTER_P (etype))
+  else if (TYPE_IS_THIN_POINTER_P (etype))
     {
       tree fields = TYPE_FIELDS (TREE_TYPE (etype));
 
     {
       tree fields = TYPE_FIELDS (TREE_TYPE (etype));
 
@@ -3679,7 +3767,7 @@ convert_to_fat_pointer (tree type, tree expr)
       else
        expr = build1 (INDIRECT_REF, TREE_TYPE (etype), expr);
 
       else
        expr = build1 (INDIRECT_REF, TREE_TYPE (etype), expr);
 
-      template = build_component_ref (expr, NULL_TREE, fields, false);
+      template_tree = build_component_ref (expr, NULL_TREE, fields, false);
       expr = build_unary_op (ADDR_EXPR, NULL_TREE,
                             build_component_ref (expr, NULL_TREE,
                                                  TREE_CHAIN (fields), false));
       expr = build_unary_op (ADDR_EXPR, NULL_TREE,
                             build_component_ref (expr, NULL_TREE,
                                                  TREE_CHAIN (fields), false));
@@ -3687,7 +3775,7 @@ convert_to_fat_pointer (tree type, tree expr)
 
   /* Otherwise, build the constructor for the template.  */
   else
 
   /* Otherwise, build the constructor for the template.  */
   else
-    template = build_template (template_type, TREE_TYPE (etype), expr);
+    template_tree = build_template (template_type, TREE_TYPE (etype), expr);
 
   /* The final result is a constructor for the fat pointer.
 
 
   /* The final result is a constructor for the fat pointer.
 
@@ -3707,7 +3795,8 @@ convert_to_fat_pointer (tree type, tree expr)
        tree_cons (TYPE_FIELDS (type),
                  convert (p_array_type, expr),
                  tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
        tree_cons (TYPE_FIELDS (type),
                  convert (p_array_type, expr),
                  tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
-                            build_unary_op (ADDR_EXPR, NULL_TREE, template),
+                            build_unary_op (ADDR_EXPR, NULL_TREE,
+                                            template_tree),
                             NULL_TREE)));
 }
 \f
                             NULL_TREE)));
 }
 \f
@@ -3718,7 +3807,7 @@ convert_to_fat_pointer (tree type, tree expr)
 static tree
 convert_to_thin_pointer (tree type, tree expr)
 {
 static tree
 convert_to_thin_pointer (tree type, tree expr)
 {
-  if (!TYPE_FAT_POINTER_P (TREE_TYPE (expr)))
+  if (!TYPE_IS_FAT_POINTER_P (TREE_TYPE (expr)))
     expr
       = convert_to_fat_pointer
        (TREE_TYPE (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type))), expr);
     expr
       = convert_to_fat_pointer
        (TREE_TYPE (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type))), expr);
@@ -3753,7 +3842,7 @@ convert (tree type, tree expr)
      as an unchecked conversion.  Likewise if one is a mere variant of the
      other, so we avoid a pointless unpad/repad sequence.  */
   else if (code == RECORD_TYPE && ecode == RECORD_TYPE
      as an unchecked conversion.  Likewise if one is a mere variant of the
      other, so we avoid a pointless unpad/repad sequence.  */
   else if (code == RECORD_TYPE && ecode == RECORD_TYPE
-          && TYPE_IS_PADDING_P (type) && TYPE_IS_PADDING_P (etype)
+          && TYPE_PADDING_P (type) && TYPE_PADDING_P (etype)
           && (!TREE_CONSTANT (TYPE_SIZE (type))
               || !TREE_CONSTANT (TYPE_SIZE (etype))
               || gnat_types_compatible_p (type, etype)
           && (!TREE_CONSTANT (TYPE_SIZE (type))
               || !TREE_CONSTANT (TYPE_SIZE (etype))
               || gnat_types_compatible_p (type, etype)
@@ -3761,13 +3850,13 @@ convert (tree type, tree expr)
                  == TYPE_NAME (TREE_TYPE (TYPE_FIELDS (etype)))))
     ;
 
                  == TYPE_NAME (TREE_TYPE (TYPE_FIELDS (etype)))))
     ;
 
-  /* If the output type has padding, convert to the inner type and
-     make a constructor to build the record.  */
-  else if (code == RECORD_TYPE && TYPE_IS_PADDING_P (type))
+  /* If the output type has padding, convert to the inner type and make a
+     constructor to build the record, unless a variable size is involved.  */
+  else if (code == RECORD_TYPE && TYPE_PADDING_P (type))
     {
       /* If we previously converted from another type and our type is
         of variable size, remove the conversion to avoid the need for
     {
       /* If we previously converted from another type and our type is
         of variable size, remove the conversion to avoid the need for
-        variable-size temporaries.  Likewise for a conversion between
+        variable-sized temporaries.  Likewise for a conversion between
         original and packable version.  */
       if (TREE_CODE (expr) == VIEW_CONVERT_EXPR
          && (!TREE_CONSTANT (TYPE_SIZE (type))
         original and packable version.  */
       if (TREE_CODE (expr) == VIEW_CONVERT_EXPR
          && (!TREE_CONSTANT (TYPE_SIZE (type))
@@ -3778,10 +3867,9 @@ convert (tree type, tree expr)
 
       /* If we are just removing the padding from expr, convert the original
         object if we have variable size in order to avoid the need for some
 
       /* If we are just removing the padding from expr, convert the original
         object if we have variable size in order to avoid the need for some
-        variable-size temporaries.  Likewise if the padding is a mere variant
+        variable-sized temporaries.  Likewise if the padding is a variant
         of the other, so we avoid a pointless unpad/repad sequence.  */
       if (TREE_CODE (expr) == COMPONENT_REF
         of the other, so we avoid a pointless unpad/repad sequence.  */
       if (TREE_CODE (expr) == COMPONENT_REF
-         && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == RECORD_TYPE
          && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0)))
          && (!TREE_CONSTANT (TYPE_SIZE (type))
              || gnat_types_compatible_p (type,
          && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0)))
          && (!TREE_CONSTANT (TYPE_SIZE (type))
              || gnat_types_compatible_p (type,
@@ -3791,28 +3879,45 @@ convert (tree type, tree expr)
                     == TYPE_NAME (TREE_TYPE (TYPE_FIELDS (type))))))
        return convert (type, TREE_OPERAND (expr, 0));
 
                     == TYPE_NAME (TREE_TYPE (TYPE_FIELDS (type))))))
        return convert (type, TREE_OPERAND (expr, 0));
 
-      /* If the result type is a padded type with a self-referentially-sized
-        field and the expression type is a record, do this as an
-        unchecked conversion.  */
-      else if (TREE_CODE (etype) == RECORD_TYPE
-              && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
-       return unchecked_convert (type, expr, false);
+      /* If the inner type is of self-referential size and the expression type
+        is a record, do this as an unchecked conversion.  But first pad the
+        expression if possible to have the same size on both sides.  */
+      if (TREE_CODE (etype) == RECORD_TYPE
+         && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
+       {
+         if (TREE_CONSTANT (TYPE_SIZE (etype)))
+           expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
+                           false, false, false, true), expr);
+         return unchecked_convert (type, expr, false);
+       }
 
 
-      else
-       return
-         gnat_build_constructor (type,
-                            tree_cons (TYPE_FIELDS (type),
-                                       convert (TREE_TYPE
-                                                (TYPE_FIELDS (type)),
-                                                expr),
-                                       NULL_TREE));
+      /* If we are converting between array types with variable size, do the
+        final conversion as an unchecked conversion, again to avoid the need
+        for some variable-sized temporaries.  If valid, this conversion is
+        very likely purely technical and without real effects.  */
+      if (TREE_CODE (etype) == ARRAY_TYPE
+         && TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE
+         && !TREE_CONSTANT (TYPE_SIZE (etype))
+         && !TREE_CONSTANT (TYPE_SIZE (type)))
+       return unchecked_convert (type,
+                                 convert (TREE_TYPE (TYPE_FIELDS (type)),
+                                          expr),
+                                 false);
+
+      return
+       gnat_build_constructor (type,
+                               tree_cons (TYPE_FIELDS (type),
+                                          convert (TREE_TYPE
+                                                   (TYPE_FIELDS (type)),
+                                                   expr),
+                                          NULL_TREE));
     }
 
   /* If the input type has padding, remove it and convert to the output type.
      The conditions ordering is arranged to ensure that the output type is not
      a padding type here, as it is not clear whether the conversion would
      always be correct if this was to happen.  */
     }
 
   /* If the input type has padding, remove it and convert to the output type.
      The conditions ordering is arranged to ensure that the output type is not
      a padding type here, as it is not clear whether the conversion would
      always be correct if this was to happen.  */
-  else if (ecode == RECORD_TYPE && TYPE_IS_PADDING_P (etype))
+  else if (ecode == RECORD_TYPE && TYPE_PADDING_P (etype))
     {
       tree unpadded;
 
     {
       tree unpadded;
 
@@ -3901,6 +4006,16 @@ convert (tree type, tree expr)
        }
       break;
 
        }
       break;
 
+    case VECTOR_CST:
+      /* If we are converting a VECTOR_CST to a mere variant type, just make
+        a new one in the proper type.  */
+      if (code == ecode && gnat_types_compatible_p (type, etype))
+       {
+         expr = copy_node (expr);
+         TREE_TYPE (expr) = type;
+         return expr;
+       }
+
     case CONSTRUCTOR:
       /* If we are converting a CONSTRUCTOR to a mere variant type, just make
         a new one in the proper type.  */
     case CONSTRUCTOR:
       /* If we are converting a CONSTRUCTOR to a mere variant type, just make
         a new one in the proper type.  */
@@ -3924,6 +4039,10 @@ convert (tree type, tree expr)
          unsigned HOST_WIDE_INT idx;
          tree index, value;
 
          unsigned HOST_WIDE_INT idx;
          tree index, value;
 
+         /* Whether we need to clear TREE_CONSTANT et al. on the output
+            constructor when we convert in place.  */
+         bool clear_constant = false;
+
          FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
            {
              constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
          FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
            {
              constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
@@ -3932,18 +4051,79 @@ convert (tree type, tree expr)
                break;
              elt->index = field;
              elt->value = convert (TREE_TYPE (field), value);
                break;
              elt->index = field;
              elt->value = convert (TREE_TYPE (field), value);
+
+             /* If packing has made this field a bitfield and the input
+                value couldn't be emitted statically any more, we need to
+                clear TREE_CONSTANT on our output.  */
+             if (!clear_constant && TREE_CONSTANT (expr)
+                 && !CONSTRUCTOR_BITFIELD_P (efield)
+                 && CONSTRUCTOR_BITFIELD_P (field)
+                 && !initializer_constant_valid_for_bitfield_p (value))
+               clear_constant = true;
+
              efield = TREE_CHAIN (efield);
              field = TREE_CHAIN (field);
            }
 
              efield = TREE_CHAIN (efield);
              field = TREE_CHAIN (field);
            }
 
+         /* If we have been able to match and convert all the input fields
+            to their output type, convert in place now.  We'll fallback to a
+            view conversion downstream otherwise.  */
          if (idx == len)
            {
              expr = copy_node (expr);
              TREE_TYPE (expr) = type;
              CONSTRUCTOR_ELTS (expr) = v;
          if (idx == len)
            {
              expr = copy_node (expr);
              TREE_TYPE (expr) = type;
              CONSTRUCTOR_ELTS (expr) = v;
+             if (clear_constant)
+               TREE_CONSTANT (expr) = TREE_STATIC (expr) = false;
              return expr;
            }
        }
              return expr;
            }
        }
+
+      /* Likewise for a conversion between array type and vector type with a
+         compatible representative array.  */
+      else if (code == VECTOR_TYPE
+              && ecode == ARRAY_TYPE
+              && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
+                                          etype))
+       {
+         VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr);
+         unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e);
+         VEC(constructor_elt,gc) *v;
+         unsigned HOST_WIDE_INT ix;
+         tree value;
+
+         /* Build a VECTOR_CST from a *constant* array constructor.  */
+         if (TREE_CONSTANT (expr))
+           {
+             bool constant_p = true;
+
+             /* Iterate through elements and check if all constructor
+                elements are *_CSTs.  */
+             FOR_EACH_CONSTRUCTOR_VALUE (e, ix, value)
+               if (!CONSTANT_CLASS_P (value))
+                 {
+                   constant_p = false;
+                   break;
+                 }
+
+             if (constant_p)
+               return build_vector_from_ctor (type,
+                                              CONSTRUCTOR_ELTS (expr));
+           }
+
+         /* Otherwise, build a regular vector constructor.  */
+         v = VEC_alloc (constructor_elt, gc, len);
+         FOR_EACH_CONSTRUCTOR_VALUE (e, ix, value)
+           {
+             constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
+             elt->index = NULL_TREE;
+             elt->value = value;
+           }
+         expr = copy_node (expr);
+         TREE_TYPE (expr) = type;
+         CONSTRUCTOR_ELTS (expr) = v;
+         return expr;
+       }
       break;
 
     case UNCONSTRAINED_ARRAY_REF:
       break;
 
     case UNCONSTRAINED_ARRAY_REF:
@@ -3972,10 +4152,11 @@ convert (tree type, tree expr)
        if (type == TREE_TYPE (op0))
          return op0;
 
        if (type == TREE_TYPE (op0))
          return op0;
 
-       /* Otherwise, if we're converting between two aggregate types, we
-          might be allowed to substitute the VIEW_CONVERT_EXPR target type
-          in place or to just convert the inner expression.  */
-       if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
+       /* Otherwise, if we're converting between two aggregate or vector
+          types, we might be allowed to substitute the VIEW_CONVERT_EXPR
+          target type in place or to just convert the inner expression.  */
+       if ((AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
+           || (VECTOR_TYPE_P (type) && VECTOR_TYPE_P (etype)))
          {
            /* If we are converting between mere variants, we can just
               substitute the VIEW_CONVERT_EXPR in place.  */
          {
            /* If we are converting between mere variants, we can just
               substitute the VIEW_CONVERT_EXPR in place.  */
@@ -3985,7 +4166,8 @@ convert (tree type, tree expr)
            /* Otherwise, we may just bypass the input view conversion unless
               one of the types is a fat pointer,  which is handled by
               specialized code below which relies on exact type matching.  */
            /* Otherwise, we may just bypass the input view conversion unless
               one of the types is a fat pointer,  which is handled by
               specialized code below which relies on exact type matching.  */
-           else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
+           else if (!TYPE_IS_FAT_POINTER_P (type)
+                    && !TYPE_IS_FAT_POINTER_P (etype))
              return convert (type, op0);
          }
       }
              return convert (type, op0);
          }
       }
@@ -4004,7 +4186,7 @@ convert (tree type, tree expr)
              || TREE_CODE (type) == UNION_TYPE)
          && (TREE_CODE (etype) == RECORD_TYPE
              || TREE_CODE (etype) == UNION_TYPE)
              || TREE_CODE (type) == UNION_TYPE)
          && (TREE_CODE (etype) == RECORD_TYPE
              || TREE_CODE (etype) == UNION_TYPE)
-         && !TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
+         && !TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype))
        return build_unary_op (INDIRECT_REF, NULL_TREE,
                               convert (build_pointer_type (type),
                                        TREE_OPERAND (expr, 0)));
        return build_unary_op (INDIRECT_REF, NULL_TREE,
                               convert (build_pointer_type (type),
                                        TREE_OPERAND (expr, 0)));
@@ -4015,14 +4197,19 @@ convert (tree type, tree expr)
     }
 
   /* Check for converting to a pointer to an unconstrained array.  */
     }
 
   /* Check for converting to a pointer to an unconstrained array.  */
-  if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
+  if (TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype))
     return convert_to_fat_pointer (type, expr);
 
     return convert_to_fat_pointer (type, expr);
 
-  /* If we are converting between two aggregate types that are mere
-     variants, just make a VIEW_CONVERT_EXPR.  */
-  else if (code == ecode
-          && AGGREGATE_TYPE_P (type)
-          && gnat_types_compatible_p (type, etype))
+  /* If we are converting between two aggregate or vector types that are mere
+     variants, just make a VIEW_CONVERT_EXPR.  Likewise when we are converting
+     to a vector type from its representative array type.  */
+  else if ((code == ecode
+           && (AGGREGATE_TYPE_P (type) || VECTOR_TYPE_P (type))
+           && gnat_types_compatible_p (type, etype))
+          || (code == VECTOR_TYPE
+              && ecode == ARRAY_TYPE
+              && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
+                                          etype)))
     return build1 (VIEW_CONVERT_EXPR, type, expr);
 
   /* In all other cases of related types, make a NOP_EXPR.  */
     return build1 (VIEW_CONVERT_EXPR, type, expr);
 
   /* In all other cases of related types, make a NOP_EXPR.  */
@@ -4082,7 +4269,7 @@ convert (tree type, tree expr)
       /* If converting between two pointers to records denoting
         both a template and type, adjust if needed to account
         for any differing offsets, since one might be negative.  */
       /* If converting between two pointers to records denoting
         both a template and type, adjust if needed to account
         for any differing offsets, since one might be negative.  */
-      if (TYPE_THIN_POINTER_P (etype) && TYPE_THIN_POINTER_P (type))
+      if (TYPE_IS_THIN_POINTER_P (etype) && TYPE_IS_THIN_POINTER_P (type))
        {
          tree bit_diff
            = size_diffop (bit_position (TYPE_FIELDS (TREE_TYPE (etype))),
        {
          tree bit_diff
            = size_diffop (bit_position (TYPE_FIELDS (TREE_TYPE (etype))),
@@ -4100,13 +4287,13 @@ convert (tree type, tree expr)
        }
 
       /* If converting to a thin pointer, handle specially.  */
        }
 
       /* If converting to a thin pointer, handle specially.  */
-      if (TYPE_THIN_POINTER_P (type)
+      if (TYPE_IS_THIN_POINTER_P (type)
          && TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)))
        return convert_to_thin_pointer (type, expr);
 
       /* If converting fat pointer to normal pointer, get the pointer to the
         array and then convert it.  */
          && TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)))
        return convert_to_thin_pointer (type, expr);
 
       /* If converting fat pointer to normal pointer, get the pointer to the
         array and then convert it.  */
-      else if (TYPE_FAT_POINTER_P (etype))
+      else if (TYPE_IS_FAT_POINTER_P (etype))
        expr = build_component_ref (expr, get_identifier ("P_ARRAY"),
                                    NULL_TREE, false);
 
        expr = build_component_ref (expr, get_identifier ("P_ARRAY"),
                                    NULL_TREE, false);
 
@@ -4138,6 +4325,15 @@ convert (tree type, tree expr)
       return unchecked_convert (type, expr, false);
 
     case UNCONSTRAINED_ARRAY_TYPE:
       return unchecked_convert (type, expr, false);
 
     case UNCONSTRAINED_ARRAY_TYPE:
+      /* If the input is a VECTOR_TYPE, convert to the representative
+        array type first.  */
+      if (ecode == VECTOR_TYPE)
+       {
+         expr = convert (TYPE_REPRESENTATIVE_ARRAY (etype), expr);
+         etype = TREE_TYPE (expr);
+         ecode = TREE_CODE (etype);
+       }
+
       /* If EXPR is a constrained array, take its address, convert it to a
         fat pointer, and then dereference it.  Likewise if EXPR is a
         record containing both a template and a constrained array.
       /* If EXPR is a constrained array, take its address, convert it to a
         fat pointer, and then dereference it.  Likewise if EXPR is a
         record containing both a template and a constrained array.
@@ -4194,8 +4390,7 @@ remove_conversions (tree exp, bool true_address)
       break;
 
     case COMPONENT_REF:
       break;
 
     case COMPONENT_REF:
-      if (TREE_CODE (TREE_TYPE (TREE_OPERAND (exp, 0))) == RECORD_TYPE
-         && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
+      if (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
        return remove_conversions (TREE_OPERAND (exp, 0), true_address);
       break;
 
        return remove_conversions (TREE_OPERAND (exp, 0), true_address);
       break;
 
@@ -4218,20 +4413,21 @@ tree
 maybe_unconstrained_array (tree exp)
 {
   enum tree_code code = TREE_CODE (exp);
 maybe_unconstrained_array (tree exp)
 {
   enum tree_code code = TREE_CODE (exp);
-  tree new;
+  tree new_exp;
 
   switch (TREE_CODE (TREE_TYPE (exp)))
     {
     case UNCONSTRAINED_ARRAY_TYPE:
       if (code == UNCONSTRAINED_ARRAY_REF)
        {
 
   switch (TREE_CODE (TREE_TYPE (exp)))
     {
     case UNCONSTRAINED_ARRAY_TYPE:
       if (code == UNCONSTRAINED_ARRAY_REF)
        {
-         new
+         new_exp
            = build_unary_op (INDIRECT_REF, NULL_TREE,
                              build_component_ref (TREE_OPERAND (exp, 0),
                                                   get_identifier ("P_ARRAY"),
                                                   NULL_TREE, false));
            = build_unary_op (INDIRECT_REF, NULL_TREE,
                              build_component_ref (TREE_OPERAND (exp, 0),
                                                   get_identifier ("P_ARRAY"),
                                                   NULL_TREE, false));
-         TREE_READONLY (new) = TREE_STATIC (new) = TREE_READONLY (exp);
-         return new;
+         TREE_READONLY (new_exp) = TREE_STATIC (new_exp)
+           = TREE_READONLY (exp);
+         return new_exp;
        }
 
       else if (code == NULL_EXPR)
        }
 
       else if (code == NULL_EXPR)
@@ -4243,14 +4439,15 @@ maybe_unconstrained_array (tree exp)
     case RECORD_TYPE:
       /* If this is a padded type, convert to the unpadded type and see if
         it contains a template.  */
     case RECORD_TYPE:
       /* If this is a padded type, convert to the unpadded type and see if
         it contains a template.  */
-      if (TYPE_IS_PADDING_P (TREE_TYPE (exp)))
+      if (TYPE_PADDING_P (TREE_TYPE (exp)))
        {
        {
-         new = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
-         if (TREE_CODE (TREE_TYPE (new)) == RECORD_TYPE
-             && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new)))
+         new_exp = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
+         if (TREE_CODE (TREE_TYPE (new_exp)) == RECORD_TYPE
+             && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new_exp)))
            return
            return
-             build_component_ref (new, NULL_TREE,
-                                  TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new))),
+             build_component_ref (new_exp, NULL_TREE,
+                                  TREE_CHAIN
+                                  (TYPE_FIELDS (TREE_TYPE (new_exp))),
                                   0);
        }
       else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
                                   0);
        }
       else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
@@ -4265,10 +4462,23 @@ maybe_unconstrained_array (tree exp)
 
   return exp;
 }
 
   return exp;
 }
+
+/* If EXP's type is a VECTOR_TYPE, return EXP converted to the associated
+   TYPE_REPRESENTATIVE_ARRAY.  */
+
+tree
+maybe_vector_array (tree exp)
+{
+  tree etype = TREE_TYPE (exp);
+
+  if (VECTOR_TYPE_P (etype))
+    exp = convert (TYPE_REPRESENTATIVE_ARRAY (etype), exp);
+
+  return exp;
+}
 \f
 /* Return true if EXPR is an expression that can be folded as an operand
 \f
 /* Return true if EXPR is an expression that can be folded as an operand
-   of a VIEW_CONVERT_EXPR.  See the head comment of unchecked_convert for
-   the rationale.  */
+   of a VIEW_CONVERT_EXPR.  See ada-tree.h for a complete rationale.  */
 
 static bool
 can_fold_for_view_convert_p (tree expr)
 
 static bool
 can_fold_for_view_convert_p (tree expr)
@@ -4316,22 +4526,7 @@ can_fold_for_view_convert_p (tree expr)
 
    we expect the 8 bits at Vbits'Address to always contain Value, while
    their original location depends on the endianness, at Value'Address
 
    we expect the 8 bits at Vbits'Address to always contain Value, while
    their original location depends on the endianness, at Value'Address
-   on a little-endian architecture but not on a big-endian one.
-
-   ??? There is a problematic discrepancy between what is called precision
-   here (and more generally throughout gigi) for integral types and what is
-   called precision in the middle-end.  In the former case it's the RM size
-   as given by TYPE_RM_SIZE (or rm_size) whereas it's TYPE_PRECISION in the
-   latter case, the hitch being that they are not equal when they matter,
-   that is when the number of value bits is not equal to the type's size:
-   TYPE_RM_SIZE does give the number of value bits but TYPE_PRECISION is set
-   to the size.  The sole exception are BOOLEAN_TYPEs for which both are 1.
-
-   The consequence is that gigi must duplicate code bridging the gap between
-   the type's size and its precision that exists for TYPE_PRECISION in the
-   middle-end, because the latter knows nothing about TYPE_RM_SIZE, and be
-   wary of transformations applied in the middle-end based on TYPE_PRECISION
-   because this value doesn't reflect the actual precision for Ada.  */
+   on a little-endian architecture but not on a big-endian one.  */
 
 tree
 unchecked_convert (tree type, tree expr, bool notrunc_p)
 
 tree
 unchecked_convert (tree type, tree expr, bool notrunc_p)
@@ -4347,13 +4542,13 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
   if ((((INTEGRAL_TYPE_P (type)
         && !(TREE_CODE (type) == INTEGER_TYPE
              && TYPE_VAX_FLOATING_POINT_P (type)))
   if ((((INTEGRAL_TYPE_P (type)
         && !(TREE_CODE (type) == INTEGER_TYPE
              && TYPE_VAX_FLOATING_POINT_P (type)))
-       || (POINTER_TYPE_P (type) && ! TYPE_THIN_POINTER_P (type))
+       || (POINTER_TYPE_P (type) && ! TYPE_IS_THIN_POINTER_P (type))
        || (TREE_CODE (type) == RECORD_TYPE
            && TYPE_JUSTIFIED_MODULAR_P (type)))
        && ((INTEGRAL_TYPE_P (etype)
            && !(TREE_CODE (etype) == INTEGER_TYPE
                 && TYPE_VAX_FLOATING_POINT_P (etype)))
        || (TREE_CODE (type) == RECORD_TYPE
            && TYPE_JUSTIFIED_MODULAR_P (type)))
        && ((INTEGRAL_TYPE_P (etype)
            && !(TREE_CODE (etype) == INTEGER_TYPE
                 && TYPE_VAX_FLOATING_POINT_P (etype)))
-          || (POINTER_TYPE_P (etype) && !TYPE_THIN_POINTER_P (etype))
+          || (POINTER_TYPE_P (etype) && !TYPE_IS_THIN_POINTER_P (etype))
           || (TREE_CODE (etype) == RECORD_TYPE
               && TYPE_JUSTIFIED_MODULAR_P (etype))))
       || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
           || (TREE_CODE (etype) == RECORD_TYPE
               && TYPE_JUSTIFIED_MODULAR_P (etype))))
       || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
@@ -4376,43 +4571,6 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
          expr = convert (rtype, expr);
          expr = build1 (NOP_EXPR, type, expr);
        }
          expr = convert (rtype, expr);
          expr = build1 (NOP_EXPR, type, expr);
        }
-
-      /* We have another special case: if we are unchecked converting either
-        a subtype or a type with limited range into a base type, we need to
-        ensure that VRP doesn't propagate range information because this
-        conversion may be done precisely to validate that the object is
-        within the range it is supposed to have.  */
-      else if (TREE_CODE (expr) != INTEGER_CST
-              && TREE_CODE (type) == INTEGER_TYPE && !TREE_TYPE (type)
-              && ((TREE_CODE (etype) == INTEGER_TYPE && TREE_TYPE (etype))
-                  || TREE_CODE (etype) == ENUMERAL_TYPE
-                  || TREE_CODE (etype) == BOOLEAN_TYPE))
-       {
-         /* The optimization barrier is a VIEW_CONVERT_EXPR node; moreover,
-            in order not to be deemed an useless type conversion, it must
-            be from subtype to base type.
-
-            Therefore we first do the bulk of the conversion to a subtype of
-            the final type.  And this conversion must itself not be deemed
-            useless if the source type is not a subtype because, otherwise,
-            the final VIEW_CONVERT_EXPR will be deemed so as well.  That's
-            why we toggle the unsigned flag in this conversion, which is
-            harmless since the final conversion is only a reinterpretation
-            of the bit pattern.
-
-            ??? This may raise addressability and/or aliasing issues because
-            VIEW_CONVERT_EXPR gets gimplified as an lvalue, thus causing the
-            address of its operand to be taken if it is deemed addressable
-            and not already in GIMPLE form.  */
-         tree rtype
-           = gnat_type_for_mode (TYPE_MODE (type), !TYPE_UNSIGNED (etype));
-         rtype = copy_type (rtype);
-         TYPE_MAIN_VARIANT (rtype) = rtype;
-         TREE_TYPE (rtype) = type;
-         expr = convert (rtype, expr);
-         expr = build1 (VIEW_CONVERT_EXPR, type, expr);
-       }
-
       else
        expr = convert (type, expr);
     }
       else
        expr = convert (type, expr);
     }
@@ -4453,15 +4611,24 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
       expr = unchecked_convert (type, expr, notrunc_p);
     }
 
       expr = unchecked_convert (type, expr, notrunc_p);
     }
 
-  /* We have a special case when we are converting between two
-     unconstrained array types.  In that case, take the address,
-     convert the fat pointer types, and dereference.  */
+  /* We have a special case when we are converting between two unconstrained
+     array types.  In that case, take the address, convert the fat pointer
+     types, and dereference.  */
   else if (TREE_CODE (etype) == UNCONSTRAINED_ARRAY_TYPE
           && TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
     expr = build_unary_op (INDIRECT_REF, NULL_TREE,
                           build1 (VIEW_CONVERT_EXPR, TREE_TYPE (type),
                                   build_unary_op (ADDR_EXPR, NULL_TREE,
                                                   expr)));
   else if (TREE_CODE (etype) == UNCONSTRAINED_ARRAY_TYPE
           && TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
     expr = build_unary_op (INDIRECT_REF, NULL_TREE,
                           build1 (VIEW_CONVERT_EXPR, TREE_TYPE (type),
                                   build_unary_op (ADDR_EXPR, NULL_TREE,
                                                   expr)));
+
+  /* Another special case is when we are converting to a vector type from its
+     representative array type; this a regular conversion.  */
+  else if (TREE_CODE (type) == VECTOR_TYPE
+          && TREE_CODE (etype) == ARRAY_TYPE
+          && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
+                                      etype))
+    expr = convert (type, expr);
+
   else
     {
       expr = maybe_unconstrained_array (expr);
   else
     {
       expr = maybe_unconstrained_array (expr);
@@ -4525,7 +4692,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
   return expr;
 }
 \f
   return expr;
 }
 \f
-/* Return the appropriate GCC tree code for the specified GNAT type,
+/* Return the appropriate GCC tree code for the specified GNAT_TYPE,
    the latter being a record type as predicated by Is_Record_Type.  */
 
 enum tree_code
    the latter being a record type as predicated by Is_Record_Type.  */
 
 enum tree_code
@@ -4553,6 +4720,62 @@ tree_code_for_record_type (Entity_Id gnat_type)
   return UNION_TYPE;
 }
 
   return UNION_TYPE;
 }
 
+/* Return true if GNAT_TYPE is a "double" floating-point type, i.e. whose
+   size is equal to 64 bits, or an array of such a type.  Set ALIGN_CLAUSE
+   according to the presence of an alignment clause on the type or, if it
+   is an array, on the component type.  */
+
+bool
+is_double_float_or_array (Entity_Id gnat_type, bool *align_clause)
+{
+  gnat_type = Underlying_Type (gnat_type);
+
+  *align_clause = Present (Alignment_Clause (gnat_type));
+
+  if (Is_Array_Type (gnat_type))
+    {
+      gnat_type = Underlying_Type (Component_Type (gnat_type));
+      if (Present (Alignment_Clause (gnat_type)))
+       *align_clause = true;
+    }
+
+  if (!Is_Floating_Point_Type (gnat_type))
+    return false;
+
+  if (UI_To_Int (Esize (gnat_type)) != 64)
+    return false;
+
+  return true;
+}
+
+/* Return true if GNAT_TYPE is a "double" or larger scalar type, i.e. whose
+   size is greater or equal to 64 bits, or an array of such a type.  Set
+   ALIGN_CLAUSE according to the presence of an alignment clause on the
+   type or, if it is an array, on the component type.  */
+
+bool
+is_double_scalar_or_array (Entity_Id gnat_type, bool *align_clause)
+{
+  gnat_type = Underlying_Type (gnat_type);
+
+  *align_clause = Present (Alignment_Clause (gnat_type));
+
+  if (Is_Array_Type (gnat_type))
+    {
+      gnat_type = Underlying_Type (Component_Type (gnat_type));
+      if (Present (Alignment_Clause (gnat_type)))
+       *align_clause = true;
+    }
+
+  if (!Is_Scalar_Type (gnat_type))
+    return false;
+
+  if (UI_To_Int (Esize (gnat_type)) < 64)
+    return false;
+
+  return true;
+}
+
 /* Return true if GNU_TYPE is suitable as the type of a non-aliased
    component of an aggregate type.  */
 
 /* Return true if GNU_TYPE is suitable as the type of a non-aliased
    component of an aggregate type.  */
 
@@ -4592,7 +4815,7 @@ gnat_write_global_declarations (void)
 {
   /* Proceed to optimize and emit assembly.
      FIXME: shouldn't be the front end's responsibility to call this.  */
 {
   /* Proceed to optimize and emit assembly.
      FIXME: shouldn't be the front end's responsibility to call this.  */
-  cgraph_optimize ();
+  cgraph_finalize_compilation_unit ();
 
   /* Emit debug info for all global declarations.  */
   emit_debug_global_declarations (VEC_address (tree, global_decls),
 
   /* Emit debug info for all global declarations.  */
   emit_debug_global_declarations (VEC_address (tree, global_decls),
@@ -4775,7 +4998,7 @@ def_fn_type (builtin_type def, builtin_type ret, bool var, int n, ...)
   va_start (list, n);
   for (i = 0; i < n; ++i)
     {
   va_start (list, n);
   for (i = 0; i < n; ++i)
     {
-      builtin_type a = va_arg (list, builtin_type);
+      builtin_type a = (builtin_type) va_arg (list, int);
       t = builtin_types[a];
       if (t == error_mark_node)
        goto egress;
       t = builtin_types[a];
       if (t == error_mark_node)
        goto egress;
@@ -4956,7 +5179,8 @@ handle_pure_attribute (tree *node, tree name, tree ARG_UNUSED (args),
   /* ??? TODO: Support types.  */
   else
     {
   /* ??? TODO: Support types.  */
   else
     {
-      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      warning (OPT_Wattributes, "%qs attribute ignored",
+              IDENTIFIER_POINTER (name));
       *no_add_attrs = true;
     }
 
       *no_add_attrs = true;
     }
 
@@ -5071,7 +5295,8 @@ handle_sentinel_attribute (tree *node, tree name, tree args,
   if (!params)
     {
       warning (OPT_Wattributes,
   if (!params)
     {
       warning (OPT_Wattributes,
-              "%qE attribute requires prototypes with named arguments", name);
+              "%qs attribute requires prototypes with named arguments",
+              IDENTIFIER_POINTER (name));
       *no_add_attrs = true;
     }
   else
       *no_add_attrs = true;
     }
   else
@@ -5082,7 +5307,8 @@ handle_sentinel_attribute (tree *node, tree name, tree args,
       if (VOID_TYPE_P (TREE_VALUE (params)))
         {
          warning (OPT_Wattributes,
       if (VOID_TYPE_P (TREE_VALUE (params)))
         {
          warning (OPT_Wattributes,
-                  "%qE attribute only applies to variadic functions", name);
+                  "%qs attribute only applies to variadic functions",
+                  IDENTIFIER_POINTER (name));
          *no_add_attrs = true;
        }
     }
          *no_add_attrs = true;
        }
     }
@@ -5129,7 +5355,8 @@ handle_noreturn_attribute (tree *node, tree name, tree ARG_UNUSED (args),
                             TYPE_READONLY (TREE_TYPE (type)), 1));
   else
     {
                             TYPE_READONLY (TREE_TYPE (type)), 1));
   else
     {
-      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      warning (OPT_Wattributes, "%qs attribute ignored",
+              IDENTIFIER_POINTER (name));
       *no_add_attrs = true;
     }
 
       *no_add_attrs = true;
     }
 
@@ -5148,7 +5375,8 @@ handle_malloc_attribute (tree *node, tree name, tree ARG_UNUSED (args),
     DECL_IS_MALLOC (*node) = 1;
   else
     {
     DECL_IS_MALLOC (*node) = 1;
   else
     {
-      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      warning (OPT_Wattributes, "%qs attribute ignored",
+              IDENTIFIER_POINTER (name));
       *no_add_attrs = true;
     }
 
       *no_add_attrs = true;
     }
 
@@ -5189,6 +5417,189 @@ handle_type_generic_attribute (tree *node, tree ARG_UNUSED (name),
   return NULL_TREE;
 }
 
   return NULL_TREE;
 }
 
+/* Handle a "vector_size" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_vector_size_attribute (tree *node, tree name, tree args,
+                             int ARG_UNUSED (flags),
+                             bool *no_add_attrs)
+{
+  unsigned HOST_WIDE_INT vecsize, nunits;
+  enum machine_mode orig_mode;
+  tree type = *node, new_type, size;
+
+  *no_add_attrs = true;
+
+  size = TREE_VALUE (args);
+
+  if (!host_integerp (size, 1))
+    {
+      warning (OPT_Wattributes, "%qs attribute ignored",
+              IDENTIFIER_POINTER (name));
+      return NULL_TREE;
+    }
+
+  /* Get the vector size (in bytes).  */
+  vecsize = tree_low_cst (size, 1);
+
+  /* We need to provide for vector pointers, vector arrays, and
+     functions returning vectors.  For example:
+
+       __attribute__((vector_size(16))) short *foo;
+
+     In this case, the mode is SI, but the type being modified is
+     HI, so we need to look further.  */
+
+  while (POINTER_TYPE_P (type)
+        || TREE_CODE (type) == FUNCTION_TYPE
+        || TREE_CODE (type) == METHOD_TYPE
+        || TREE_CODE (type) == ARRAY_TYPE
+        || TREE_CODE (type) == OFFSET_TYPE)
+    type = TREE_TYPE (type);
+
+  /* Get the mode of the type being modified.  */
+  orig_mode = TYPE_MODE (type);
+
+  if ((!INTEGRAL_TYPE_P (type)
+       && !SCALAR_FLOAT_TYPE_P (type)
+       && !FIXED_POINT_TYPE_P (type))
+      || (!SCALAR_FLOAT_MODE_P (orig_mode)
+         && GET_MODE_CLASS (orig_mode) != MODE_INT
+         && !ALL_SCALAR_FIXED_POINT_MODE_P (orig_mode))
+      || !host_integerp (TYPE_SIZE_UNIT (type), 1)
+      || TREE_CODE (type) == BOOLEAN_TYPE)
+    {
+      error ("invalid vector type for attribute %qs",
+            IDENTIFIER_POINTER (name));
+      return NULL_TREE;
+    }
+
+  if (vecsize % tree_low_cst (TYPE_SIZE_UNIT (type), 1))
+    {
+      error ("vector size not an integral multiple of component size");
+      return NULL;
+    }
+
+  if (vecsize == 0)
+    {
+      error ("zero vector size");
+      return NULL;
+    }
+
+  /* Calculate how many units fit in the vector.  */
+  nunits = vecsize / tree_low_cst (TYPE_SIZE_UNIT (type), 1);
+  if (nunits & (nunits - 1))
+    {
+      error ("number of components of the vector not a power of two");
+      return NULL_TREE;
+    }
+
+  new_type = build_vector_type (type, nunits);
+
+  /* Build back pointers if needed.  */
+  *node = lang_hooks.types.reconstruct_complex_type (*node, new_type);
+
+  return NULL_TREE;
+}
+
+/* Handle a "vector_type" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args),
+                             int ARG_UNUSED (flags),
+                             bool *no_add_attrs)
+{
+  /* Vector representative type and size.  */
+  tree rep_type = *node;
+  tree rep_size = TYPE_SIZE_UNIT (rep_type);
+  tree rep_name;
+
+  /* Vector size in bytes and number of units.  */
+  unsigned HOST_WIDE_INT vec_bytes, vec_units;
+
+  /* Vector element type and mode.  */
+  tree elem_type;
+  enum machine_mode elem_mode;
+
+  *no_add_attrs = true;
+
+  /* Get the representative array type, possibly nested within a
+     padding record e.g. for alignment purposes.  */
+
+  if (TYPE_IS_PADDING_P (rep_type))
+    rep_type = TREE_TYPE (TYPE_FIELDS (rep_type));
+
+  if (TREE_CODE (rep_type) != ARRAY_TYPE)
+    {
+      error ("attribute %qs applies to array types only",
+            IDENTIFIER_POINTER (name));
+      return NULL_TREE;
+    }
+
+  /* Silently punt on variable sizes.  We can't make vector types for them,
+     need to ignore them on front-end generated subtypes of unconstrained
+     bases, and this attribute is for binding implementors, not end-users, so
+     we should never get there from legitimate explicit uses.  */
+
+  if (!host_integerp (rep_size, 1))
+    return NULL_TREE;
+
+  /* Get the element type/mode and check this is something we know
+     how to make vectors of.  */
+
+  elem_type = TREE_TYPE (rep_type);
+  elem_mode = TYPE_MODE (elem_type);
+
+  if ((!INTEGRAL_TYPE_P (elem_type)
+       && !SCALAR_FLOAT_TYPE_P (elem_type)
+       && !FIXED_POINT_TYPE_P (elem_type))
+      || (!SCALAR_FLOAT_MODE_P (elem_mode)
+         && GET_MODE_CLASS (elem_mode) != MODE_INT
+         && !ALL_SCALAR_FIXED_POINT_MODE_P (elem_mode))
+      || !host_integerp (TYPE_SIZE_UNIT (elem_type), 1))
+    {
+      error ("invalid element type for attribute %qs",
+            IDENTIFIER_POINTER (name));
+      return NULL_TREE;
+    }
+
+  /* Sanity check the vector size and element type consistency.  */
+
+  vec_bytes = tree_low_cst (rep_size, 1);
+
+  if (vec_bytes % tree_low_cst (TYPE_SIZE_UNIT (elem_type), 1))
+    {
+      error ("vector size not an integral multiple of component size");
+      return NULL;
+    }
+
+  if (vec_bytes == 0)
+    {
+      error ("zero vector size");
+      return NULL;
+    }
+
+  vec_units = vec_bytes / tree_low_cst (TYPE_SIZE_UNIT (elem_type), 1);
+  if (vec_units & (vec_units - 1))
+    {
+      error ("number of components of the vector not a power of two");
+      return NULL_TREE;
+    }
+
+  /* Build the vector type and replace.  */
+
+  *node = build_vector_type (elem_type, vec_units);
+  rep_name = TYPE_NAME (rep_type);
+  if (TREE_CODE (rep_name) == TYPE_DECL)
+    rep_name = DECL_NAME (rep_name);
+  TYPE_NAME (*node) = rep_name;
+  TYPE_REPRESENTATIVE_ARRAY (*node) = rep_type;
+
+  return NULL_TREE;
+}
+
 /* ----------------------------------------------------------------------- *
  *                              BUILTIN FUNCTIONS                          *
  * ----------------------------------------------------------------------- */
 /* ----------------------------------------------------------------------- *
  *                              BUILTIN FUNCTIONS                          *
  * ----------------------------------------------------------------------- */