* doc/gnat_rm/implementation_defined_attributes.rst
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 16 May 2016 11:08:53 +0000 (11:08 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Mon, 16 May 2016 11:08:53 +0000 (11:08 +0000)
(Scalar_Storage_Order): Adjust restriction for packed array types.
* einfo.ads (Is_Bit_Packed_Array): Adjust description.
(Is_Packed): Likewise.
(Is_Packed_Array_Impl_Type): Likewise.
(Packed_Array_Impl_Type): Likewise.
* exp_ch4.adb (Expand_N_Indexed_Component): Do not do anything special
if the prefix is not a packed array implemented specially.
* exp_ch6.adb (Expand_Actuals): Expand indexed components only for
bit-packed array types.
* exp_pakd.adb (Install_PAT): Set Is_Packed_Array_Impl_Type flag on
the PAT before analyzing its declaration.
(Create_Packed_Array_Impl_Type): Remove redundant statements.
* freeze.adb (Check_Component_Storage_Order): Reject packed array
components only if they are bit packed.
(Freeze_Array_Type): Fix logic detecting bit packing and do not bit
pack for composite types whose size is multiple of a byte.
Create the implementation type for packed array types only when it is
needed, i.e. bit packing or packing because of holes in index types.
Make sure the Has_Non_Standard_Rep and Is_Packed flags agree.
* gcc-interface/gigi.h (make_packable_type): Add MAX_ALIGN parameter.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
Call maybe_pad_type instead of building the padding type manually.
(gnat_to_gnu_entity) <E_Array_Subtype>: Do not assert that
Packed_Array_Impl_Type is present for packed arrays.
(gnat_to_gnu_component_type): Also handle known alignment for packed
types by passing it to make_packable_type.
* gcc-interface/utils.c (make_packable_type): Add MAX_ALIGN parameter
and deal with it in the array case.  Adjust recursive call.  Simplify
computation of new size and cap the alignment to BIGGEST_ALIGNMENT.

From-SVN: r236279

gcc/ada/ChangeLog
gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
gcc/ada/einfo.ads
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch6.adb
gcc/ada/exp_pakd.adb
gcc/ada/freeze.adb
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/gigi.h
gcc/ada/gcc-interface/utils.c

index b8b14d2..2f5620f 100644 (file)
@@ -1,3 +1,36 @@
+2016-05-16  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * doc/gnat_rm/implementation_defined_attributes.rst
+       (Scalar_Storage_Order): Adjust restriction for packed array types.
+       * einfo.ads (Is_Bit_Packed_Array): Adjust description.
+       (Is_Packed): Likewise.
+       (Is_Packed_Array_Impl_Type): Likewise.
+       (Packed_Array_Impl_Type): Likewise.
+       * exp_ch4.adb (Expand_N_Indexed_Component): Do not do anything special
+       if the prefix is not a packed array implemented specially.
+       * exp_ch6.adb (Expand_Actuals): Expand indexed components only for
+       bit-packed array types.
+       * exp_pakd.adb (Install_PAT): Set Is_Packed_Array_Impl_Type flag on
+       the PAT before analyzing its declaration.
+       (Create_Packed_Array_Impl_Type): Remove redundant statements.
+       * freeze.adb (Check_Component_Storage_Order): Reject packed array
+       components only if they are bit packed.
+       (Freeze_Array_Type): Fix logic detecting bit packing and do not bit
+       pack for composite types whose size is multiple of a byte.
+       Create the implementation type for packed array types only when it is
+       needed, i.e. bit packing or packing because of holes in index types.
+       Make sure the Has_Non_Standard_Rep and Is_Packed flags agree.
+       * gcc-interface/gigi.h (make_packable_type): Add MAX_ALIGN parameter.
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
+       Call maybe_pad_type instead of building the padding type manually.
+       (gnat_to_gnu_entity) <E_Array_Subtype>: Do not assert that
+       Packed_Array_Impl_Type is present for packed arrays.
+       (gnat_to_gnu_component_type): Also handle known alignment for packed
+       types by passing it to make_packable_type.
+       * gcc-interface/utils.c (make_packable_type): Add MAX_ALIGN parameter
+       and deal with it in the array case.  Adjust recursive call.  Simplify
+       computation of new size and cap the alignment to BIGGEST_ALIGNMENT.
+
 2016-05-16  Thomas Quinot  <quinot@adacore.com>
 
        * freeze.adb (Check_Component_Storage_Order): Also get full view of
index 432db36..958ab24 100644 (file)
@@ -969,7 +969,7 @@ must have the same scalar storage order as the parent type.
 If a component of `T` is of a record or array type, then that type must
 also have a `Scalar_Storage_Order` attribute definition clause.
 
-A component of a record or array type that is a packed array, or that
+A component of a record or array type that is a bit-packed array, or that
 does not start on a byte boundary, must have the same scalar storage order
 as the enclosing record or array type.
 
index 901e2ef..69492fc 100644 (file)
@@ -2268,9 +2268,9 @@ package Einfo is
 --       is bit packed (i.e. the component size is known by the front end and
 --       is in the range 1-7, 9-15, 17-31, or 33-63). Is_Packed is always set
 --       if Is_Bit_Packed_Array is set, but it is possible for Is_Packed to be
---       set without Is_Bit_Packed_Array for the case of an array having one or
---       more index types that are enumeration types with non-standard
---       enumeration representations.
+--       set without Is_Bit_Packed_Array if the component size is not known by
+--       the front-end or for the case of an array having one or more index
+--       types that are enumeration types with non-standard representation.
 
 --    Is_Boolean_Type (synthesized)
 --       Applies to all entities, true for boolean types and subtypes,
@@ -2852,49 +2852,49 @@ package Einfo is
 
 --    Is_Packed (Flag51) [implementation base type only]
 --       Defined in all type entities. This flag is set only for record and
---       array types which have a packed representation. There are three
---       cases which cause packing:
+--       array types which have a packed representation. There are four cases
+--       which cause packing:
 --
---         1. Explicit use of pragma Pack for an array of package components
---         2. Explicit use of pragma Pack to pack a record
---         4. Setting Component_Size of an array to a bit-packable value
---         3. Indexing an array with a non-standard enumeration type.
+--         1. Explicit use of pragma Pack to pack a record.
+--         2. Explicit use of pragma Pack to pack an array.
+--         3. Setting Component_Size of an array to a packable value.
+--         4. Indexing an array with a non-standard enumeration type.
 --
---       For records, Is_Packed is always set if Has_Pragma_Pack is set,
---       and can also be set on its own in a derived type which inherited
---       its packed status.
---
---       For arrays, Is_Packed is set if an array is bit packed (i.e. the
---       component size is known at compile time and is 1-7, 9-15 or 17-31),
---       or if the array has one or more index types that are enumeration
---       types with non-standard representations (in GNAT, we store such
---       arrays compactly, using the Pos of the enumeration type value).
---
---       As for the case of records, Is_Packed can be set on its own for a
---       derived type, with the same dual before/after freeze meaning.
---       Is_Packed can also be set as the result of an explicit component
---       size clause that specifies an appropriate component size.
---
---       In the bit packed array case, Is_Bit_Packed_Array will be set in
---       the bit packed case once the array type is frozen.
+--       For records, Is_Packed is always set if Has_Pragma_Pack is set, and
+--       can also be set on its own in a derived type which inherited its
+--       packed status.
 --
+--       For arrays, Is_Packed is set if either Has_Pragma_Pack is set and the
+--       component size is either not known at compile time or known but not
+--       8/16/32/64 bits, or a Component_Size clause exists and the specified
+--       value is smaller than 64 bits but not 8/16/32, or if the array has one
+--       or more index types that are enumeration types with a non-standard
+--       representation (in GNAT, we store such arrays compactly, using the Pos
+--       of the enumeration type value). As for the case of records, Is_Packed
+--       can be set on its own for a derived type.
+
 --       Before an array type is frozen, Is_Packed will always be set if
 --       Has_Pragma_Pack is set. Before the freeze point, it is not possible
 --       to know the component size, since the component type is not frozen
 --       until the array type is frozen. Thus Is_Packed for an array type
 --       before it is frozen means that packed is required. Then if it turns
---       out that the component size is not suitable for bit packing, the
---       Is_Packed flag gets turned off.
+--       out that the component size doesn't require packing, the Is_Packed
+--       flag gets turned off.
 
+--       In the bit packed array case (i.e. component size is known at compile
+--       time and is 1-7, 9-15, 17-31 or 33-63), Is_Bit_Packed_Array will be
+--       set once the array type is frozen.
+--
 --    Is_Packed_Array (synth)
 --       Applies to all entities, true if entity is for a packed array.
 
 --    Is_Packed_Array_Impl_Type (Flag138)
 --       Defined in all entities. This flag is set on the entity for the type
---       used to implement a packed array (either a modular type, or a subtype
---       of Packed_Bytes{1,2,4} as appropriate). The flag is set if and only
+--       used to implement a packed array (either a modular type or a subtype
+--       of Packed_Bytes{1,2,4} in the bit packed array case, a regular array
+--       in the non-standard enumeration index case). It is set if and only
 --       if the type appears in the Packed_Array_Impl_Type field of some other
---       entity. It is used by the backend to activate the special processing
+--       entity. It is used by the back end to activate the special processing
 --       for such types (unchecked conversions that would not otherwise be
 --       allowed are allowed for such types). If Is_Packed_Array_Impl_Type is
 --       set in an entity, then the Original_Array_Type field of this entity
@@ -3698,16 +3698,17 @@ package Einfo is
 --       with formal packages. ???
 
 --    Packed_Array_Impl_Type (Node23)
---       Defined in array types and subtypes, including the string literal
---       subtype case, if the corresponding type is packed (either bit packed
---       or packed to eliminate holes in non-contiguous enumeration type index
---       types). References the type used to represent the packed array, which
---       is either a modular type for short static arrays, or an array of
---       System.Unsigned. Note that in some situations (internal types, and
---       references to fields of variant records), it is not always possible
---       to construct this type in advance of its use. If this field is empty,
---       then the necessary type is declared on the fly for each reference to
---       the array.
+--       Defined in array types and subtypes, except for the string literal
+--       subtype case, if the corresponding type is packed and implemented
+--       specially (either bit packed or packed to eliminate holes in the
+--       non-contiguous enumeration index types). References the type used to
+--       represent the packed array, which is either a modular type for short
+--       static arrays or an array of System.Unsigned in the bit packed case,
+--       or a regular array in the non-standard enumeration index case). Note
+--       that in some situations (internal types and references to fields of
+--       variant records), it is not always possible to construct this type in
+--       advance of its use. If this field is empty, then the necessary type
+--       is declared on the fly for each reference to the array.
 
 --    Parameter_Mode (synthesized)
 --       Applies to formal parameter entities. This is a synonym for Ekind,
