* gcc-interface/utils.c (handle_stack_protect_attribute): Move around.
[gcc.git] / gcc / ada / gcc-interface / utils.c
index 475261b36828db5348c2b7f22789b3447da56d48..d9c9209ed84fdf53939e17c84cc29c85f79abb81 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2017, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2019, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -90,65 +90,104 @@ static tree handle_novops_attribute (tree *, tree, tree, int, bool *);
 static tree handle_nonnull_attribute (tree *, tree, tree, int, bool *);
 static tree handle_sentinel_attribute (tree *, tree, tree, int, bool *);
 static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *);
+static tree handle_stack_protect_attribute (tree *, tree, tree, int, bool *);
 static tree handle_noinline_attribute (tree *, tree, tree, int, bool *);
 static tree handle_noclone_attribute (tree *, tree, tree, int, bool *);
+static tree handle_noicf_attribute (tree *, tree, tree, int, bool *);
+static tree handle_noipa_attribute (tree *, tree, tree, int, bool *);
 static tree handle_leaf_attribute (tree *, tree, tree, int, bool *);
 static tree handle_always_inline_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_flatten_attribute (tree *, tree, tree, int, bool *);
+static tree handle_used_attribute (tree *, tree, tree, int, bool *);
+static tree handle_cold_attribute (tree *, tree, tree, int, bool *);
+static tree handle_hot_attribute (tree *, tree, tree, int, bool *);
+static tree handle_target_attribute (tree *, tree, tree, int, bool *);
+static tree handle_target_clones_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 *);
 
+static const struct attribute_spec::exclusions attr_cold_hot_exclusions[] =
+{
+  { "cold", true,  true,  true  },
+  { "hot" , true,  true,  true  },
+  { NULL  , false, false, false }
+};
+
 /* Fake handler for attributes we don't properly support, typically because
    they'd require dragging a lot of the common-c front-end circuitry.  */
-static tree fake_attribute_handler      (tree *, tree, tree, int, bool *);
+static tree fake_attribute_handler (tree *, tree, tree, int, bool *);
 
 /* Table of machine-independent internal attributes for Ada.  We support
    this minimal set of attributes to accommodate the needs of builtins.  */
 const struct attribute_spec gnat_internal_attribute_table[] =
 {
-  /* { name, min_len, max_len, decl_req, type_req, fn_type_req, handler,
-       affects_type_identity } */
-  { "const",        0, 0,  true,  false, false, handle_const_attribute,
-    false },
-  { "nothrow",      0, 0,  true,  false, false, handle_nothrow_attribute,
-    false },
-  { "pure",         0, 0,  true,  false, false, handle_pure_attribute,
-    false },
-  { "no vops",      0, 0,  true,  false, false, handle_novops_attribute,
-    false },
-  { "nonnull",      0, -1, false, true,  true,  handle_nonnull_attribute,
-    false },
-  { "sentinel",     0, 1,  false, true,  true,  handle_sentinel_attribute,
-    false },
-  { "noreturn",     0, 0,  true,  false, false, handle_noreturn_attribute,
-    false },
-  { "noinline",     0, 0,  true,  false, false, handle_noinline_attribute,
-    false },
-  { "noclone",      0, 0,  true,  false, false, handle_noclone_attribute,
-    false },
-  { "leaf",         0, 0,  true,  false, false, handle_leaf_attribute,
-    false },
-  { "always_inline",0, 0,  true,  false, false, handle_always_inline_attribute,
-    false },
-  { "malloc",       0, 0,  true,  false, false, handle_malloc_attribute,
-    false },
-  { "type generic", 0, 0,  false, true, true, handle_type_generic_attribute,
-    false },
-
-  { "vector_size",  1, 1,  false, true, false,  handle_vector_size_attribute,
-    false },
-  { "vector_type",  0, 0,  false, true, false,  handle_vector_type_attribute,
-    false },
-  { "may_alias",    0, 0, false, true, false, NULL, false },
+  /* { name, min_len, max_len, decl_req, type_req, fn_type_req,
+       affects_type_identity, handler, exclude } */
+  { "const",        0, 0,  true,  false, false, false,
+    handle_const_attribute, NULL },
+  { "nothrow",      0, 0,  true,  false, false, false,
+    handle_nothrow_attribute, NULL },
+  { "pure",         0, 0,  true,  false, false, false,
+    handle_pure_attribute, NULL },
+  { "no vops",      0, 0,  true,  false, false, false,
+    handle_novops_attribute, NULL },
+  { "nonnull",      0, -1, false, true,  true,  false,
+    handle_nonnull_attribute, NULL },
+  { "sentinel",     0, 1,  false, true,  true,  false,
+    handle_sentinel_attribute, NULL },
+  { "noreturn",     0, 0,  true,  false, false, false,
+    handle_noreturn_attribute, NULL },
+  { "stack_protect",0, 0, true,  false, false, false,
+    handle_stack_protect_attribute, NULL },
+  { "noinline",     0, 0,  true,  false, false, false,
+    handle_noinline_attribute, NULL },
+  { "noclone",      0, 0,  true,  false, false, false,
+    handle_noclone_attribute, NULL },
+  { "no_icf",       0, 0,  true,  false, false, false,
+    handle_noicf_attribute, NULL },
+  { "noipa",        0, 0,  true,  false, false, false,
+    handle_noipa_attribute, NULL },
+  { "leaf",         0, 0,  true,  false, false, false,
+    handle_leaf_attribute, NULL },
+  { "always_inline",0, 0,  true,  false, false, false,
+    handle_always_inline_attribute, NULL },
+  { "malloc",       0, 0,  true,  false, false, false,
+    handle_malloc_attribute, NULL },
+  { "type generic", 0, 0,  false, true,  true,  false,
+    handle_type_generic_attribute, NULL },
+
+  { "flatten",      0, 0,  true,  false, false, false,
+    handle_flatten_attribute, NULL },
+  { "used",         0, 0,  true,  false, false, false,
+    handle_used_attribute, NULL },
+  { "cold",         0, 0,  true,  false, false, false,
+    handle_cold_attribute, attr_cold_hot_exclusions },
+  { "hot",          0, 0,  true,  false, false, false,
+    handle_hot_attribute, attr_cold_hot_exclusions },
+  { "target",       1, -1, true,  false, false, false,
+    handle_target_attribute, NULL },
+  { "target_clones",1, -1, true,  false, false, false,
+    handle_target_clones_attribute, NULL },
+
+  { "vector_size",  1, 1,  false, true,  false, false,
+    handle_vector_size_attribute, NULL },
+  { "vector_type",  0, 0,  false, true,  false, false,
+    handle_vector_type_attribute, NULL },
+  { "may_alias",    0, 0,  false, true,  false, false,
+    NULL, NULL },
 
   /* ??? format and format_arg are heavy and not supported, which actually
      prevents support for stdio builtins, which we however declare as part
      of the common builtins.def contents.  */
-  { "format",     3, 3,  false, true,  true,  fake_attribute_handler, false },
-  { "format_arg", 1, 1,  false, true,  true,  fake_attribute_handler, false },
+  { "format",       3, 3,  false, true,  true,  false,
+    fake_attribute_handler, NULL },
+  { "format_arg",   1, 1,  false, true,  true,  false,
+    fake_attribute_handler, NULL },
 
-  { NULL,         0, 0, false, false, false, NULL, false }
+  { NULL,           0, 0,  false, false, false, false,
+    NULL, NULL }
 };
 
 /* Associates a GNAT tree node to a GCC tree node. It is used in
@@ -222,8 +261,9 @@ static GTY((deletable)) tree free_block_chain;
 /* A hash table of padded types.  It is modelled on the generic type
    hash table in tree.c, which must thus be used as a reference.  */
 
-struct GTY((for_user)) pad_type_hash {
-  unsigned long hash;
+struct GTY((for_user)) pad_type_hash
+{
+  hashval_t hash;
   tree type;
 };
 
@@ -231,11 +271,15 @@ struct pad_type_hasher : ggc_cache_ptr_hash<pad_type_hash>
 {
   static inline hashval_t hash (pad_type_hash *t) { return t->hash; }
   static bool equal (pad_type_hash *a, pad_type_hash *b);
-  static int keep_cache_entry (pad_type_hash *&);
+
+  static int
+  keep_cache_entry (pad_type_hash *&t)
+  {
+    return ggc_marked_p (t->type);
+  }
 };
 
-static GTY ((cache))
-  hash_table<pad_type_hasher> *pad_type_hash_table;
+static GTY ((cache)) hash_table<pad_type_hasher> *pad_type_hash_table;
 
 static tree merge_sizes (tree, tree, tree, bool, bool);
 static tree fold_bit_position (const_tree);
@@ -384,15 +428,13 @@ make_dummy_type (Entity_Id gnat_type)
 
   SET_DUMMY_NODE (gnat_equiv, gnu_type);
 
-  /* Create a debug type so that debug info consumers only see an unspecified
-     type.  */
+  /* Create a debug type so that debuggers only see an unspecified type.  */
   if (Needs_Debug_Info (gnat_type))
     {
       debug_type = make_node (LANG_TYPE);
-      SET_TYPE_DEBUG_TYPE (gnu_type, debug_type);
-
       TYPE_NAME (debug_type) = TYPE_NAME (gnu_type);
       TYPE_ARTIFICIAL (debug_type) = TYPE_ARTIFICIAL (gnu_type);
+      SET_TYPE_DEBUG_TYPE (gnu_type, debug_type);
     }
 
   return gnu_type;
@@ -750,7 +792,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
   TREE_NO_WARNING (decl) = (No (gnat_node) || Warnings_Off (gnat_node));
 
   /* Set the location of DECL and emit a declaration for it.  */
-  if (Present (gnat_node) && !renaming_from_generic_instantiation_p (gnat_node))
+  if (Present (gnat_node) && !renaming_from_instantiation_p (gnat_node))
     Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (decl));
 
   add_decl_expr (decl, gnat_node);
