OSDN Git Service

* gimple.c (walk_gimple_op) <GIMPLE_ASSIGN>: Do not request a pure
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / decl.c
index ceb1f34..a333170 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, 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- *
@@ -138,6 +138,7 @@ static bool same_discriminant_p (Entity_Id, Entity_Id);
 static bool array_type_has_nonaliased_component (tree, Entity_Id);
 static bool compile_time_known_address_p (Node_Id);
 static bool cannot_be_superflat_p (Node_Id);
+static bool constructor_address_p (tree);
 static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
                                  bool, bool, bool, bool, bool);
 static Uint annotate_value (tree);
@@ -897,7 +898,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                            && !TREE_SIDE_EFFECTS (gnu_expr))))
                  {
                    maybe_stable_expr
-                     = maybe_stabilize_reference (gnu_expr, true, &stable);
+                     = gnat_stabilize_reference (gnu_expr, true, &stable);
 
                    if (stable)
                      {
@@ -973,7 +974,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                    else
                     {
                        maybe_stable_expr
-                         = maybe_stabilize_reference (gnu_expr, true, &stable);
+                         = gnat_stabilize_reference (gnu_expr, true, &stable);
 
                        if (stable)
                          renamed_obj = maybe_stable_expr;
@@ -1376,6 +1377,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            DECL_IGNORED_P (gnu_decl) = 1;
          }
 
+       /* If this is a constant, even if we don't need a true variable, we
+          may need to avoid returning the initializer in every case.  That
+          can happen for the address of a (constant) constructor because,
+          upon dereferencing it, the constructor will be reinjected in the
+          tree, which may not be valid in every case; see lvalue_required_p
+          for more details.  */
+       if (TREE_CODE (gnu_decl) == CONST_DECL)
+         DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr);
+
        /* If this is declared in a block that contains a block with an
           exception handler, we must force this variable in memory to
           suppress an invalid optimization.  */
@@ -1416,30 +1426,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          break;
        }
 
-      /* Normal case of non-character type or non-Standard character type.  */
       {
-       /* Here we have a list of enumeral constants in First_Literal.
-          We make a CONST_DECL for each and build into GNU_LITERAL_LIST
-          the list to be placed into TYPE_FIELDS.  Each node in the list
-          is a TREE_LIST whose TREE_VALUE is the literal name and whose
-          TREE_PURPOSE is the value of the literal.  */
-
-       Entity_Id gnat_literal;
+       /* We have a list of enumeral constants in First_Literal.  We make a
+          CONST_DECL for each one and build into GNU_LITERAL_LIST the list to
+          be placed into TYPE_FIELDS.  Each node in the list is a TREE_LIST
+          whose TREE_VALUE is the literal name and whose TREE_PURPOSE is the
+          value of the literal.  But when we have a regular boolean type, we
+          simplify this a little by using a BOOLEAN_TYPE.  */
+       bool is_boolean = Is_Boolean_Type (gnat_entity)
+                         && !Has_Non_Standard_Rep (gnat_entity);
        tree gnu_literal_list = NULL_TREE;
+       Entity_Id gnat_literal;
 
        if (Is_Unsigned_Type (gnat_entity))
          gnu_type = make_unsigned_type (esize);
        else
          gnu_type = make_signed_type (esize);
 
-       TREE_SET_CODE (gnu_type, ENUMERAL_TYPE);
+       TREE_SET_CODE (gnu_type, is_boolean ? BOOLEAN_TYPE : ENUMERAL_TYPE);
 
        for (gnat_literal = First_Literal (gnat_entity);
             Present (gnat_literal);
             gnat_literal = Next_Literal (gnat_literal))
          {
-           tree gnu_value = UI_To_gnu (Enumeration_Rep (gnat_literal),
-                                       gnu_type);
+           tree gnu_value
+             = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type);
            tree gnu_literal
              = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
                                 gnu_type, gnu_value, true, false, false,
@@ -1450,7 +1461,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                                          gnu_value, gnu_literal_list);
          }
 
-       TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
+       if (!is_boolean)
+         TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
 
        /* Note that the bounds are updated at the end of this function
           to avoid an infinite recursion since they refer to the type.  */
@@ -1591,6 +1603,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                           gnat_to_gnu_type
                           (Original_Array_Type (gnat_entity)));
 