index cb1c117..e6ea474 100644 (file)
@@ -6216,9 +6216,11 @@ package body Exp_Ch4 is
          Activate_Atomic_Synchronization (N);
       end if;
 
-      --  All done for the non-packed case
+      --  All done if the prefix is not a packed array implemented specially
 
-      if not Is_Packed (Etype (Prefix (N))) then
+      if not (Is_Packed (Etype (Prefix (N)))
+               and then Present (Packed_Array_Impl_Type (Etype (Prefix (N)))))
+      then
          return;
       end if;
 
index dbdd33d..9f7c1dc 100644 (file)
@@ -2038,7 +2038,7 @@ package body Exp_Ch6 is
          --  Processing for IN parameters
 
          else
-            --  For IN parameters is in the packed array case, we expand an
+            --  For IN parameters in the bit packed array case, we expand an
             --  indexed component (the circuit in Exp_Ch4 deliberately left
             --  indexed components appearing as actuals untouched, so that
             --  the special processing above for the OUT and IN OUT cases
@@ -2047,7 +2047,7 @@ package body Exp_Ch6 is
             --  easier simply to handle all cases here.)
 
             if Nkind (Actual) = N_Indexed_Component
-              and then Is_Packed (Etype (Prefix (Actual)))
+              and then Is_Bit_Packed_Array (Etype (Prefix (Actual)))
             then
                Reset_Packed_Prefix;
                Expand_Packed_Element_Reference (Actual);