@@ -768,7 +810,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
         debugger at the proper time.  */
       if (DECL_EXTERNAL (decl)
          && TREE_CODE (decl) == FUNCTION_DECL
-         && DECL_BUILT_IN (decl))
+         && fndecl_built_in_p (decl))
        vec_safe_push (builtin_decls, decl);
       else if (global_bindings_p ())
        vec_safe_push (global_decls, decl);
@@ -968,6 +1010,7 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
      Note that we rely on the pointer equality created here for
      TYPE_NAME to look through conversions in various places.  */
   TYPE_NAME (new_type) = TYPE_NAME (type);
+  TYPE_PACKED (new_type) = 1;
   TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type);
   TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type);
   TYPE_REVERSE_STORAGE_ORDER (new_type) = TYPE_REVERSE_STORAGE_ORDER (type);
@@ -985,15 +1028,16 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
     }
   else
     {
+      tree type_size = TYPE_ADA_SIZE (type);
       /* Do not try to shrink the size if the RM size is not constant.  */
       if (TYPE_CONTAINS_TEMPLATE_P (type)
-         || !tree_fits_uhwi_p (TYPE_ADA_SIZE (type)))
+         || !tree_fits_uhwi_p (type_size))
        return type;
 
       /* Round the RM size up to a unit boundary to get the minimal size
         for a BLKmode record.  Give up if it's already the size and we
         don't need to lower the alignment.  */
-      new_size = tree_to_uhwi (TYPE_ADA_SIZE (type));
+      new_size = tree_to_uhwi (type_size);
       new_size = (new_size + BITS_PER_UNIT - 1) & -BITS_PER_UNIT;
       if (new_size == size && (max_align == 0 || align <= max_align))
        return type;
@@ -1012,7 +1056,7 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
   for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
     {
       tree new_field_type = TREE_TYPE (field);
-      tree new_field, new_size;
+      tree new_field, new_field_size;
 
       if (RECORD_OR_UNION_TYPE_P (new_field_type)
          && !TYPE_FAT_POINTER_P (new_field_type)
@@ -1028,14 +1072,15 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
          && !TYPE_FAT_POINTER_P (new_field_type)
          && !TYPE_CONTAINS_TEMPLATE_P (new_field_type)
          && TYPE_ADA_SIZE (new_field_type))
-       new_size = TYPE_ADA_SIZE (new_field_type);
+       new_field_size = TYPE_ADA_SIZE (new_field_type);
       else
-       new_size = DECL_SIZE (field);
+       new_field_size = DECL_SIZE (field);
 
+      /* This is a layout with full representation, alignment and size clauses
+        so we simply pass 0 as PACKED like gnat_to_gnu_field in this case.  */
       new_field
        = create_field_decl (DECL_NAME (field), new_field_type, new_type,
-                            new_size, bit_position (field),
-                            TYPE_PACKED (type),
+                            new_field_size, bit_position (field), 0,
                             !DECL_NONADDRESSABLE_P (field));
 
       DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (field);
@@ -1047,12 +1092,6 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
       new_field_list = new_field;
     }
 
-  finish_record_type (new_type, nreverse (new_field_list), 2, false);
-  relate_alias_sets (new_type, type, ALIAS_SET_COPY);
-  if (TYPE_STUB_DECL (type))
-    SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
-                           DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
-
   /* If this is a padding record, we never want to make the size smaller
      than what was specified.  For QUAL_UNION_TYPE, also copy the size.  */
   if (TYPE_IS_PADDING_P (type) || TREE_CODE (type) == QUAL_UNION_TYPE)
@@ -1070,13 +1109,20 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
   if (!TYPE_CONTAINS_TEMPLATE_P (type))
     SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (type));
 
-  compute_record_mode (new_type);
+  finish_record_type (new_type, nreverse (new_field_list), 2, false);
+  relate_alias_sets (new_type, type, ALIAS_SET_COPY);
+  if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
+    SET_TYPE_DEBUG_TYPE (new_type, TYPE_DEBUG_TYPE (type));
+  else if (TYPE_STUB_DECL (type))
+    SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
+                           DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
 
   /* Try harder to get a packable type if necessary, for example
      in case the record itself contains a BLKmode field.  */
   if (in_record && TYPE_MODE (new_type) == BLKmode)
     SET_TYPE_MODE (new_type,
-                  mode_for_size_tree (TYPE_SIZE (new_type), MODE_INT, 1));
+                  mode_for_size_tree (TYPE_SIZE (new_type),
+                                      MODE_INT, 1).else_blk ());
 
   /* If neither mode nor size nor alignment shrunk, return the old type.  */
   if (TYPE_MODE (new_type) == BLKmode && new_size >= size && max_align == 0)
@@ -1125,9 +1171,15 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
 
   switch (TREE_CODE (type))
     {
+    case BOOLEAN_TYPE:
+      /* Do not mess with boolean types that have foreign convention.  */
+      if (TYPE_PRECISION (type) == 1 && TYPE_SIZE (type) == size_tree)
+       break;
+
+      /* ... fall through ... */
+
     case INTEGER_TYPE:
     case ENUMERAL_TYPE:
-    case BOOLEAN_TYPE:
       biased_p = (TREE_CODE (type) == INTEGER_TYPE
                  && TYPE_BIASED_REPRESENTATION_P (type));
 
@@ -1166,8 +1218,9 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
         may need to return the thin pointer.  */
       if (TYPE_FAT_POINTER_P (type) && size < POINTER_SIZE * 2)
        {
-         machine_mode p_mode = mode_for_size (size, MODE_INT, 0);
-         if (!targetm.valid_pointer_mode (p_mode))
+         scalar_int_mode p_mode;
+         if (!int_mode_for_size (size, 0).exists (&p_mode)
+             || !targetm.valid_pointer_mode (p_mode))
            p_mode = ptr_mode;
          return
            build_pointer_type_for_mode
@@ -1191,14 +1244,6 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
   return type;
 }
 
-/* See if the data pointed to by the hash table slot is marked.  */
-
-int
-pad_type_hasher::keep_cache_entry (pad_type_hash *&t)
-{
-  return ggc_marked_p (t->type);
-}
-
 /* Return true iff the padded types are equivalent.  */
 
 bool
@@ -1223,14 +1268,12 @@ pad_type_hasher::equal (pad_type_hash *t1, pad_type_hash *t2)
     && TYPE_REVERSE_STORAGE_ORDER (type1) == TYPE_REVERSE_STORAGE_ORDER (type2);
 }
 
-/* Look up the padded TYPE in the hash table and return its canonical version
-   if it exists; otherwise, insert it into the hash table.  */
+/* Compute the hash value for the padded TYPE.  */
 
-static tree
-lookup_and_insert_pad_type (tree type)
+static hashval_t
+hash_pad_type (tree type)
 {
   hashval_t hashcode;
-  struct pad_type_hash in, *h;
 
   hashcode
     = iterative_hash_object (TYPE_HASH (TREE_TYPE (TYPE_FIELDS (type))), 0);
@@ -1238,17 +1281,31 @@ lookup_and_insert_pad_type (tree type)
   hashcode = iterative_hash_hashval_t (TYPE_ALIGN (type), hashcode);
   hashcode = iterative_hash_expr (TYPE_ADA_SIZE (type), hashcode);
 
+  return hashcode;
+}
+
+/* Look up the padded TYPE in the hash table and return its canonical version
+   if it exists; otherwise, insert it into the hash table.  */
+
+static tree
+canonicalize_pad_type (tree type)
+{
+  const hashval_t hashcode = hash_pad_type (type);
+  struct pad_type_hash in, *h, **slot;
+
   in.hash = hashcode;
   in.type = type;
-  h = pad_type_hash_table->find_with_hash (&in, hashcode);
-  if (h)
-    return h->type;
+  slot = pad_type_hash_table->find_slot_with_hash (&in, hashcode, INSERT);
+  h = *slot;
+  if (!h)
+    {
+      h = ggc_alloc<pad_type_hash> ();
+      h->hash = hashcode;
+      h->type = type;
+      *slot = h;
+    }
 
-  h = ggc_alloc<pad_type_hash> ();
-  h->hash = hashcode;
-  h->type = type;
-  *pad_type_hash_table->find_slot_with_hash (h, hashcode, INSERT) = h;
-  return NULL_TREE;
+  return h->type;
 }
 
 /* Ensure that TYPE has SIZE and ALIGN.  Make and return a new padded type
@@ -1379,28 +1436,29 @@ maybe_pad_type (tree type, tree size, unsigned int align,
   /* We will output additional debug info manually below.  */
   finish_record_type (record, field, 1, false);
 