+      /* We have to handle clauses that under-align the type specially.  */
+      if ((Present (Alignment_Clause (gnat_entity))
+          || (Is_Packed_Array_Type (gnat_entity)
+              && Present
+                 (Alignment_Clause (Original_Array_Type (gnat_entity)))))
+         && UI_Is_In_Int_Range (Alignment (gnat_entity)))
+       {
+         align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT;
+         if (align >= TYPE_ALIGN (gnu_type))
+           align = 0;
+       }
+
       /* If the type we are dealing with represents a bit-packed array,
         we need to have the bits left justified on big-endian targets
         and right justified on little-endian targets.  We also need to
@@ -1603,91 +1627,98 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        {
          tree gnu_field_type, gnu_field;
 
-         /* Set the RM size before wrapping up the type.  */
+         /* Set the RM size before wrapping up the original type.  */
          SET_TYPE_RM_SIZE (gnu_type,
                            UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
          TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
+
+         /* Create a stripped-down declaration, mainly for debugging.  */
+         create_type_decl (gnu_entity_name, gnu_type, NULL, true,
+                           debug_info_p, gnat_entity);
+
+         /* Now save it and build the enclosing record type.  */
          gnu_field_type = gnu_type;
 
          gnu_type = make_node (RECORD_TYPE);
          TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "JM");
-
-         /* Propagate the alignment of the modular type to the record.
-            This means that bit-packed arrays have "ceil" alignment for
-            their size, which may seem counter-intuitive but makes it
-            possible to easily overlay them on modular types.  */
-         TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_field_type);
          TYPE_PACKED (gnu_type) = 1;
+         TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type);
+         TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type);
+         SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type));
+
+         /* Propagate the alignment of the modular type to the record type,
+            unless there is an alignment clause that under-aligns the type.
+            This means that bit-packed arrays are given "ceil" alignment for
+            their size by default, which may seem counter-intuitive but makes
+            it possible to overlay them on modular types easily.  */
+         TYPE_ALIGN (gnu_type)
+           = align > 0 ? align : TYPE_ALIGN (gnu_field_type);
 
-         /* Create a stripped-down declaration of the original type, mainly
-            for debugging.  */
-         create_type_decl (gnu_entity_name, gnu_field_type, NULL, true,
-                           debug_info_p, gnat_entity);
+         relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
 
          /* Don't notify the field as "addressable", since we won't be taking
             it's address and it would prevent create_field_decl from making a
             bitfield.  */
          gnu_field = create_field_decl (get_identifier ("OBJECT"),
-                                        gnu_field_type, gnu_type, 1, 0, 0, 0);
+                                        gnu_field_type, gnu_type, 1,
+                                        NULL_TREE, bitsize_zero_node, 0);
 
-         /* Do not finalize it until after the parallel type is added.  */
-         finish_record_type (gnu_type, gnu_field, 0, true);
+         /* Do not emit debug info until after the parallel type is added.  */
+         finish_record_type (gnu_type, gnu_field, 2, false);
+         compute_record_mode (gnu_type);
          TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
 
-         relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
-
-         /* Make the original array type a parallel type.  */
-         if (debug_info_p
-             && present_gnu_tree (Original_Array_Type (gnat_entity)))
-           add_parallel_type (TYPE_STUB_DECL (gnu_type),
-                              gnat_to_gnu_type
-                              (Original_Array_Type (gnat_entity)));
+         if (debug_info_p)
+           {
+             /* Make the original array type a parallel type.  */
+             if (present_gnu_tree (Original_Array_Type (gnat_entity)))
+               add_parallel_type (TYPE_STUB_DECL (gnu_type),
+                                  gnat_to_gnu_type
+                                  (Original_Array_Type (gnat_entity)));
 
-         rest_of_record_type_compilation (gnu_type);
+             rest_of_record_type_compilation (gnu_type);
+           }
        }
 
       /* If the type we are dealing with has got a smaller alignment than the
         natural one, we need to wrap it up in a record type and under-align
         the latter.  We reuse the padding machinery for this purpose.  */