index ea82596..0ec3ef4 100644 (file)
@@ -543,6 +543,7 @@ package body Exp_Pakd is
          end if;
 
          Set_Is_Itype (PAT, True);
+         Set_Is_Packed_Array_Impl_Type (PAT, True);
          Set_Packed_Array_Impl_Type (Typ, PAT);
          Analyze (Decl, Suppress => All_Checks);
 
@@ -569,7 +570,6 @@ package body Exp_Pakd is
          Init_Alignment                (PAT);
          Set_Parent                    (PAT, Empty);
          Set_Associated_Node_For_Itype (PAT, Typ);
-         Set_Is_Packed_Array_Impl_Type (PAT, True);
          Set_Original_Array_Type       (PAT, Typ);
 
          --  Propagate representation aspects
@@ -701,8 +701,6 @@ package body Exp_Pakd is
            Make_Defining_Identifier (Loc,
              Chars => New_External_Name (Chars (Typ), 'P'));
 
-         Set_Packed_Array_Impl_Type (Typ, PAT);
-
          declare
             Indexes   : constant List_Id := New_List;
             Indx      : Node_Id;
@@ -798,9 +796,6 @@ package body Exp_Pakd is
                 Type_Definition     => Typedef);
          end;
 
-         --  Set type as packed array type and install it
-
-         Set_Is_Packed_Array_Impl_Type (PAT);
          Install_PAT;
          return;
 