-  if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
-    SET_TYPE_DEBUG_TYPE (record, type);
-
   /* Set the RM size if requested.  */
   if (set_rm_size)
     {
-      tree canonical_pad_type;
-
       SET_TYPE_ADA_SIZE (record, size ? size : orig_size);
 
       /* If the padded type is complete and has constant size, we canonicalize
         it by means of the hash table.  This is consistent with the language
         semantics and ensures that gigi and the middle-end have a common view
         of these padded types.  */
-      if (TREE_CONSTANT (TYPE_SIZE (record))
-         && (canonical_pad_type = lookup_and_insert_pad_type (record)))
+      if (TREE_CONSTANT (TYPE_SIZE (record)))
        {
-         record = canonical_pad_type;
-         goto built;
+         tree canonical = canonicalize_pad_type (record);
+         if (canonical != record)
+           {
+             record = canonical;
+             goto built;
+           }
        }
     }
 
+  if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
+    SET_TYPE_DEBUG_TYPE (record, maybe_debug_type (type));
+
   /* Unless debugging information isn't being written for the input type,
      write a record that shows what we are a subtype of and also make a
      variable that indicates our size, if still variable.  */
@@ -1487,7 +1545,7 @@ built:
               || TREE_OVERFLOW (orig_size)
               || tree_int_cst_lt (size, orig_size))))
     {
-      Node_Id gnat_error_node = Empty;
+      Node_Id gnat_error_node;
 
       /* For a packed array, post the message on the original array type.  */
       if (Is_Packed_Array_Impl_Type (gnat_entity))
@@ -1497,35 +1555,57 @@ built:
           || Ekind (gnat_entity) == E_Discriminant)
          && Present (Component_Clause (gnat_entity)))
        gnat_error_node = Last_Bit (Component_Clause (gnat_entity));
-      else if (Present (Size_Clause (gnat_entity)))
+      else if (Has_Size_Clause (gnat_entity))
        gnat_error_node = Expression (Size_Clause (gnat_entity));
+      else if (Has_Object_Size_Clause (gnat_entity))
+       gnat_error_node = Expression (Object_Size_Clause (gnat_entity));
+      else
+       gnat_error_node = Empty;
 
       /* Generate message only for entities that come from source, since
         if we have an entity created by expansion, the message will be
         generated for some other corresponding source entity.  */
       if (Comes_From_Source (gnat_entity))
        {
-         if (Present (gnat_error_node))
-           post_error_ne_tree ("{^ }bits of & unused?",
-                               gnat_error_node, gnat_entity,
-                               size_diffop (size, orig_size));
-         else if (is_component_type)
+         if (is_component_type)
            post_error_ne_tree ("component of& padded{ by ^ bits}?",
                                gnat_entity, gnat_entity,
                                size_diffop (size, orig_size));
+         else if (Present (gnat_error_node))
+           post_error_ne_tree ("{^ }bits of & unused?",
+                               gnat_error_node, gnat_entity,
+                               size_diffop (size, orig_size));
        }
     }
 
   return record;
 }
 
+/* Return true if padded TYPE was built with an RM size.  */
+
+bool
+pad_type_has_rm_size (tree type)
+{
+  /* This is required for the lookup.  */
+  if (!TREE_CONSTANT (TYPE_SIZE (type)))
+    return false;
+
+  const hashval_t hashcode = hash_pad_type (type);
+  struct pad_type_hash in, *h;
+
+  in.hash = hashcode;
+  in.type = type;
+  h = pad_type_hash_table->find_with_hash (&in, hashcode);
+
+  /* The types built with an RM size are the canonicalized ones.  */
+  return h && h->type == type;
+}
+
 /* Return a copy of the padded TYPE but with reverse storage order.  */
 
 tree
 set_reverse_storage_order_on_pad_type (tree type)
 {
-  tree field, canonical_pad_type;
-
   if (flag_checking)
     {
       /* If the inner type is not scalar then the function does nothing.  */
@@ -1537,13 +1617,12 @@ set_reverse_storage_order_on_pad_type (tree type)
   /* This is required for the canonicalization.  */
   gcc_assert (TREE_CONSTANT (TYPE_SIZE (type)));
 
-  field = copy_node (TYPE_FIELDS (type));
+  tree field = copy_node (TYPE_FIELDS (type));
   type = copy_type (type);
   DECL_CONTEXT (field) = type;
   TYPE_FIELDS (type) = field;
   TYPE_REVERSE_STORAGE_ORDER (type) = 1;
-  canonical_pad_type = lookup_and_insert_pad_type (type);
-  return canonical_pad_type ? canonical_pad_type : type;
+  return canonicalize_pad_type (type);
 }
 \f
 /* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP.
@@ -1645,7 +1724,7 @@ record_builtin_type (const char *name, tree type, bool artificial_p)
   integral types are unsigned.
 
   Unfortunately the signedness of 'char' in C is implementation-defined
-  and GCC even has the option -fsigned-char to toggle it at run time.
+  and GCC even has the option -f[un]signed-char to toggle it at run time.
   Since GNAT's philosophy is to be compatible with C by default, to wit
   Interfaces.C.char is defined as a mere copy of Character, we may need
   to declare character types as signed types in GENERIC and generate the
@@ -1818,6 +1897,9 @@ finish_record_type (tree record_type, tree field_list, int rep_level,
       else
        this_ada_size = this_size;
 
+      const bool variant_part = (TREE_CODE (type) == QUAL_UNION_TYPE);
+      const bool variant_part_at_zero = variant_part && integer_zerop (pos);
+
       /* Clear DECL_BIT_FIELD for the cases layout_decl does not handle.  */
       if (DECL_BIT_FIELD (field)
          && operand_equal_p (this_size, TYPE_SIZE (type), 0))
@@ -1856,6 +1938,12 @@ finish_record_type (tree record_type, tree field_list, int rep_level,
            DECL_BIT_FIELD (field) = 0;
        }
 
+      /* Clear DECL_BIT_FIELD_TYPE for a variant part at offset 0, it's simply
+        not supported by the DECL_BIT_FIELD_REPRESENTATIVE machinery because
+        the variant part is always the last field in the list.  */
+      if (variant_part_at_zero)
+       DECL_BIT_FIELD_TYPE (field) = NULL_TREE;
+
       /* 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.  */
@@ -1888,18 +1976,18 @@ finish_record_type (tree record_type, tree field_list, int rep_level,
        case RECORD_TYPE:
          /* Since we know here that all fields are sorted in order of
             increasing bit position, the size of the record is one
-            higher than the ending bit of the last field processed
-            unless we have a rep clause, since in that case we might
-            have a field outside a QUAL_UNION_TYPE that has a higher ending
-            position.  So use a MAX in that case.  Also, if this field is a
-            QUAL_UNION_TYPE, we need to take into account the previous size in
-            the case of empty variants.  */
+            higher than the ending bit of the last field processed,
+            unless we have a variant part at offset 0, since in this
+            case we might have a field outside the variant part that
+            has a higher ending position; so use a MAX in this case.
+            Also, if this field is a QUAL_UNION_TYPE, we need to take
+            into account the previous size in the case of empty variants.  */
          ada_size
-           = merge_sizes (ada_size, pos, this_ada_size,
-                          TREE_CODE (type) == QUAL_UNION_TYPE, rep_level > 0);
+           = merge_sizes (ada_size, pos, this_ada_size, variant_part,
+                          variant_part_at_zero);
          size
-           = merge_sizes (size, pos, this_size,
-                          TREE_CODE (type) == QUAL_UNION_TYPE, rep_level > 0);
+           = merge_sizes (size, pos, this_size, variant_part,
+                          variant_part_at_zero);
          break;
 
        default:
@@ -1910,33 +1998,40 @@ finish_record_type (tree record_type, tree field_list, int rep_level,
   if (code == QUAL_UNION_TYPE)
     nreverse (field_list);
 
-  if (rep_level < 2)
+  /* We need to set the regular sizes if REP_LEVEL is one.  */
+  if (rep_level == 1)
     {
       /* If this is a padding record, we never want to make the size smaller
         than what was specified in it, if any.  */
       if (TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type))
        size = TYPE_SIZE (record_type);
 
+      tree size_unit = had_size_unit
+                      ? TYPE_SIZE_UNIT (record_type)
+                      : convert (sizetype,
+                                 size_binop (CEIL_DIV_EXPR, size,
+                                             bitsize_unit_node));
+      const unsigned int align = TYPE_ALIGN (record_type);
+
+      TYPE_SIZE (record_type) = variable_size (round_up (size, align));
+      TYPE_SIZE_UNIT (record_type)
+       = variable_size (round_up (size_unit, align / BITS_PER_UNIT));
+    }
+
+  /* We need to set the Ada size if REP_LEVEL is zero or one.  */
+  if (rep_level < 2)
+    {
       /* Now set any of the values we've just computed that apply.  */
       if (!TYPE_FAT_POINTER_P (record_type)
          && !TYPE_CONTAINS_TEMPLATE_P (record_type))
        SET_TYPE_ADA_SIZE (record_type, ada_size);
+    }
 
-      if (rep_level > 0)
-       {
-         tree size_unit = had_size_unit
-                          ? TYPE_SIZE_UNIT (record_type)
-                          : convert (sizetype,
-                                     size_binop (CEIL_DIV_EXPR, size,
-                                                 bitsize_unit_node));
-         unsigned int align = TYPE_ALIGN (record_type);
-
-         TYPE_SIZE (record_type) = variable_size (round_up (size, align));
-         TYPE_SIZE_UNIT (record_type)
-           = variable_size (round_up (size_unit, align / BITS_PER_UNIT));
-
-         compute_record_mode (record_type);
-       }
+  /* We need to set the mode if REP_LEVEL is one or two.  */
+  if (rep_level > 0)
+    {
+      compute_record_mode (record_type);
+      finish_bitfield_layout (record_type);
     }
 
   /* Reset the TYPE_MAX_ALIGN field since it's private to gigi.  */
@@ -2173,13 +2268,12 @@ rest_of_record_type_compilation (tree record_type)
 /* Utility function of above to merge LAST_SIZE, the previous size of a record
    with FIRST_BIT and SIZE that describe a field.  SPECIAL is true if this
    represents a QUAL_UNION_TYPE in which case we must look for COND_EXPRs and
-   replace a value of zero with the old size.  If HAS_REP is true, we take the
+   replace a value of zero with the old size.  If MAX is true, we take the
    MAX of the end position of this field with LAST_SIZE.  In all other cases,
    we use FIRST_BIT plus SIZE.  Return an expression for the size.  */
 
 static tree
-merge_sizes (tree last_size, tree first_bit, tree size, bool special,
-            bool has_rep)
+merge_sizes (tree last_size, tree first_bit, tree size, bool special, bool max)
 {
   tree type = TREE_TYPE (last_size);
   tree new_size;
@@ -2187,7 +2281,7 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special,
   if (!special || TREE_CODE (size) != COND_EXPR)
     {
       new_size = size_binop (PLUS_EXPR, first_bit, size);
-      if (has_rep)
+      if (max)
        new_size = size_binop (MAX_EXPR, last_size, new_size);
     }
 
@@ -2196,14 +2290,14 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special,
                            integer_zerop (TREE_OPERAND (size, 1))
                            ? last_size : merge_sizes (last_size, first_bit,
                                                       TREE_OPERAND (size, 1),
-                                                      1, has_rep),
+                                                      1, max),
                            integer_zerop (TREE_OPERAND (size, 2))
                            ? last_size : merge_sizes (last_size, first_bit,
                                                       TREE_OPERAND (size, 2),
-                                                      1, has_rep));
+                                                      1, max));
 
   /* 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
+     when fed through SUBSTITUTE_IN_EXPR) into thinking that a constant
      size is not constant.  */
   while (TREE_CODE (new_size) == NON_LVALUE_EXPR)
     new_size = TREE_OPERAND (new_size, 0);
