OSDN Git Service

* tree.h (TREE_ADDRESSABLE): Document its effect for function types.
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / decl.c
index cd13e21..25b4c07 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- *
@@ -1366,7 +1366,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            tree gnu_corr_var
              = create_true_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
                                      gnu_expr, true, Is_Public (gnat_entity),
-                                     !definition, static_p, NULL,
+                                     !definition, static_p, attr_list,
                                      gnat_entity);
 
            SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
@@ -1416,30 +1416,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 +1451,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 +1593,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 +1617,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 +1845,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 +1954,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 +2415,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,8 +2889,8 @@ 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
@@ -3188,9 +3210,10 @@ 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)
@@ -3225,7 +3248,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 +3482,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 +3799,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 +3831,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 +3885,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 +3926,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 +3938,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 +4078,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 +4090,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 +4099,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 +4130,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
@@ -4965,9 +4993,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:
@@ -6043,7 +6069,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
@@ -6052,6 +6078,7 @@ make_packable_type (tree type, bool in_record)
     {
       TYPE_SIZE (new_type) = TYPE_SIZE (type);
       TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type);
+      new_size = size;
     }
   else
     {
@@ -6199,8 +6226,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.  */
@@ -6209,9 +6236,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))))
     {
@@ -6231,7 +6258,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);
 
@@ -6449,67 +6476,44 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   else
     gnu_size = NULL_TREE;
 
-  /* If we have a specified size that's smaller than that of the field type,
-     or a position is specified, and the field type is a record, see if we can
-     get either an integral mode form of the type or a smaller form.  If we
-     can, show a size was specified for the field if there wasn't one already,
-     so we know to make this a bitfield and avoid making things wider.
+  /* If we have a specified size that is smaller than that of the field's type,
+     or a position is specified, and the field's type is a record that doesn't
+     require strict alignment, see if we can get either an integral mode form
+     of the type or a smaller form.  If we can, show a size was specified for
+     the field if there wasn't one already, so we know to make this a bitfield
+     and avoid making things wider.
 
-     Doing this is first useful if the record is packed because we may then
-     place the field at a non-byte-aligned position and so achieve tighter
-     packing.
+     Changing to an integral mode form is useful when the record is packed as
+     we can then place the field at a non-byte-aligned position and so achieve
+     tighter packing.  This is in addition required if the field shares a byte
+     with another field and the front-end lets the back-end handle the access
+     to the field, because GCC cannot handle non-byte-aligned BLKmode fields.
 
-     This is in addition *required* if the field shares a byte with another
-     field and the front-end lets the back-end handle the references, because
-     GCC does not handle BLKmode bitfields properly.
+     Changing to a smaller form is required if the specified size is smaller
+     than that of the field's type and the type contains sub-fields that are
+     padded, in order to avoid generating accesses to these sub-fields that
+     are wider than the field.
 
      We avoid the transformation if it is not required or potentially useful,
      as it might entail an increase of the field's alignment and have ripple
      effects on the outer record type.  A typical case is a field known to be
-     byte aligned and not to share a byte with another field.
-
-     Besides, we don't even look the possibility of a transformation in cases
-     known to be in error already, for instance when an invalid size results
-     from a component clause.  */
-
-  if (TREE_CODE (gnu_field_type) == RECORD_TYPE
+     byte-aligned and not to share a byte with another field.  */
+  if (!needs_strict_alignment
+      && TREE_CODE (gnu_field_type) == RECORD_TYPE
       && !TYPE_FAT_POINTER_P (gnu_field_type)
       && host_integerp (TYPE_SIZE (gnu_field_type), 1)
       && (packed == 1
          || (gnu_size
              && (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))
-                 || Present (Component_Clause (gnat_field))))))
+                 || (Present (Component_Clause (gnat_field))
+                     && !(UI_To_Int (Component_Bit_Offset (gnat_field))
+                          % BITS_PER_UNIT == 0
+                          && value_factor_p (gnu_size, BITS_PER_UNIT)))))))
     {
-      /* See what the alternate type and size would be.  */
       tree gnu_packable_type = make_packable_type (gnu_field_type, true);
-
-      bool has_byte_aligned_clause
-       = Present (Component_Clause (gnat_field))
-         && (UI_To_Int (Component_Bit_Offset (gnat_field))
-             % BITS_PER_UNIT == 0);
-
-      /* Compute whether we should avoid the substitution.  */
-      bool reject
-       /* There is no point substituting if there is no change...  */
-       = (gnu_packable_type == gnu_field_type)
-        /* ... nor when the field is known to be byte aligned and not to
-           share a byte with another field.  */
-         || (has_byte_aligned_clause
-             && value_factor_p (gnu_size, BITS_PER_UNIT))
-        /* The size of an aliased field must be an exact multiple of the
-           type's alignment, which the substitution might increase.  Reject
-           substitutions that would so invalidate a component clause when the
-           specified position is byte aligned, as the change would have no
-           real benefit from the packing standpoint anyway.  */
-         || (Is_Aliased (gnat_field)
-             && has_byte_aligned_clause
-             && !value_factor_p (gnu_size, TYPE_ALIGN (gnu_packable_type)));
-
-      /* Substitute unless told otherwise.  */
-      if (!reject)
+      if (gnu_packable_type != gnu_field_type)
        {
          gnu_field_type = gnu_packable_type;
-
          if (!gnu_size)
            gnu_size = rm_size (gnu_field_type);
        }
@@ -6744,35 +6748,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 is true if a rep clause is present for all the fields.
 
-   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.
+   UNCHECKED_UNION is true if we are building this type for a record with a
+   Pragma Unchecked_Union.
 
-   DO_NOT_FINALIZE, if true, means that the record type is expected to be
-   modified afterwards so it will not be finalized here.
+   DEBUG_INFO_P is true if we need to write debug information about the type.
 
-   UNCHECKED_UNION, if true, means that we are building a type for a record
-   with a Pragma Unchecked_Union.
+   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;
@@ -6902,12 +6905,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));
 
@@ -6966,7 +6969,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
@@ -7058,7 +7061,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);
@@ -7076,7 +7079,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
@@ -7737,6 +7740,10 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
       biased_p = (TREE_CODE (type) == INTEGER_TYPE
                  && TYPE_BIASED_REPRESENTATION_P (type));
 
+      /* Integer types with precision 0 are forbidden.  */
+      if (size == 0)
+       size = 1;
+
       /* Only do something if the type is not a packed array type and
         doesn't already have the proper size.  */
       if (TYPE_PACKED_ARRAY_TYPE_P (type)
@@ -8161,12 +8168,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);
 
@@ -8180,12 +8185,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);