-      else if (Present (Alignment_Clause (gnat_entity))
-              && UI_Is_In_Int_Range (Alignment (gnat_entity))
-              && (align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT)
-              && align < TYPE_ALIGN (gnu_type))
+      else if (align > 0)
        {
          tree gnu_field_type, gnu_field;
 
          /* Set the RM size before wrapping up the type.  */
          SET_TYPE_RM_SIZE (gnu_type,
                            UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
+
+         /* Create a stripped-down declaration, mainly for debugging.  */
+         create_type_decl (gnu_entity_name, gnu_type, NULL, true,
+                           debug_info_p, gnat_entity);
+
+         /* Now save it and build the enclosing record type.  */
          gnu_field_type = gnu_type;
 
          gnu_type = make_node (RECORD_TYPE);
          TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD");
-
-         TYPE_ALIGN (gnu_type) = align;
          TYPE_PACKED (gnu_type) = 1;
-
-         /* Create a stripped-down declaration of the original type, mainly
-            for debugging.  */
-         create_type_decl (gnu_entity_name, gnu_field_type, NULL, true,
-                           debug_info_p, gnat_entity);
+         TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type);
+         TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type);
+         SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type));
+         TYPE_ALIGN (gnu_type) = align;
+         relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
 
          /* Don't notify the field as "addressable", since we won't be taking
             it's address and it would prevent create_field_decl from making a
             bitfield.  */
-         gnu_field = create_field_decl (get_identifier ("OBJECT"),
-                                        gnu_field_type, gnu_type, 1, 0, 0, 0);
+         gnu_field = create_field_decl (get_identifier ("F"),
+                                        gnu_field_type, gnu_type, 1,
+                                        NULL_TREE, bitsize_zero_node, 0);
 
-         finish_record_type (gnu_type, gnu_field, 0, false);
+         finish_record_type (gnu_type, gnu_field, 2, debug_info_p);
+         compute_record_mode (gnu_type);
          TYPE_PADDING_P (gnu_type) = 1;
-
-         relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
        }
 
-      /* Otherwise reset the alignment lest we computed it above.  */
-      else
-       align = 0;
-
       break;
 
     case E_Floating_Point_Type:
@@ -1824,9 +1855,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        /* Make sure we can put this into a register.  */
        TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
 
-       /* Do not finalize this record type since the types of its fields
-          are still incomplete at this point.  */
-       finish_record_type (gnu_fat_type, tem, 0, true);
+       /* Do not emit debug info for this record type since the types of its
+          fields are still incomplete at this point.  */
+       finish_record_type (gnu_fat_type, tem, 0, false);
        TYPE_FAT_POINTER_P (gnu_fat_type) = 1;
 
        /* Build a reference to the template from a PLACEHOLDER_EXPR that
@@ -1933,7 +1964,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            = chainon (gnu_template_fields, gnu_temp_fields[index]);
 
        /* Install all the fields into the template.  */
-       finish_record_type (gnu_template_type, gnu_template_fields, 0, false);
+       finish_record_type (gnu_template_type, gnu_template_fields, 0,
+                           debug_info_p);
        TYPE_READONLY (gnu_template_type) = 1;
 
        /* Now make the array of arrays and update the pointer to the array
@@ -2393,7 +2425,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                  gnu_field_list = gnu_field;
                }
 
-             finish_record_type (gnu_bound_rec, gnu_field_list, 0, false);
+             finish_record_type (gnu_bound_rec, gnu_field_list, 0, true);
              add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec);
            }
 
@@ -2867,13 +2899,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        /* Add the fields into the record type and finish it up.  */
        components_to_record (gnu_type, Component_List (record_definition),
                              gnu_field_list, packed, definition, NULL,
-                             false, all_rep, false, is_unchecked_union,
-                             debug_info_p);
+                             false, all_rep, is_unchecked_union,
+                             debug_info_p, false);
 
-       /* If it is a tagged record force the type to BLKmode to insure that
-          these objects will always be put in memory.  Likewise for limited
-          record types.  */
-       if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity))
+       /* If it is passed by reference, force BLKmode to ensure that objects
++         of this type will always be put in memory.  */
+       if (Is_By_Reference_Type (gnat_entity))
          SET_TYPE_MODE (gnu_type, BLKmode);
 
        /* We used to remove the associations of the discriminants and _Parent
@@ -3188,13 +3219,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                    && !present_gnu_tree (Etype (gnat_field)))
                  gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0);
 
-             /* Do not finalize it since we're going to modify it below.  */
+             /* Do not emit debug info for the type yet since we're going to
+                modify it below.  */
              gnu_field_list = nreverse (gnu_field_list);
-             finish_record_type (gnu_type, gnu_field_list, 2, true);
+             finish_record_type (gnu_type, gnu_field_list, 2, false);
 
              /* See the E_Record_Type case for the rationale.  */
-             if (Is_Tagged_Type (gnat_entity)
-                 || Is_Limited_Record (gnat_entity))
+             if (Is_By_Reference_Type (gnat_entity))
                SET_TYPE_MODE (gnu_type, BLKmode);
              else
                compute_record_mode (gnu_type);