@@ -2372,6 +2466,24 @@ create_range_type (tree type, tree min, tree max)
   return range_type;
 }
 \f
+\f/* Return an extra subtype of TYPE with range MIN to MAX.  */
+
+tree
+create_extra_subtype (tree type, tree min, tree max)
+{
+  const bool uns = TYPE_UNSIGNED (type);
+  const unsigned prec = TYPE_PRECISION (type);
+  tree subtype = uns ? make_unsigned_type (prec) : make_signed_type (prec);
+
+  TREE_TYPE (subtype) = type;
+  TYPE_EXTRA_SUBTYPE_P (subtype) = 1;
+
+  SET_TYPE_RM_MIN_VALUE (subtype, min);
+  SET_TYPE_RM_MAX_VALUE (subtype, max);
+
+  return subtype;
+}
+\f
 /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE.
    NAME gives the name of the type to be used in the declaration.  */
 
@@ -2678,9 +2790,9 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos,
        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 when the size is
      specified for two reasons: first if the size differs from the natural
-     size.  Second, if the alignment is insufficient.  There are a number of
+     size; second, if the alignment is insufficient.  There are a number of
      ways the latter can be true.
 
      We never make a bitfield if the type of the field has a nonconstant size,
@@ -2688,7 +2800,7 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos,
 
      We do *preventively* make a bitfield when there might be the need for it
      but we don't have all the necessary information to decide, as is the case
-     of a field with no specified position in a packed record.
+     of a field in a packed record.
 
      We also don't look at STRICT_ALIGNMENT here, and rely on later processing
      in layout_decl or finish_record_type to clear the bit_field indication if
@@ -2754,8 +2866,8 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos,
 
       layout_decl (field_decl, known_align);
       SET_DECL_OFFSET_ALIGN (field_decl,
-                            tree_fits_uhwi_p (pos) ? BIGGEST_ALIGNMENT
-                            : BITS_PER_UNIT);
+                            tree_fits_uhwi_p (pos)
+                            ? BIGGEST_ALIGNMENT : BITS_PER_UNIT);
       pos_from_bit (&DECL_FIELD_OFFSET (field_decl),
                    &DECL_FIELD_BIT_OFFSET (field_decl),
                    DECL_OFFSET_ALIGN (field_decl), pos);
@@ -2772,6 +2884,15 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos,
   if (!addressable && !type_for_nonaliased_component_p (type))
     addressable = 1;
 
+  /* Note that there is a trade-off in making a field nonaddressable because
+     this will cause type-based alias analysis to use the same alias set for
+     accesses to the field as for accesses to the whole record: while doing
+     so will make it more likely to disambiguate accesses to other objects
+     and accesses to the field, it will make it less likely to disambiguate
+     accesses to the other fields of the record and accesses to the field.
+     If the record is fully static, then the trade-off is irrelevant since
+     the fields of the record can always be disambiguated by their offsets
+     but, if the record is dynamic, then it can become problematic.  */
   DECL_NONADDRESSABLE_P (field_decl) = !addressable;
 
   return field_decl;
@@ -2892,37 +3013,6 @@ value_factor_p (tree value, HOST_WIDE_INT factor)
   return false;
 }
 
-/* Return whether GNAT_NODE is a defining identifier for a renaming that comes
-   from the parameter association for the instantiation of a generic.  We do
-   not want to emit source location for them: the code generated for their
-   initialization is likely to disturb debugging.  */
-
-bool
-renaming_from_generic_instantiation_p (Node_Id gnat_node)
-{
-  if (Nkind (gnat_node) != N_Defining_Identifier
-      || !IN (Ekind (gnat_node), Object_Kind)
-      || Comes_From_Source (gnat_node)
-      || !Present (Renamed_Object (gnat_node)))
-    return false;
-
-  /* Get the object declaration of the renamed object, if any and if the
-     renamed object is a mere identifier.  */
-  gnat_node = Renamed_Object (gnat_node);
-  if (Nkind (gnat_node) != N_Identifier)
-    return false;
-
-  gnat_node = Entity (gnat_node);
-  if (!Present (Parent (gnat_node)))
-    return false;
-
-  gnat_node = Parent (gnat_node);
-  return
-   (Present (gnat_node)
-    && Nkind (gnat_node) == N_Object_Declaration
-    && Present (Corresponding_Generic_Association (gnat_node)));
-}
-
 /* Defer the initialization of DECL's DECL_CONTEXT attribute, scheduling to
    feed it with the elaboration of GNAT_SCOPE.  */
 
@@ -3176,9 +3266,9 @@ create_label_decl (tree name, Node_Id gnat_node)
 }
 \f
 /* Return a FUNCTION_DECL node.  NAME is the name of the subprogram, ASM_NAME
-   its assembler name, TYPE its type (a FUNCTION_TYPE node), PARAM_DECL_LIST
-   the list of its parameters (a list of PARM_DECL nodes chained through the
-   DECL_CHAIN field).
+   its assembler name, TYPE its type (a FUNCTION_TYPE or METHOD_TYPE node),
+   PARAM_DECL_LIST the list of its parameters (a list of PARM_DECL nodes
+   chained through the DECL_CHAIN field).
 
    INLINE_STATUS describes the inline flags to be set on the FUNCTION_DECL.
 
@@ -3209,20 +3299,17 @@ create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list,
 
   DECL_ARTIFICIAL (subprog_decl) = artificial_p;
   DECL_EXTERNAL (subprog_decl) = extern_flag;
+  DECL_FUNCTION_IS_DEF (subprog_decl) = definition;
+  DECL_IGNORED_P (subprog_decl) = !debug_info_p;
   TREE_PUBLIC (subprog_decl) = public_flag;
 
-  if (!debug_info_p)
-    DECL_IGNORED_P (subprog_decl) = 1;
-  if (definition)
-    DECL_FUNCTION_IS_DEF (subprog_decl) = 1;
-
   switch (inline_status)
     {
     case is_suppressed:
       DECL_UNINLINABLE (subprog_decl) = 1;
       break;
 
-    case is_disabled:
+    case is_default:
       break;
 
     case is_required:
@@ -3243,9 +3330,15 @@ create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list,
 
       /* ... fall through ... */
 