@@ -819,13 +814,13 @@ package body Exp_Pakd is
            Make_Defining_Identifier (Loc,
              Chars => Make_Packed_Array_Impl_Type_Name (Typ, Csize));
 
-         Set_Packed_Array_Impl_Type (Typ, PAT);
          Set_PB_Type;
 
          Decl :=
            Make_Subtype_Declaration (Loc,
              Defining_Identifier => PAT,
                Subtype_Indication => New_Occurrence_Of (PB_Type, Loc));
+
          Install_PAT;
          return;
 
@@ -843,8 +838,6 @@ package body Exp_Pakd is
            Make_Defining_Identifier (Loc,
              Chars => Make_Packed_Array_Impl_Type_Name (Typ, Csize));
 
-         Set_Packed_Array_Impl_Type (Typ, PAT);
-
          --  Build an expression for the length of the array in bits.
          --  This is the product of the length of each of the dimensions
 
index c040f07..8b74f86 100644 (file)
@@ -1254,24 +1254,24 @@ package body Freeze is
             end if;
 
          --  If component and composite SSO differs, check that component
-         --  falls on byte boundaries and isn't packed.
+         --  falls on byte boundaries and isn't bit packed.
 
          elsif Comp_SSO_Differs then
 
             --  Component SSO differs from enclosing composite:
 
-            --  Reject if component is a packed array, as it may be represented
+            --  Reject if component is a bit-packed array, as it is represented
             --  as a scalar internally.
 
-            if Is_Packed_Array (Comp_Base) then
+            if Is_Bit_Packed_Array (Comp_Base) then
                Error_Msg_N
                  ("type of packed component must have same scalar storage "
                   & "order as enclosing composite", Err_Node);
 
-            --  Reject if composite is a packed array, as it may be rewritten
+            --  Reject if composite is a bit-packed array, as it is rewritten
             --  into an array of scalars.
 
-            elsif Is_Packed_Array (Encl_Base) then
+            elsif Is_Bit_Packed_Array (Encl_Base) then
                Error_Msg_N
                  ("type of packed array must have same scalar storage order "
                   & "as component", Err_Node);