@@ -3225,7 +3256,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                                                         gnu_subtype_marker,
                                                         0, NULL_TREE,
                                                         NULL_TREE, 0),
-                                     0, false);
+                                     0, true);
 
                  add_parallel_type (TYPE_STUB_DECL (gnu_type),
                                     gnu_subtype_marker);
@@ -3459,9 +3490,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                  = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
                TYPE_FAT_POINTER_P (gnu_type) = 1;
 
-               /* Do not finalize this record type since the types of
-                  its fields are incomplete.  */
-               finish_record_type (gnu_type, fields, 0, true);
+               /* Do not emit debug info for this record type since the types
+                  of its fields are incomplete.  */
+               finish_record_type (gnu_type, fields, 0, false);
 
                TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE);
                TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old))
@@ -3776,13 +3807,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        tree gnu_field_list = NULL_TREE;
        /* Non-null for subprograms containing parameters passed by copy-in
           copy-out (Ada In Out or Out parameters not passed by reference),
-          in which case it is the list of nodes used to specify the values of
-          the in out/out parameters that are returned as a record upon
+          in which case it is the list of nodes used to specify the values
+          of the In Out/Out parameters that are returned as a record upon
           procedure return.  The TREE_PURPOSE of an element of this list is
           a field of the record and the TREE_VALUE is the PARM_DECL
           corresponding to that field.  This list will be saved in the
           TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create.  */
-       tree gnu_return_list = NULL_TREE;
+       tree gnu_cico_list = NULL_TREE;
        /* If an import pragma asks to map this subprogram to a GCC builtin,
           this is the builtin DECL node.  */
        tree gnu_builtin_decl = NULL_TREE;
@@ -3808,9 +3839,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
             && Is_Pure (gnat_entity));
 
        bool volatile_flag = No_Return (gnat_entity);
-       bool returns_by_ref = false;
-       bool returns_unconstrained = false;
-       bool returns_by_target_ptr = false;
+       bool return_by_direct_ref_p = false;
+       bool return_by_invisi_ref_p = false;
+       bool return_unconstrained_p = false;
        bool has_copy_in_out = false;
        bool has_stub = false;
        int parmnum;
@@ -3862,37 +3893,39 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        if (kind == E_Function || kind == E_Subprogram_Type)
          gnu_return_type = gnat_to_gnu_type (Etype (gnat_entity));
 
-       /* If this function returns by reference, make the actual
-          return type of this function the pointer and mark the decl.  */
+       /* If this function returns by reference, make the actual return
+          type of this function the pointer and mark the decl.  */
        if (Returns_By_Ref (gnat_entity))
          {
-           returns_by_ref = true;
            gnu_return_type = build_pointer_type (gnu_return_type);
+           return_by_direct_ref_p = true;
          }
 