-    case is_enabled:
+    case is_prescribed:
+      DECL_DISREGARD_INLINE_LIMITS (subprog_decl) = 1;
+
+      /* ... fall through ... */
+
+    case is_requested:
       DECL_DECLARED_INLINE_P (subprog_decl) = 1;
-      DECL_NO_INLINE_WARNING_P (subprog_decl) = artificial_p;
+      if (!Debug_Generated_Code)
+       DECL_NO_INLINE_WARNING_P (subprog_decl) = artificial_p;
       break;
 
     default:
@@ -3278,11 +3371,18 @@ finish_subprog_decl (tree decl, tree asm_name, tree type)
 
   DECL_ARTIFICIAL (result_decl) = 1;
   DECL_IGNORED_P (result_decl) = 1;
+  DECL_CONTEXT (result_decl) = decl;
   DECL_BY_REFERENCE (result_decl) = TREE_ADDRESSABLE (type);
   DECL_RESULT (decl) = result_decl;
 
+  /* Propagate the "const" property.  */
   TREE_READONLY (decl) = TYPE_READONLY (type);
-  TREE_SIDE_EFFECTS (decl) = TREE_THIS_VOLATILE (decl) = TYPE_VOLATILE (type);
+
+  /* Propagate the "pure" property.  */
+  DECL_PURE_P (decl) = TYPE_RESTRICT (type);
+
+  /* Propagate the "noreturn" property.  */
+  TREE_THIS_VOLATILE (decl) = TYPE_VOLATILE (type);
 
   if (asm_name)
     {
@@ -3331,8 +3431,6 @@ begin_subprog_body (tree subprog_decl)
   for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
        param_decl = DECL_CHAIN (param_decl))
     DECL_CONTEXT (param_decl) = subprog_decl;
-
-  make_decl_rtl (subprog_decl);
 }
 
 /* Finish translating the current subprogram and set its BODY.  */
@@ -3347,9 +3445,6 @@ end_subprog_body (tree body)
   DECL_INITIAL (fndecl) = current_binding_level->block;
   gnat_poplevel ();
 
-  /* Mark the RESULT_DECL as being in this subprogram. */
-  DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
-
   /* The body should be a BIND_EXPR whose BLOCK is the top-level one.  */
   if (TREE_CODE (body) == BIND_EXPR)
     {
@@ -3368,7 +3463,7 @@ void
 rest_of_subprog_body_compilation (tree subprog_decl)
 {
   /* We cannot track the location of errors past this point.  */
-  error_gnat_node = Empty;
+  Current_Error_Node = Empty;
 
   /* If we're only annotating types, don't actually compile this function.  */
   if (type_annotate_only)
@@ -3464,11 +3559,14 @@ gnat_type_for_mode (machine_mode mode, int unsignedp)
   if (COMPLEX_MODE_P (mode))
     return NULL_TREE;
 
-  if (SCALAR_FLOAT_MODE_P (mode))
-    return float_type_for_precision (GET_MODE_PRECISION (mode), mode);
+  scalar_float_mode float_mode;
+  if (is_a <scalar_float_mode> (mode, &float_mode))
+    return float_type_for_precision (GET_MODE_PRECISION (float_mode),
+                                    float_mode);
 
-  if (SCALAR_INT_MODE_P (mode))
-    return gnat_type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
+  scalar_int_mode int_mode;
+  if (is_a <scalar_int_mode> (mode, &int_mode))
+    return gnat_type_for_size (GET_MODE_BITSIZE (int_mode), unsignedp);
 
   if (VECTOR_MODE_P (mode))
     {
@@ -3527,7 +3625,7 @@ gnat_types_compatible_p (tree t1, tree t2)
   /* 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)
+      && known_eq (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;
@@ -3565,7 +3663,7 @@ gnat_useless_type_conversion (tree expr)
   return false;
 }
 
-/* Return true if T, a FUNCTION_TYPE, has the specified list of flags.  */
+/* Return true if T, a {FUNCTION,METHOD}_TYPE, has the specified flags.  */
 
 bool
 fntype_same_flags_p (const_tree t, tree cico_list, bool return_unconstrained_p,
@@ -3579,7 +3677,10 @@ fntype_same_flags_p (const_tree t, tree cico_list, bool return_unconstrained_p,
 \f
 /* EXP is an expression for the size of an object.  If this size contains
    discriminant references, replace them with the maximum (if MAX_P) or
-   minimum (if !MAX_P) possible value of the discriminant.  */
+   minimum (if !MAX_P) possible value of the discriminant.
+
+   Note that the expression may have already been gimplified,in which case
+   COND_EXPRs have VOID_TYPE and no operands, and this must be handled.  */
 
 tree
 max_size (tree exp, bool max_p)
@@ -3594,6 +3695,10 @@ max_size (tree exp, bool max_p)
     case tcc_constant:
       return exp;
 
+    case tcc_exceptional:
+      gcc_assert (code == SSA_NAME);
+      return exp;
+
     case tcc_vl_exp:
       if (code == CALL_EXPR)
        {
@@ -3618,11 +3723,27 @@ max_size (tree exp, bool max_p)
         modify.  Otherwise, we treat it like a variable.  */
       if (CONTAINS_PLACEHOLDER_P (exp))
        {
-         tree val_type = TREE_TYPE (TREE_OPERAND (exp, 1));
-         tree val = (max_p ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type));
-         return
-           convert (type,
-                    max_size (convert (get_base_type (val_type), val), true));
+         tree base_type = get_base_type (TREE_TYPE (TREE_OPERAND (exp, 1)));
+         tree val
+           = fold_convert (base_type,
+                           max_p
+                           ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type));
+
+         /* Walk down the extra subtypes to get more restrictive bounds.  */
+         while (TYPE_IS_EXTRA_SUBTYPE_P (type))
+           {
+             type = TREE_TYPE (type);
+             if (max_p)
+               val = fold_build2 (MIN_EXPR, base_type, val,
+                                  fold_convert (base_type,
+                                                TYPE_MAX_VALUE (type)));
+             else
+               val = fold_build2 (MAX_EXPR, base_type, val,
+                                  fold_convert (base_type,
+                                                TYPE_MIN_VALUE (type)));
+           }
+
+         return fold_convert (type, max_size (val, max_p));
        }
 
       return exp;
@@ -3631,11 +3752,15 @@ max_size (tree exp, bool max_p)
       return build_int_cst (type, max_p ? 1 : 0);
 
     case tcc_unary:
+      op0 = TREE_OPERAND (exp, 0);
+
       if (code == NON_LVALUE_EXPR)
-       return max_size (TREE_OPERAND (exp, 0), max_p);
+       return max_size (op0, max_p);
+
+      if (VOID_TYPE_P (TREE_TYPE (op0)))
+       return max_p ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type);
 
-      op0 = max_size (TREE_OPERAND (exp, 0),
-                     code == NEGATE_EXPR ? !max_p : max_p);
+      op0 = max_size (op0, code == NEGATE_EXPR ? !max_p : max_p);
 
       if (op0 == TREE_OPERAND (exp, 0))
        return exp;
@@ -3643,49 +3768,57 @@ max_size (tree exp, bool max_p)
       return fold_build1 (code, type, op0);
 
     case tcc_binary:
-      {
-       tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
-       tree rhs = max_size (TREE_OPERAND (exp, 1),
-                            code == MINUS_EXPR ? !max_p : max_p);
-
-       /* Special-case wanting the maximum value of a MIN_EXPR.
-          In that case, if one side overflows, return the other.  */
-       if (max_p && code == MIN_EXPR)
-         {
-           if (TREE_CODE (rhs) == INTEGER_CST && TREE_OVERFLOW (rhs))
-             return lhs;
+      op0 = TREE_OPERAND (exp, 0);
+      op1 = TREE_OPERAND (exp, 1);
+
+      /* If we have a multiply-add with a "negative" value in an unsigned
+        type, do a multiply-subtract with the negated value, in order to
+        avoid creating a spurious overflow below.  */
+      if (code == PLUS_EXPR
+         && TREE_CODE (op0) == MULT_EXPR
+         && TYPE_UNSIGNED (type)
+         && TREE_CODE (TREE_OPERAND (op0, 1)) == INTEGER_CST
+         && !TREE_OVERFLOW (TREE_OPERAND (op0, 1))
+         && tree_int_cst_sign_bit (TREE_OPERAND (op0, 1)))
+       {
+         tree tmp = op1;
+         op1 = build2 (MULT_EXPR, type, TREE_OPERAND (op0, 0),
+                       fold_build1 (NEGATE_EXPR, type,
+                                   TREE_OPERAND (op0, 1)));
+         op0 = tmp;
+         code = MINUS_EXPR;
+       }
 
-           if (TREE_CODE (lhs) == INTEGER_CST && TREE_OVERFLOW (lhs))
-             return rhs;
-         }
+      op0 = max_size (op0, max_p);
+      op1 = max_size (op1, code == MINUS_EXPR ? !max_p : max_p);
 
-       /* Likewise, handle a MINUS_EXPR or PLUS_EXPR with the LHS
-          overflowing and the RHS a variable.  */
-       if ((code == MINUS_EXPR || code == PLUS_EXPR)
-           && TREE_CODE (lhs) == INTEGER_CST
-           && TREE_OVERFLOW (lhs)
-           && TREE_CODE (rhs) != INTEGER_CST)
-         return lhs;
-
-       /* If we are going to subtract a "negative" value in an unsigned type,
-          do the operation as an addition of the negated value, in order to
-          avoid creating a spurious overflow below.  */
-       if (code == MINUS_EXPR
-           && TYPE_UNSIGNED (type)
-           && TREE_CODE (rhs) == INTEGER_CST
-           && !TREE_OVERFLOW (rhs)
-           && tree_int_cst_sign_bit (rhs) != 0)
-         {
-           rhs = fold_build1 (NEGATE_EXPR, type, rhs);
-           code = PLUS_EXPR;
-         }
+      if ((code == MINUS_EXPR || code == PLUS_EXPR))
+       {
+         /* If the op0 has overflowed and the op1 is a variable,
+            propagate the overflow by returning the op0.  */
+         if (TREE_CODE (op0) == INTEGER_CST
+             && TREE_OVERFLOW (op0)
+             && TREE_CODE (op1) != INTEGER_CST)
+           return op0;
+
+         /* If we have a "negative" value in an unsigned type, do the
+            opposite operation on the negated value, in order to avoid
+            creating a spurious overflow below.  */
+         if (TYPE_UNSIGNED (type)
+             && TREE_CODE (op1) == INTEGER_CST
+             && !TREE_OVERFLOW (op1)
+             && tree_int_cst_sign_bit (op1))
+           {
+             op1 = fold_build1 (NEGATE_EXPR, type, op1);
+             code = (code == MINUS_EXPR ? PLUS_EXPR : MINUS_EXPR);
+           }
+       }
 
-       if (lhs == TREE_OPERAND (exp, 0) && rhs == TREE_OPERAND (exp, 1))
-         return exp;
+      if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
+       return exp;
 
-       /* We need to detect overflows so we call size_binop here.  */
-       return size_binop (code, lhs, rhs);
-      }
+      /* We need to detect overflows so we call size_binop here.  */
+      return size_binop (code, op0, op1);
 
     case tcc_expression:
       switch (TREE_CODE_LENGTH (code))
@@ -3717,15 +3850,28 @@ max_size (tree exp, bool max_p)
        case 3:
          if (code == COND_EXPR)
            {
+             op0 = TREE_OPERAND (exp, 0);
              op1 = TREE_OPERAND (exp, 1);
              op2 = TREE_OPERAND (exp, 2);
 
              if (!op1 || !op2)
                return exp;
 
-             return
-               fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
-                            max_size (op1, max_p), max_size (op2, max_p));
+             op1 = max_size (op1, max_p);
+             op2 = max_size (op2, max_p);
+
+             /* If we have the MAX of a "negative" value in an unsigned type
+                and zero for a length expression, just return zero.  */
+             if (max_p
+                 && TREE_CODE (op0) == LE_EXPR
+                 && TYPE_UNSIGNED (type)
+                 && TREE_CODE (op1) == INTEGER_CST
+                 && !TREE_OVERFLOW (op1)
+                 && tree_int_cst_sign_bit (op1)
+                 && integer_zerop (op2))
+               return op2;
+
+             return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type, op1, op2);
            }
          break;
 
@@ -4218,8 +4364,6 @@ convert (tree type, tree expr)
      constructor to build the record, unless a variable size is involved.  */
   else if (code == RECORD_TYPE && TYPE_PADDING_P (type))
     {
-      vec<constructor_elt, va_gc> *v;
-
       /* If we previously converted from another type and our type is
         of variable size, remove the conversion to avoid the need for
         variable-sized temporaries.  Likewise for a conversion between
@@ -4246,17 +4390,13 @@ convert (tree type, tree expr)
        return convert (type, TREE_OPERAND (expr, 0));
 
       /* 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.  */
+        is a record, do this as an unchecked conversion unless both types are
+        essentially the same.  */
       if (ecode == RECORD_TYPE
-         && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
-       {
-         if (TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST)
-           expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
-                                           false, false, false, true),
-                           expr);
-         return unchecked_convert (type, expr, false);
-       }
+         && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)))
+         && TYPE_MAIN_VARIANT (etype)
+            != TYPE_MAIN_VARIANT (TREE_TYPE (TYPE_FIELDS (type))))
+       return unchecked_convert (type, expr, false);
 
       /* If we are converting between array types with variable size, do the
         final conversion as an unchecked conversion, again to avoid the need
@@ -4271,9 +4411,21 @@ convert (tree type, tree expr)
                                           expr),
                                  false);
 
+      tree t = convert (TREE_TYPE (TYPE_FIELDS (type)), expr);
+
+      /* If converting to the inner type has already created a CONSTRUCTOR with
+         the right size, then reuse it instead of creating another one.  This
+         can happen for the padding type built to overalign local variables.  */
+      if (TREE_CODE (t) == VIEW_CONVERT_EXPR
+         && TREE_CODE (TREE_OPERAND (t, 0)) == CONSTRUCTOR
+         && TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (TREE_OPERAND (t, 0))))
+         && tree_int_cst_equal (TYPE_SIZE (type),
+                                TYPE_SIZE (TREE_TYPE (TREE_OPERAND (t, 0)))))
+       return build1 (VIEW_CONVERT_EXPR, type, TREE_OPERAND (t, 0));
+
+      vec<constructor_elt, va_gc> *v;
       vec_alloc (v, 1);