@@ -2386,7 +2386,7 @@ package body Freeze is
                   end if;
                end if;
 
-               --  Case of component size that may result in packing
+               --  Case of component size that may result in bit packing
 
                if 1 <= Csiz and then Csiz <= 64 then
                   declare
@@ -2451,44 +2451,58 @@ package body Freeze is
                         end if;
                      end if;
 
-                     --  Actual packing is not needed for 8, 16, 32, 64. Also
-                     --  not needed for multiples of 8 if alignment is 1, and
-                     --  for multiples of 16 (i.e. only 48) if alignment is 2.
+                     --  Bit packing is never needed for 8, 16, 32, 64
 
                      if        Csiz = 8
                        or else Csiz = 16
                        or else Csiz = 32
                        or else Csiz = 64
-                       or else (Csiz mod 8 = 0 and then Alignment (Ctyp) = 1)
-                       or else (Csiz = 48 and then Alignment (Ctyp) = 2)
                      then
-                        --  Here the array was requested to be packed, but
-                        --  the packing request had no effect, so Is_Packed
-                        --  is reset.
-
-                        --  Note: semantically this means that we lose track
-                        --  of the fact that a derived type inherited a pragma
-                        --  Pack that was non- effective, but that seems fine.
-
-                        --  We regard a Pack pragma as a request to set a
-                        --  representation characteristic, and this request
-                        --  may be ignored.
-
-                        Set_Is_Packed           (Base_Type (Arr), False);
-                        Set_Is_Bit_Packed_Array (Base_Type (Arr), False);
+                        --  If the Esize of the component is known and equal to
+                        --  the component size then even packing is not needed.
 
                         if Known_Static_Esize (Component_Type (Arr))
                           and then Esize (Component_Type (Arr)) = Csiz
                         then
+                           --  Here the array was requested to be packed, but
+                           --  the packing request had no effect whatsoever,
+                           --  so flag Is_Packed is reset.
+
+                           --  Note: semantically this means that we lose track
+                           --  of the fact that a derived type inherited pragma
+                           --  Pack that was non-effective, but that is fine.
+
+                           --  We regard a Pack pragma as a request to set a
+                           --  representation characteristic, and this request
+                           --  may be ignored.
+
+                           Set_Is_Packed            (Base_Type (Arr), False);
                            Set_Has_Non_Standard_Rep (Base_Type (Arr), False);
+                        else
+                           Set_Is_Packed            (Base_Type (Arr), True);
+                           Set_Has_Non_Standard_Rep (Base_Type (Arr), True);
                         end if;
 
-                        --  In all other cases, packing is indeed needed
+                        Set_Is_Bit_Packed_Array (Base_Type (Arr), False);
+
+                     --  Bit packing is not needed for multiples of the storage
+                     --  unit if the type is composite because the back end can
+                     --  byte pack composite types.
+
+                     elsif Csiz mod System_Storage_Unit = 0
+                       and then Is_Composite_Type (Ctyp)
+                     then
+
+                        Set_Is_Packed            (Base_Type (Arr), True);
+                        Set_Has_Non_Standard_Rep (Base_Type (Arr), True);
+                        Set_Is_Bit_Packed_Array  (Base_Type (Arr), False);
+
+                     --  In all other cases, bit packing is needed
 
                      else
+                        Set_Is_Packed            (Base_Type (Arr), True);
                         Set_Has_Non_Standard_Rep (Base_Type (Arr), True);
                         Set_Is_Bit_Packed_Array  (Base_Type (Arr), True);
-                        Set_Is_Packed            (Base_Type (Arr), True);
                      end if;
                   end;
                end if;
@@ -2780,12 +2794,14 @@ package body Freeze is
 
          Set_Component_Alignment_If_Not_Set (Arr);
 