-       /* If the Mechanism is By_Reference, ensure the return type uses
-          the machine's by-reference mechanism, which may not the same
-          as above (e.g., it might be by passing a fake parameter).  */
-       else if (kind == E_Function
-                && Mechanism (gnat_entity) == By_Reference)
-         {
-           TREE_ADDRESSABLE (gnu_return_type) = 1;
-
-           /* We expect this bit to be reset by gigi shortly, so can avoid a
-              type node copy here.  This actually also prevents troubles with
-              the generation of debug information for the function, because
-              we might have issued such info for this type already, and would
-              be attaching a distinct type node to the function if we made a
-              copy here.  */
-         }
-
-       /* If we are supposed to return an unconstrained array,
-          actually return a fat pointer and make a note of that.  Return
-          a pointer to an unconstrained record of variable size.  */
+       /* If the Mechanism is By_Reference, ensure this function uses the
+          target's by-invisible-reference mechanism, which may not be the
+          same as above (e.g. it might be passing an extra parameter).
+
+          Prior to GCC 4, this was handled by just setting TREE_ADDRESSABLE
+          on the result type.  Everything required to pass by invisible
+          reference using the target's mechanism (e.g. an extra parameter)
+          was handled at RTL expansion time.
+
+          This doesn't work with GCC 4 any more for several reasons.  First,
+          the gimplification process might need to create temporaries of this
+          type and the gimplifier ICEs on such attempts; that's why the flag
+          is now set on the function type instead.  Second, the middle-end
+          now also relies on a different attribute, DECL_BY_REFERENCE on the
+          RESULT_DECL, and expects the by-invisible-reference-ness to be made
+          explicit in the function body.  */
+       else if (kind == E_Function && Mechanism (gnat_entity) == By_Reference)
+         return_by_invisi_ref_p = true;
+
+       /* If we are supposed to return an unconstrained array, actually return
+          a fat pointer and make a note of that.  */
        else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
          {
            gnu_return_type = TREE_TYPE (gnu_return_type);
-           returns_unconstrained = true;
+           return_unconstrained_p = true;
          }
 
        /* If the type requires a transient scope, the result is allocated
@@ -3901,7 +3934,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        else if (Requires_Transient_Scope (Etype (gnat_entity)))
          {
            gnu_return_type = build_pointer_type (gnu_return_type);
-           returns_unconstrained = true;
+           return_unconstrained_p = true;
          }
 
        /* If the type is a padded type and the underlying type would not
@@ -3913,20 +3946,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                     || Has_Foreign_Convention (gnat_entity)))
          gnu_return_type = TREE_TYPE (TYPE_FIELDS (gnu_return_type));
 
-       /* If the return type has a non-constant size, we convert the function
-          into a procedure and its caller will pass a pointer to an object as
-          the first parameter when we call the function.  This can happen for
-          an unconstrained type with a maximum size or a constrained type with
-          a size not known at compile time.  */
-       if (TYPE_SIZE_UNIT (gnu_return_type)
-           && !TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type)))
+       /* If the return type is unconstrained, that means it must have a
+          maximum size.  Use the padded type as the effective return type.
+          And ensure the function uses the target's by-invisible-reference
+          mechanism to avoid copying too much data when it returns.  */
+       if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
          {
-           returns_by_target_ptr = true;
-           gnu_param_list
-             = create_param_decl (get_identifier ("TARGET"),
-                                  build_reference_type (gnu_return_type),
-                                  true);
-           gnu_return_type = void_type_node;
+           gnu_return_type
+             = maybe_pad_type (gnu_return_type,
+                               max_size (TYPE_SIZE (gnu_return_type), true),
+                               0, gnat_entity, false, false, false, true);
+           return_by_invisi_ref_p = true;
          }
 
        /* If the return type has a size that overflows, we cannot have
@@ -4056,6 +4086,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                    gcc_assert (TREE_CODE (gnu_return_type) == VOID_TYPE);
                    gnu_return_type = make_node (RECORD_TYPE);
                    TYPE_NAME (gnu_return_type) = get_identifier ("RETURN");
+                   /* Set a default alignment to speed up accesses.  */
+                   TYPE_ALIGN (gnu_return_type)
+                     = get_mode_alignment (ptr_mode);
                    has_copy_in_out = true;
                  }
 
@@ -4065,8 +4098,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                               &DECL_SOURCE_LOCATION (gnu_field));
                TREE_CHAIN (gnu_field) = gnu_field_list;
                gnu_field_list = gnu_field;
-               gnu_return_list = tree_cons (gnu_field, gnu_param,
-                                            gnu_return_list);
+               gnu_cico_list
+                 = tree_cons (gnu_field, gnu_param, gnu_cico_list);
              }
          }
 
@@ -4074,13 +4107,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           stubbed since structures are incomplete for the back-end.  */
        if (gnu_field_list && Convention (gnat_entity) != Convention_Stubbed)
          finish_record_type (gnu_return_type, nreverse (gnu_field_list),
-                             0, false);
+                             0, debug_info_p);
 
        /* If we have a CICO list but it has only one entry, we convert
           this function into a function that simply returns that one
           object.  */
-       if (list_length (gnu_return_list) == 1)
-         gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list));
+       if (list_length (gnu_cico_list) == 1)
+         gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list));
 
        if (Has_Stdcall_Convention (gnat_entity))
          prepend_one_attribute_to
@@ -4105,22 +4138,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        gnu_param_list = nreverse (gnu_param_list);
        if (has_stub)
          gnu_stub_param_list = nreverse (gnu_stub_param_list);
-       gnu_return_list = nreverse (gnu_return_list);
+       gnu_cico_list = nreverse (gnu_cico_list);
 
        if (Ekind (gnat_entity) == E_Function)