-      CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
-                             convert (TREE_TYPE (TYPE_FIELDS (type)), expr));
+      CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), t);
       return gnat_build_constructor (type, v);
     }
 
@@ -4308,12 +4460,13 @@ convert (tree type, tree expr)
                                                TYPE_MIN_VALUE (etype))));
 
   /* If the input is a justified modular type, we need to extract the actual
-     object before converting it to any other type with the exceptions of an
-     unconstrained array or of a mere type variant.  It is useful to avoid the
-     extraction and conversion in the type variant case because it could end
-     up replacing a VAR_DECL expr by a constructor and we might be about the
-     take the address of the result.  */
+     object before converting it to an other type with the exceptions of an
+     [unconstrained] array or a mere type variant.  It is useful to avoid
+     the extraction and conversion in these cases because it could end up
+     replacing a VAR_DECL by a constructor and we might be about the take
+     the address of the result.  */
   if (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)
+      && code != ARRAY_TYPE
       && code != UNCONSTRAINED_ARRAY_TYPE
       && TYPE_MAIN_VARIANT (type) != TYPE_MAIN_VARIANT (etype))
     return
@@ -4358,9 +4511,9 @@ convert (tree type, tree expr)
     case STRING_CST:
       /* If we are converting a STRING_CST to another constrained array type,
         just make a new one in the proper type.  */
-      if (code == ecode && AGGREGATE_TYPE_P (etype)
-         && !(TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST
-              && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST))
+      if (code == ecode
+         && !(TREE_CONSTANT (TYPE_SIZE (etype))
+              && !TREE_CONSTANT (TYPE_SIZE (type))))
        {
          expr = copy_node (expr);
          TREE_TYPE (expr) = type;
@@ -4570,9 +4723,12 @@ convert (tree type, tree expr)
                                           etype)))
     return build1 (VIEW_CONVERT_EXPR, type, expr);
 
-  /* If we are converting between tagged types, try to upcast properly.  */
+  /* If we are converting between tagged types, try to upcast properly.
+     But don't do it if we are just annotating types since tagged types
+     aren't fully laid out in this mode.  */
   else if (ecode == RECORD_TYPE && code == RECORD_TYPE
-          && TYPE_ALIGN_OK (etype) && TYPE_ALIGN_OK (type))
+          && TYPE_ALIGN_OK (etype) && TYPE_ALIGN_OK (type)
+          && !type_annotate_only)
     {
       tree child_etype = etype;
       do {
@@ -4687,6 +4843,7 @@ convert (tree type, tree expr)
       return fold (convert_to_real (type, expr));
 
     case RECORD_TYPE:
+      /* Do a normal conversion between scalar and justified modular type.  */
       if (TYPE_JUSTIFIED_MODULAR_P (type) && !AGGREGATE_TYPE_P (etype))
        {
          vec<constructor_elt, va_gc> *v;
@@ -4698,9 +4855,27 @@ convert (tree type, tree expr)
          return gnat_build_constructor (type, v);
        }
 
-      /* ... fall through ... */
+      /* In these cases, assume the front-end has validated the conversion.
+        If the conversion is valid, it will be a bit-wise conversion, so
+        it can be viewed as an unchecked conversion.  */
+      return unchecked_convert (type, expr, false);
 
     case ARRAY_TYPE:
+      /* Do a normal conversion between unconstrained and constrained array
+        type, assuming the latter is a constrained version of the former.  */
+      if (TREE_CODE (expr) == INDIRECT_REF
+         && ecode == ARRAY_TYPE
+         && TREE_TYPE (etype) == TREE_TYPE (type))
+       {
+         tree ptr_type = build_pointer_type (type);
+         tree t = build_unary_op (INDIRECT_REF, NULL_TREE,
+                                  fold_convert (ptr_type,
+                                                TREE_OPERAND (expr, 0)));
+         TREE_READONLY (t) = TREE_READONLY (expr);
+         TREE_THIS_NOTRAP (t) = TREE_THIS_NOTRAP (expr);
+         return t;
+       }
+
       /* In these cases, assume the front-end has validated the conversion.
         If the conversion is valid, it will be a bit-wise conversion, so
         it can be viewed as an unchecked conversion.  */
@@ -5030,8 +5205,16 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
   tree etype = TREE_TYPE (expr);
   enum tree_code ecode = TREE_CODE (etype);
   enum tree_code code = TREE_CODE (type);
+  const bool ebiased
+    = (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype));
+  const bool biased
+    = (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type));
+  const bool ereverse
+    = (AGGREGATE_TYPE_P (etype) && TYPE_REVERSE_STORAGE_ORDER (etype));
+  const bool reverse
+    = (AGGREGATE_TYPE_P (type) && TYPE_REVERSE_STORAGE_ORDER (type));
   tree tem;