-         --  If the array is packed, we must create the packed array type to be
-         --  used to actually implement the type. This is only needed for real
-         --  array types (not for string literal types, since they are present
-         --  only for the front end).
+         --  If the array is packed and bit packed or packed to eliminate holes
+         --  in the non-contiguous enumeration index types, we must create the
+         --  packed array type to be used to actually implement the type. This
+         --  is only needed for real array types (not for string literal types,
+         --  since they are present only for the front end).
 
          if Is_Packed (Arr)
+           and then (Is_Bit_Packed_Array (Arr) or else Non_Standard_Enum)
            and then Ekind (Arr) /= E_String_Literal_Subtype
          then
             Create_Packed_Array_Impl_Type (Arr);
index f3d2b52..8f2be23 100644 (file)
@@ -1961,47 +1961,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 
       /* 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 misalign the
-        latter; we reuse the padding machinery for this purpose.  Note that,
-        even if the record type is marked as packed because of misalignment,
-        we don't pack the field so as to give it the size of the type.  */
+        latter; we reuse the padding machinery for this purpose.  */
       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));
+         tree gnu_size = UI_To_gnu (RM_Size (gnat_entity), bitsizetype);
 
-         /* Create a stripped-down declaration, mainly for debugging.  */
-         create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
-                           gnat_entity);
+         /* Set the RM size before wrapping the type.  */
+         SET_TYPE_RM_SIZE (gnu_type, gnu_size);
 
-         /* Now save it and build the enclosing record type.  */
-         gnu_field_type = gnu_type;
+         gnu_type
+           = maybe_pad_type (gnu_type, TYPE_SIZE (gnu_type), align,
+                             gnat_entity, false, true, definition, false);
 
-         gnu_type = make_node (RECORD_TYPE);
-         TYPE_PADDING_P (gnu_type) = 1;
-         TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD");
          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));
-         SET_TYPE_ALIGN (gnu_type, align);
-         relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
-
-         /* Don't declare the field as addressable since we won't be taking
-            its address and this would prevent create_field_decl from making
-            a bitfield.  */
-         gnu_field
-           = create_field_decl (get_identifier ("F"), gnu_field_type,
-                                gnu_type, TYPE_SIZE (gnu_field_type),
-                                bitsize_zero_node, 0, 0);
-
-         finish_record_type (gnu_type, gnu_field, 2, false);
-         compute_record_mode (gnu_type);
-
-         if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
-           SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type);
+         SET_TYPE_ADA_SIZE (gnu_type, gnu_size);
        }
 
       break;
@@ -2909,10 +2882,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                    TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner;
                }
            }
-
-         else
-           /* Abort if packed array with no Packed_Array_Impl_Type.  */
-           gcc_assert (!Is_Packed (gnat_entity));
        }
       break;
 
@@ -5234,6 +5203,16 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
   const Entity_Id gnat_type = Component_Type (gnat_array);
   tree gnu_type = gnat_to_gnu_type (gnat_type);
   tree gnu_comp_size;
+  unsigned int max_align;
+
+  /* If an alignment is specified, use it as a cap on the component type
+     so that it can be honored for the whole type.  But ignore it for the
+     original type of packed array types.  */
+  if (No (Packed_Array_Impl_Type (gnat_array))
+      && Known_Alignment (gnat_array))
+    max_align = validate_alignment (Alignment (gnat_array), gnat_array, 0);
+  else
+    max_align = 0;
 
   /* Try to get a smaller form of the component if needed.  */
   if ((Is_Packed (gnat_array) || Has_Component_Size_Clause (gnat_array))
@@ -5243,7 +5222,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
       && RECORD_OR_UNION_TYPE_P (gnu_type)
       && !TYPE_FAT_POINTER_P (gnu_type)
       && tree_fits_uhwi_p (TYPE_SIZE (gnu_type)))
-    gnu_type = make_packable_type (gnu_type, false);
+    gnu_type = make_packable_type (gnu_type, false, max_align);
 
   if (Has_Atomic_Components (gnat_array))
     check_ok_for_atomic_type (gnu_type, gnat_array, true);