-         Set_Mechanism (gnat_entity,
-                        (returns_by_ref || returns_unconstrained
-                         ? By_Reference : By_Copy));
+         Set_Mechanism (gnat_entity, return_unconstrained_p
+                                     || return_by_direct_ref_p
+                                     || return_by_invisi_ref_p
+                                     ? By_Reference : By_Copy);
        gnu_type
          = create_subprog_type (gnu_return_type, gnu_param_list,
-                                gnu_return_list, returns_unconstrained,
-                                returns_by_ref, returns_by_target_ptr);
+                                gnu_cico_list, return_unconstrained_p,
+                                return_by_direct_ref_p,
+                                return_by_invisi_ref_p);
 
        if (has_stub)
          gnu_stub_type
            = create_subprog_type (gnu_return_type, gnu_stub_param_list,
-                                  gnu_return_list, returns_unconstrained,
-                                  returns_by_ref, returns_by_target_ptr);
+                                  gnu_cico_list, return_unconstrained_p,
+                                  return_by_direct_ref_p,
+                                  return_by_invisi_ref_p);
 
        /* A subprogram (something that doesn't return anything) shouldn't
           be considered const since there would be no reason for such a
@@ -4360,8 +4396,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          || Is_Class_Wide_Equivalent_Type (gnat_entity))
        TYPE_ALIGN_OK (gnu_type) = 1;
 
-      if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity))
-       TYPE_BY_REFERENCE_P (gnu_type) = 1;
+      /* If the type is passed by reference, objects of this type must be
+        fully addressable and cannot be copied.  */
+      if (Is_By_Reference_Type (gnat_entity))
+       TREE_ADDRESSABLE (gnu_type) = 1;
 
       /* ??? Don't set the size for a String_Literal since it is either
         confirming or we don't handle it properly (if the low bound is
@@ -4965,9 +5003,7 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity)
       break;
 
     case E_Class_Wide_Type:
-      gnat_equiv = ((Present (Equivalent_Type (gnat_entity)))
-                   ? Equivalent_Type (gnat_entity)
-                   : Root_Type (gnat_entity));
+      gnat_equiv = Root_Type (gnat_entity);
       break;
 
     case E_Task_Type:
@@ -5371,6 +5407,20 @@ cannot_be_superflat_p (Node_Id gnat_range)
 
   return (tree_int_cst_lt (gnu_hb, gnu_lb) == 0);
 }
+
+/* Return true if GNU_EXPR is (essentially) the address of a CONSTRUCTOR.  */
+
+static bool
+constructor_address_p (tree gnu_expr)
+{
+  while (TREE_CODE (gnu_expr) == NOP_EXPR
+        || TREE_CODE (gnu_expr) == CONVERT_EXPR
+        || TREE_CODE (gnu_expr) == NON_LVALUE_EXPR)
+    gnu_expr = TREE_OPERAND (gnu_expr, 0);
+
+  return (TREE_CODE (gnu_expr) == ADDR_EXPR
+         && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR);
+}
 \f
 /* Given GNAT_ENTITY, elaborate all expressions that are required to
    be elaborated at the point of its definition, but do nothing else.  */
@@ -5701,31 +5751,6 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
       }
 }
 \f
-/* Called when we need to protect a variable object using a SAVE_EXPR.  */
-
-tree
-maybe_variable (tree gnu_operand)
-{
-  if (TREE_CONSTANT (gnu_operand)
-      || TREE_READONLY (gnu_operand)
-      || TREE_CODE (gnu_operand) == SAVE_EXPR
-      || TREE_CODE (gnu_operand) == NULL_EXPR)
-    return gnu_operand;
-
-  if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF)
-    {
-      tree gnu_result
-       = build1 (UNCONSTRAINED_ARRAY_REF, TREE_TYPE (gnu_operand),
-                 variable_size (TREE_OPERAND (gnu_operand, 0)));
-
-      TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result)
-       = TYPE_READONLY (TREE_TYPE (TREE_TYPE (gnu_operand)));
-      return gnu_result;
-    }
-
-  return variable_size (gnu_operand);
-}
-\f
 /* Given a GNAT tree GNAT_EXPR, for an expression which is a value within a
    type definition (either a bound or a discriminant value) for GNAT_ENTITY,
    return the GCC tree to use for that expression.  GNU_NAME is the suffix
@@ -5828,7 +5853,7 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
   if (expr_global && expr_variable)
     return gnu_decl;
 
-  return expr_variable ? maybe_variable (gnu_expr) : gnu_expr;
+  return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr;
 }
 \f
 /* Create a record type that contains a SIZE bytes long field of TYPE with a
@@ -6032,10 +6057,7 @@ make_packable_type (tree type, bool in_record)
                                     !DECL_NONADDRESSABLE_P (old_field));
 
       DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
-      SET_DECL_ORIGINAL_FIELD
-       (new_field, (DECL_ORIGINAL_FIELD (old_field)
-                    ? DECL_ORIGINAL_FIELD (old_field) : old_field));
-
+      SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
       if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
        DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
 
@@ -6043,7 +6065,7 @@ make_packable_type (tree type, bool in_record)
       field_list = new_field;
     }
 
-  finish_record_type (new_type, nreverse (field_list), 2, true);
+  finish_record_type (new_type, nreverse (field_list), 2, false);
   relate_alias_sets (new_type, type, ALIAS_SET_COPY);
 
   /* If this is a padding record, we never want to make the size smaller
@@ -6200,8 +6222,8 @@ maybe_pad_type (tree type, tree size, unsigned int align,
                              orig_size, bitsize_zero_node, 1);
   DECL_INTERNAL_P (field) = 1;
 
-  /* Do not finalize it until after the auxiliary record is built.  */
-  finish_record_type (record, field, 1, true);
+  /* Do not emit debug info until after the auxiliary record is built.  */
+  finish_record_type (record, field, 1, false);
 
   /* Set the same size for its RM size if requested; otherwise reuse
      the RM size of the original type.  */