-  int c;
+  int c = 0;
 
   /* If the expression is already of the right type, we are done.  */
   if (etype == type)
@@ -5047,7 +5230,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
           || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype))))
       || code == UNCONSTRAINED_ARRAY_TYPE)
     {
-      if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
+      if (ebiased)
        {
          tree ntype = copy_type (etype);
          TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
@@ -5055,7 +5238,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
          expr = build1 (NOP_EXPR, ntype, expr);
        }
 
-      if (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
+      if (biased)
        {
          tree rtype = copy_type (type);
          TYPE_BIASED_REPRESENTATION_P (rtype) = 0;
@@ -5084,30 +5267,35 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      Finally, for the sake of consistency, we do the unchecked conversion
      to an integral type with reverse storage order as soon as the source
      type is an aggregate type with reverse storage order, even if there
-     are no considerations of precision or size involved.  */
-  else if (INTEGRAL_TYPE_P (type)
-          && TYPE_RM_SIZE (type)
-          && (tree_int_cst_compare (TYPE_RM_SIZE (type),
-                                    TYPE_SIZE (type)) < 0
-              || (AGGREGATE_TYPE_P (etype)
-                  && TYPE_REVERSE_STORAGE_ORDER (etype))))
+     are no considerations of precision or size involved.  Ultimately, we
+     further extend this processing to any scalar type.  */
+  else if ((INTEGRAL_TYPE_P (type)
+           && TYPE_RM_SIZE (type)
+           && ((c = tree_int_cst_compare (TYPE_RM_SIZE (type),
+                                          TYPE_SIZE (type))) < 0
+               || ereverse))
+          || (SCALAR_FLOAT_TYPE_P (type) && ereverse))
     {
       tree rec_type = make_node (RECORD_TYPE);
-      unsigned HOST_WIDE_INT prec = TREE_INT_CST_LOW (TYPE_RM_SIZE (type));
       tree field_type, field;
 
-      if (AGGREGATE_TYPE_P (etype))
-       TYPE_REVERSE_STORAGE_ORDER (rec_type)
-         = TYPE_REVERSE_STORAGE_ORDER (etype);
+      TYPE_REVERSE_STORAGE_ORDER (rec_type) = ereverse;
 
-      if (type_unsigned_for_rm (type))
-       field_type = make_unsigned_type (prec);
+      if (c < 0)
+       {
+         const unsigned HOST_WIDE_INT prec
+           = TREE_INT_CST_LOW (TYPE_RM_SIZE (type));
+         if (type_unsigned_for_rm (type))
+           field_type = make_unsigned_type (prec);
+         else
+           field_type = make_signed_type (prec);
+         SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (type));
+       }
       else
-       field_type = make_signed_type (prec);
-      SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (type));
+       field_type = type;
 
       field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type,
-                                NULL_TREE, bitsize_zero_node, 1, 0);
+                                NULL_TREE, bitsize_zero_node, c < 0, 0);
 
       finish_record_type (rec_type, field, 1, false);
 
@@ -5122,31 +5310,35 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 
      The same considerations as above apply if the target type is an aggregate
      type with reverse storage order and we also proceed similarly.  */
-  else if (INTEGRAL_TYPE_P (etype)
-          && TYPE_RM_SIZE (etype)
-          && (tree_int_cst_compare (TYPE_RM_SIZE (etype),
-                                    TYPE_SIZE (etype)) < 0
-              || (AGGREGATE_TYPE_P (type)
-                  && TYPE_REVERSE_STORAGE_ORDER (type))))
+  else if ((INTEGRAL_TYPE_P (etype)
+           && TYPE_RM_SIZE (etype)
+           && ((c = tree_int_cst_compare (TYPE_RM_SIZE (etype),
+                                          TYPE_SIZE (etype))) < 0
+               || reverse))
+          || (SCALAR_FLOAT_TYPE_P (etype) && reverse))
     {
       tree rec_type = make_node (RECORD_TYPE);
-      unsigned HOST_WIDE_INT prec = TREE_INT_CST_LOW (TYPE_RM_SIZE (etype));
       vec<constructor_elt, va_gc> *v;
       vec_alloc (v, 1);
       tree field_type, field;
 
-      if (AGGREGATE_TYPE_P (type))
-       TYPE_REVERSE_STORAGE_ORDER (rec_type)
-         = TYPE_REVERSE_STORAGE_ORDER (type);
+      TYPE_REVERSE_STORAGE_ORDER (rec_type) = reverse;
 
-      if (type_unsigned_for_rm (etype))
-       field_type = make_unsigned_type (prec);
+      if (c < 0)
+       {
+         const unsigned HOST_WIDE_INT prec
+           = TREE_INT_CST_LOW (TYPE_RM_SIZE (etype));
+         if (type_unsigned_for_rm (etype))
+           field_type = make_unsigned_type (prec);
+         else
+           field_type = make_signed_type (prec);
+         SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (etype));
+       }
       else
-       field_type = make_signed_type (prec);
-      SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (etype));
+       field_type = etype;
 
       field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type,
-                                NULL_TREE, bitsize_zero_node, 1, 0);
+                                NULL_TREE, bitsize_zero_node, c < 0, 0);
 
       finish_record_type (rec_type, field, 1, false);
 
@@ -5168,7 +5360,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      so we skip all expressions that are references.  */
   else if (!REFERENCE_CLASS_P (expr)
           && !AGGREGATE_TYPE_P (etype)
-          && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST
+          && TREE_CONSTANT (TYPE_SIZE (type))
           && (c = tree_int_cst_compare (TYPE_SIZE (etype), TYPE_SIZE (type))))
     {
       if (c < 0)
@@ -5216,10 +5408,13 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
       return unchecked_convert (type, expr, notrunc_p);
     }
 