@@ -5276,16 +5255,6 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
   if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_array))
     {
       tree orig_type = gnu_type;
-      unsigned int max_align;
-
-      /* If an alignment is specified, use it as a cap on the component type
-        so that it can be honored for the whole type.  But ignore it for the
-        original type of packed array types.  */
-      if (No (Packed_Array_Impl_Type (gnat_array))
-         && Known_Alignment (gnat_array))
-       max_align = validate_alignment (Alignment (gnat_array), gnat_array, 0);
-      else
-       max_align = 0;
 
       gnu_type = make_type_from_size (gnu_type, gnu_comp_size, false);
       if (max_align > 0 && TYPE_ALIGN (gnu_type) > max_align)
index 9cc744b..099923d 100644 (file)
@@ -129,9 +129,11 @@ extern tree make_aligning_type (tree type, unsigned int align, tree size,
    as the field type of a packed record if IN_RECORD is true, or as the
    component type of a packed array if IN_RECORD is false.  See if we can
    rewrite it either as a type that has a non-BLKmode, which we can pack
-   tighter in the packed record case, or as a smaller type.  If so, return
-   the new type.  If not, return the original type.  */
-extern tree make_packable_type (tree type, bool in_record);
+   tighter in the packed record case, or as a smaller type with at most
+   MAX_ALIGN alignment if the value is non-zero.  If so, return the new
+   type; if not, return the original type.  */
+extern tree make_packable_type (tree type, bool in_record,
+                               unsigned int max_align = 0);
 
 /* Given a type TYPE, return a new type whose size is appropriate for SIZE.
    If TYPE is the best type, return it.  Otherwise, make a new type.  We
index 8c36149..7494065 100644 (file)
@@ -937,23 +937,24 @@ make_aligning_type (tree type, unsigned int align, tree size,
 /* TYPE is a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE that is being used
    as the field type of a packed record if IN_RECORD is true, or as the
    component type of a packed array if IN_RECORD is false.  See if we can
-   rewrite it either as a type that has a non-BLKmode, which we can pack
-   tighter in the packed record case, or as a smaller type.  If so, return
-   the new type.  If not, return the original type.  */
+   rewrite it either as a type that has non-BLKmode, which we can pack
+   tighter in the packed record case, or as a smaller type with at most
+   MAX_ALIGN alignment if the value is non-zero.  If so, return the new
+   type; if not, return the original type.  */
 
 tree
-make_packable_type (tree type, bool in_record)
+make_packable_type (tree type, bool in_record, unsigned int max_align)
 {
   unsigned HOST_WIDE_INT size = tree_to_uhwi (TYPE_SIZE (type));
   unsigned HOST_WIDE_INT new_size;
-  tree new_type, old_field, field_list = NULL_TREE;
-  unsigned int align;
+  unsigned int align = TYPE_ALIGN (type);
+  unsigned int new_align;
 
   /* No point in doing anything if the size is zero.  */
   if (size == 0)
     return type;
 
-  new_type = make_node (TREE_CODE (type));
+  tree new_type = make_node (TREE_CODE (type));
 
   /* Copy the name and flags from the old type to that of the new.
      Note that we rely on the pointer equality created here for
@@ -970,49 +971,50 @@ make_packable_type (tree type, bool in_record)
      type with BLKmode.  */
   if (in_record && size <= MAX_FIXED_MODE_SIZE)
     {
-      align = ceil_pow2 (size);
-      SET_TYPE_ALIGN (new_type, align);
-      new_size = (size + align - 1) & -align;
+      new_size = ceil_pow2 (size);
+      new_align = MIN (new_size, BIGGEST_ALIGNMENT);
+      SET_TYPE_ALIGN (new_type, new_align);
     }
   else
     {
-      unsigned HOST_WIDE_INT align;
-
       /* 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)))
        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.  */
+        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 = (new_size + BITS_PER_UNIT - 1) & -BITS_PER_UNIT;
-      if (new_size == size)
+      if (new_size == size && (max_align == 0 || align <= max_align))
        return type;
 
-      align = new_size & -new_size;
-      SET_TYPE_ALIGN (new_type, MIN (TYPE_ALIGN (type), align));
+      new_align = MIN (new_size & -new_size, BIGGEST_ALIGNMENT);
+      if (max_align > 0 && new_align > max_align)
+       new_align = max_align;
+      SET_TYPE_ALIGN (new_type, MIN (align, new_align));
     }
 
   TYPE_USER_ALIGN (new_type) = 1;
 
   /* Now copy the fields, keeping the position and size as we don't want
      to change the layout by propagating the packedness downwards.  */
-  for (old_field = TYPE_FIELDS (type); old_field;
-       old_field = DECL_CHAIN (old_field))
+  tree new_field_list = NULL_TREE;
+  for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
     {
-      tree new_field_type = TREE_TYPE (old_field);
+      tree new_field_type = TREE_TYPE (field);
       tree new_field, new_size;
 
       if (RECORD_OR_UNION_TYPE_P (new_field_type)
          && !TYPE_FAT_POINTER_P (new_field_type)
          && tree_fits_uhwi_p (TYPE_SIZE (new_field_type)))
-       new_field_type = make_packable_type (new_field_type, true);
+       new_field_type = make_packable_type (new_field_type, true, max_align);
 
       /* However, for the last field in a not already packed record type
         that is of an aggregate type, we need to use the RM size in the
         packable version of the record type, see finish_record_type.  */
-      if (!DECL_CHAIN (old_field)
+      if (!DECL_CHAIN (field)
          && !TYPE_PACKED (type)
          && RECORD_OR_UNION_TYPE_P (new_field_type)
          && !TYPE_FAT_POINTER_P (new_field_type)
@@ -1020,24 +1022,24 @@ make_packable_type (tree type, bool in_record)
          && TYPE_ADA_SIZE (new_field_type))
        new_size = TYPE_ADA_SIZE (new_field_type);
       else
-       new_size = DECL_SIZE (old_field);
+       new_size = DECL_SIZE (field);
 
       new_field
-       = create_field_decl (DECL_NAME (old_field), new_field_type, new_type,
-                            new_size, bit_position (old_field),
+       = create_field_decl (DECL_NAME (field), new_field_type, new_type,
+                            new_size, bit_position (field),
                             TYPE_PACKED (type),
-                            !DECL_NONADDRESSABLE_P (old_field));
+                            !DECL_NONADDRESSABLE_P (field));
 
-      DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
-      SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
+      DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (field);
+      SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field);
       if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
-       DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
+       DECL_QUALIFIER (new_field) = DECL_QUALIFIER (field);
 
-      DECL_CHAIN (new_field) = field_list;
-      field_list = new_field;
+      DECL_CHAIN (new_field) = new_field_list;
+      new_field_list = new_field;
     }
 
-  finish_record_type (new_type, nreverse (field_list), 2, false);
+  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),
@@ -1054,8 +1056,7 @@ make_packable_type (tree type, bool in_record)
   else
     {
       TYPE_SIZE (new_type) = bitsize_int (new_size);
-      TYPE_SIZE_UNIT (new_type)
-       = size_int ((new_size + BITS_PER_UNIT - 1) / BITS_PER_UNIT);
+      TYPE_SIZE_UNIT (new_type) = size_int (new_size / BITS_PER_UNIT);
     }
 
   if (!TYPE_CONTAINS_TEMPLATE_P (type))
@@ -1069,8 +1070,8 @@ make_packable_type (tree type, bool in_record)
     SET_TYPE_MODE (new_type,
                   mode_for_size_tree (TYPE_SIZE (new_type), MODE_INT, 1));
 
-  /* If neither the mode nor the size has shrunk, return the old type.  */
-  if (TYPE_MODE (new_type) == BLKmode && new_size >= size)
+  /* If neither mode nor size nor alignment shrunk, return the old type.  */
+  if (TYPE_MODE (new_type) == BLKmode && new_size >= size && max_align == 0)
     return type;
 
   return new_type;