@@ -6210,9 +6232,9 @@ maybe_pad_type (tree type, tree size, unsigned int align,
   /* 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.  */
-  if (TYPE_NAME (record)
-      && AGGREGATE_TYPE_P (type)
-      && TREE_CODE (orig_size) != INTEGER_CST
+  if (TREE_CODE (orig_size) != INTEGER_CST
+      && TYPE_NAME (record)
+      && TYPE_NAME (type)
       && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
           && DECL_IGNORED_P (TYPE_NAME (type))))
     {
@@ -6232,7 +6254,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
                                             build_reference_type (type),
                                             marker, 0, NULL_TREE, NULL_TREE,
                                             0),
-                         0, false);
+                         0, true);
 
       add_parallel_type (TYPE_STUB_DECL (record), marker);
 
@@ -6722,35 +6744,34 @@ compare_field_bitpos (const PTR rt1, const PTR rt2)
    with Component_Alignment of Storage_Unit, -2 if this is for a record
    with a specified alignment.
 
-   DEFINITION is true if we are defining this record.
+   DEFINITION is true if we are defining this record type.
 
    P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field
    with a rep clause is to be added; in this case, that is all that should
    be done with such fields.
 
-   CANCEL_ALIGNMENT, if true, means the alignment should be zeroed before
-   laying out the record.  This means the alignment only serves to force
-   fields to be bitfields, but not require the record to be that aligned.
-   This is used for variants.
+   CANCEL_ALIGNMENT is true if the alignment should be zeroed before laying
+   out the record.  This means the alignment only serves to force fields to
+   be bitfields, but not to require the record to be that aligned.  This is
+   used for variants.
 
-   ALL_REP, if true, means a rep clause was found for all the fields.  This
-   simplifies the logic since we know we're not in the mixed case.
+   ALL_REP is true if a rep clause is present for all the fields.
 
-   DO_NOT_FINALIZE, if true, means that the record type is expected to be
-   modified afterwards so it will not be finalized here.
+   UNCHECKED_UNION is true if we are building this type for a record with a
+   Pragma Unchecked_Union.
 
-   UNCHECKED_UNION, if true, means that we are building a type for a record
-   with a Pragma Unchecked_Union.
+   DEBUG_INFO_P is true if we need to write debug information about the type.
+
+   MAYBE_UNUSED is true if this type may be unused in the end; this doesn't
+   mean that its contents may be unused as well, but only the container.  */
 
-   DEBUG_INFO_P, if true, means that we need to write debug information for
-   types that we may create in the process.  */
 
 static void
 components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
                      tree gnu_field_list, int packed, bool definition,
                      tree *p_gnu_rep_list, bool cancel_alignment,
-                     bool all_rep, bool do_not_finalize,
-                     bool unchecked_union, bool debug_info_p)
+                     bool all_rep, bool unchecked_union, bool debug_info_p,
+                     bool maybe_unused)
 {
   bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
   bool layout_with_rep = false;
@@ -6880,12 +6901,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
                = TYPE_SIZE_UNIT (gnu_record_type);
            }
 
-         /* Add the fields into the record type for the variant.  Note that we
-            defer finalizing it until after we are sure to really use it.  */
+         /* Add the fields into the record type for the variant.  Note that
+            we aren't sure to really use it at this point, see below.  */
          components_to_record (gnu_variant_type, Component_List (variant),
                                NULL_TREE, packed, definition,
                                &gnu_our_rep_list, !all_rep_and_size, all_rep,
-                               true, unchecked_union, debug_info_p);
+                               unchecked_union, debug_info_p, true);
 
          gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant));
 