-  /* If we are converting a CONSTRUCTOR to a more aligned RECORD_TYPE, bump
-     the alignment of the CONSTRUCTOR to speed up the copy operation.  */
+  /* If we are converting a CONSTRUCTOR to a more aligned aggregate type, bump
+     the alignment of the CONSTRUCTOR to speed up the copy operation.  But do
+     not do it for a conversion between original and packable version to avoid
+     an infinite recursion.  */
   else if (TREE_CODE (expr) == CONSTRUCTOR
-          && code == RECORD_TYPE
+          && AGGREGATE_TYPE_P (type)
+          && TYPE_NAME (type) != TYPE_NAME (etype)
           && TYPE_ALIGN (etype) < TYPE_ALIGN (type))
     {
       expr = convert (maybe_pad_type (etype, NULL_TREE, TYPE_ALIGN (type),
@@ -5228,6 +5423,23 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
       return unchecked_convert (type, expr, notrunc_p);
     }
 
+  /* If we are converting a CONSTRUCTOR to a larger aggregate type, bump the
+     size of the CONSTRUCTOR to make sure there are enough allocated bytes.
+     But do not do it for a conversion between original and packable version
+     to avoid an infinite recursion.  */
+  else if (TREE_CODE (expr) == CONSTRUCTOR
+          && AGGREGATE_TYPE_P (type)
+          && TYPE_NAME (type) != TYPE_NAME (etype)
+          && TREE_CONSTANT (TYPE_SIZE (type))
+          && (!TREE_CONSTANT (TYPE_SIZE (etype))
+              || tree_int_cst_lt (TYPE_SIZE (etype), TYPE_SIZE (type))))
+    {
+      expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0,
+                                     Empty, false, false, false, true),
+                     expr);
+      return unchecked_convert (type, expr, notrunc_p);
+    }
+
   /* Otherwise, just build a VIEW_CONVERT_EXPR of the expression.  */
   else
     {
@@ -5244,33 +5456,40 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      to its size, sign- or zero-extend the result.  But we need not do this
      if the input is also an integral type and both are unsigned or both are
      signed and have the same precision.  */
+  tree type_rm_size;
   if (!notrunc_p
+      && !biased
       && INTEGRAL_TYPE_P (type)
-      && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
-      && TYPE_RM_SIZE (type)
-      && tree_int_cst_compare (TYPE_RM_SIZE (type), TYPE_SIZE (type)) < 0
+      && (type_rm_size = TYPE_RM_SIZE (type))
+      && tree_int_cst_compare (type_rm_size, TYPE_SIZE (type)) < 0
       && !(INTEGRAL_TYPE_P (etype)
           && type_unsigned_for_rm (type) == type_unsigned_for_rm (etype)
           && (type_unsigned_for_rm (type)
-              || tree_int_cst_compare (TYPE_RM_SIZE (type),
+              || tree_int_cst_compare (type_rm_size,
                                        TYPE_RM_SIZE (etype)
                                        ? TYPE_RM_SIZE (etype)
                                        : TYPE_SIZE (etype)) == 0)))
     {
-      tree base_type
-       = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (type)),
-                             type_unsigned_for_rm (type));
-      tree shift_expr
-       = convert (base_type,
-                  size_binop (MINUS_EXPR,
-                              TYPE_SIZE (type), TYPE_RM_SIZE (type)));
-      expr
-       = convert (type,
-                  build_binary_op (RSHIFT_EXPR, base_type,
-                                   build_binary_op (LSHIFT_EXPR, base_type,
-                                                    convert (base_type, expr),
-                                                    shift_expr),
-                                   shift_expr));
+      if (integer_zerop (type_rm_size))
+       expr = build_int_cst (type, 0);
+      else
+       {
+         tree base_type
+           = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (type)),
+                                 type_unsigned_for_rm (type));
+         tree shift_expr
+           = convert (base_type,
+                      size_binop (MINUS_EXPR,
+                                  TYPE_SIZE (type), type_rm_size));
+         expr
+           = convert (type,
+                      build_binary_op (RSHIFT_EXPR, base_type,
+                                       build_binary_op (LSHIFT_EXPR, base_type,
+                                                        convert (base_type,
+                                                                 expr),
+                                                        shift_expr),
+                                       shift_expr));
+       }
     }
 
   /* An unchecked conversion should never raise Constraint_Error.  The code
@@ -5693,6 +5912,7 @@ enum c_builtin_type
                                ARG6, ARG7) NAME,
 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
 #include "builtin-types.def"
+#include "ada-builtin-types.def"
 #undef DEF_PRIMITIVE_TYPE
 #undef DEF_FUNCTION_TYPE_0
 #undef DEF_FUNCTION_TYPE_1
@@ -5841,6 +6061,7 @@ install_builtin_function_types (void)
   builtin_types[(int) ENUM] = build_pointer_type (builtin_types[(int) TYPE]);
 
 #include "builtin-types.def"
+#include "ada-builtin-types.def"
 
 #undef DEF_PRIMITIVE_TYPE
 #undef DEF_FUNCTION_TYPE_0
@@ -6132,8 +6353,7 @@ handle_noreturn_attribute (tree *node, tree name, tree ARG_UNUSED (args),
           && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE)
     TREE_TYPE (*node)
       = build_pointer_type
-       (build_type_variant (TREE_TYPE (type),
-                            TYPE_READONLY (TREE_TYPE (type)), 1));
+       (change_qualified_type (TREE_TYPE (type), TYPE_QUAL_VOLATILE));
   else
     {
       warning (OPT_Wattributes, "%qs attribute ignored",
@@ -6144,6 +6364,22 @@ handle_noreturn_attribute (tree *node, tree name, tree ARG_UNUSED (args),
   return NULL_TREE;
 }
 
+/* Handle a "stack_protect" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_stack_protect_attribute (tree *node, tree name, tree, int,
+                               bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) != FUNCTION_DECL)
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
 /* Handle a "noinline" attribute; arguments as in
    struct attribute_spec.handler.  */
 
@@ -6189,6 +6425,38 @@ handle_noclone_attribute (tree *node, tree name,
   return NULL_TREE;
 }
 
+/* Handle a "no_icf" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_noicf_attribute (tree *node, tree name,
+                       tree ARG_UNUSED (args),
+                       int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) != FUNCTION_DECL)
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "noipa" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_noipa_attribute (tree *node, tree name, tree, int, bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) != FUNCTION_DECL)
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
 /* Handle a "leaf" attribute; arguments as in
    struct attribute_spec.handler.  */
 
@@ -6279,6 +6547,166 @@ handle_type_generic_attribute (tree *node, tree ARG_UNUSED (name),
   return NULL_TREE;
 }
 
+/* Handle a "flatten" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_flatten_attribute (tree *node, tree name,
+                         tree args ATTRIBUTE_UNUSED,
+                         int flags ATTRIBUTE_UNUSED, bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) == FUNCTION_DECL)
+    /* Do nothing else, just set the attribute.  We'll get at
+       it later with lookup_attribute.  */
+    ;
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "used" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_used_attribute (tree *pnode, tree name, tree ARG_UNUSED (args),
+                      int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  tree node = *pnode;
+
+  if (TREE_CODE (node) == FUNCTION_DECL
+      || (VAR_P (node) && TREE_STATIC (node))
+      || (TREE_CODE (node) == TYPE_DECL))
+    {
+      TREE_USED (node) = 1;
+      DECL_PRESERVE_P (node) = 1;
+      if (VAR_P (node))
+       DECL_READ_P (node) = 1;
+    }
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "cold" and attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_cold_attribute (tree *node, tree name, tree ARG_UNUSED (args),
+                      int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) == FUNCTION_DECL
+      || TREE_CODE (*node) == LABEL_DECL)
+    {
+      /* Attribute cold processing is done later with lookup_attribute.  */
+    }
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "hot" and attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_hot_attribute (tree *node, tree name, tree ARG_UNUSED (args),
+                     int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) == FUNCTION_DECL
+      || TREE_CODE (*node) == LABEL_DECL)
+    {
+      /* Attribute hot processing is done later with lookup_attribute.  */
+    }
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "target" attribute.  */
+
+static tree
+handle_target_attribute (tree *node, tree name, tree args, int flags,
+                        bool *no_add_attrs)
+{
+  /* Ensure we have a function type.  */
+  if (TREE_CODE (*node) != FUNCTION_DECL)
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+  else if (lookup_attribute ("target_clones", DECL_ATTRIBUTES (*node)))
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
+                  "with %qs attribute", name, "target_clones");
+      *no_add_attrs = true;
+    }
+  else if (!targetm.target_option.valid_attribute_p (*node, name, args, flags))
+    *no_add_attrs = true;
+
+  /* Check that there's no empty string in values of the attribute.  */
+  for (tree t = args; t != NULL_TREE; t = TREE_CHAIN (t))
+    {
+      tree value = TREE_VALUE (t);
+      if (TREE_CODE (value) == STRING_CST
+         && TREE_STRING_LENGTH (value) == 1
+         && TREE_STRING_POINTER (value)[0] == '\0')
+       {
+         warning (OPT_Wattributes, "empty string in attribute %<target%>");
+         *no_add_attrs = true;
+       }
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "target_clones" attribute.  */
+
+static tree
+handle_target_clones_attribute (tree *node, tree name, tree ARG_UNUSED (args),
+                         int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  /* Ensure we have a function type.  */
+  if (TREE_CODE (*node) == FUNCTION_DECL)
+    {
+      if (lookup_attribute ("always_inline", DECL_ATTRIBUTES (*node)))
+       {
+         warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
+                  "with %qs attribute", name, "always_inline");
+         *no_add_attrs = true;
+       }
+      else if (lookup_attribute ("target", DECL_ATTRIBUTES (*node)))
+       {
+         warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
+                  "with %qs attribute", name, "target");
+         *no_add_attrs = true;
+       }
+      else
+       /* Do not inline functions with multiple clone targets.  */
+       DECL_UNINLINABLE (*node) = 1;
+    }
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+  return NULL_TREE;
+}
+
 /* Handle a "vector_size" attribute; arguments as in
    struct attribute_spec.handler.  */
 
@@ -6367,6 +6795,9 @@ def_builtin_1 (enum built_in_function fncode,
   if (builtin_decl_explicit (fncode))
     return;
 
+  if (fntype == error_mark_node)
+    return;
+
   gcc_assert ((!both_p && !fallback_p)
              || !strncmp (name, "__builtin_",
                           strlen ("__builtin_")));
@@ -6388,7 +6819,10 @@ static int flag_isoc94 = 0;
 static int flag_isoc99 = 0;
 static int flag_isoc11 = 0;
 
-/* Install what the common builtins.def offers.  */
+/* Install what the common builtins.def offers plus our local additions.
+
+   Note that ada-builtins.def is included first so that locally redefined
+   built-in functions take precedence over the commonly defined ones.  */
 
 static void
 install_builtin_functions (void)
@@ -6401,6 +6835,10 @@ install_builtin_functions (void)
                    builtin_types[(int) LIBTYPE],                        \
                    BOTH_P, FALLBACK_P, NONANSI_P,                       \
                    built_in_attributes[(int) ATTRS], IMPLICIT);
+#define DEF_ADA_BUILTIN(ENUM, NAME, TYPE, ATTRS)               \
+  DEF_BUILTIN (ENUM, "__builtin_" NAME, BUILT_IN_FRONTEND, TYPE, BT_LAST, \
+              false, false, false, ATTRS, true, true)
+#include "ada-builtins.def"
 #include "builtins.def"
 }