@@ -6944,7 +6965,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
            }
 
          finish_record_type (gnu_union_type, nreverse (gnu_variant_list),
-                             all_rep_and_size ? 1 : 0, false);
+                             all_rep_and_size ? 1 : 0, debug_info_p);
 
          /* If GNU_UNION_TYPE is our record type, it means we must have an
             Unchecked_Union with no fields.  Verify that and, if so, just
@@ -7036,7 +7057,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
 
       if (gnu_field_list)
        {
-         finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, false);
+         finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, debug_info_p);
          gnu_field
            = create_field_decl (get_identifier ("REP"), gnu_rep_type,
                                 gnu_record_type, 0, NULL_TREE, NULL_TREE, 1);
@@ -7054,7 +7075,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
     TYPE_ALIGN (gnu_record_type) = 0;
 
   finish_record_type (gnu_record_type, nreverse (gnu_field_list),
-                     layout_with_rep ? 1 : 0, do_not_finalize);
+                     layout_with_rep ? 1 : 0, debug_info_p && !maybe_unused);
 }
 \f
 /* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be
@@ -7253,9 +7274,8 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
                   UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
 }
 
-/* Return first element of field list whose TREE_PURPOSE is ELEM or whose
-   DECL_ORIGINAL_FIELD of TREE_PURPOSE is ELEM.  Return NULL_TREE if there
-   is no such element in the list.  */
+/* Return first element of field list whose TREE_PURPOSE is the same as ELEM.
+   Return NULL_TREE if there is no such element in the list.  */
 
 static tree
 purpose_member_field (const_tree elem, tree list)
@@ -7263,7 +7283,7 @@ purpose_member_field (const_tree elem, tree list)
   while (list)
     {
       tree field = TREE_PURPOSE (list);
-      if (elem == field || elem == DECL_ORIGINAL_FIELD (field))
+      if (SAME_FIELD_P (field, elem))
        return list;
       list = TREE_CHAIN (list);
     }
@@ -8035,8 +8055,7 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type,
     }
 
   DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
-  t = DECL_ORIGINAL_FIELD (old_field);
-  SET_DECL_ORIGINAL_FIELD (new_field, t ? t : old_field);
+  SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
   DECL_DISCRIMINANT_NUMBER (new_field) = DECL_DISCRIMINANT_NUMBER (old_field);
   TREE_THIS_VOLATILE (new_field) = TREE_THIS_VOLATILE (old_field);
 
@@ -8143,12 +8162,10 @@ create_variant_part_from (tree old_variant_part, tree variant_list,
          field_list = new_variant_subpart;
        }
 
-      /* Finish up the new variant and create the field.  */
-      finish_record_type (new_variant, nreverse (field_list), 2, true);
+      /* Finish up the new variant and create the field.  No need for debug
+        info thanks to the XVS type.  */
+      finish_record_type (new_variant, nreverse (field_list), 2, false);
       compute_record_mode (new_variant);
-      rest_of_record_type_compilation (new_variant);
-
-      /* No need for debug info thanks to the XVS type.  */
       create_type_decl (TYPE_NAME (new_variant), new_variant, NULL,
                        true, false, Empty);
 
@@ -8162,12 +8179,10 @@ create_variant_part_from (tree old_variant_part, tree variant_list,
       union_field_list = new_field;
     }
 
-  /* Finish up the union type and create the variant part.  */
-  finish_record_type (new_union_type, union_field_list, 2, true);
+  /* Finish up the union type and create the variant part.  No need for debug
+     info thanks to the XVS type.  */
+  finish_record_type (new_union_type, union_field_list, 2, false);
   compute_record_mode (new_union_type);
-  rest_of_record_type_compilation (new_union_type);
-
-  /* No need for debug info thanks to the XVS type.  */
   create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL,
                    true, false, Empty);
 
@@ -8376,9 +8391,7 @@ substitute_in_type (tree t, tree f, tree r)
              }
 
            DECL_CONTEXT (new_field) = nt;
-           SET_DECL_ORIGINAL_FIELD (new_field,
-                                    (DECL_ORIGINAL_FIELD (field)
-                                     ? DECL_ORIGINAL_FIELD (field) : field));
+           SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field);
 
            TREE_CHAIN (new_field) = TYPE_FIELDS (nt);
            TYPE_FIELDS (nt) = new_field;