decl.c (MAX_FIXED_MODE_SIZE): Define if not already defined.
authorEric Botcazou <ebotcazou@adacore.com>
Fri, 7 Mar 2008 17:12:28 +0000 (17:12 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Fri, 7 Mar 2008 17:12:28 +0000 (17:12 +0000)
* decl.c (MAX_FIXED_MODE_SIZE): Define if not already defined.
(gnat_to_gnu_entity) <E_Record_Type>: Try to get a smaller form of
the component for packing, if possible, as well as if a component
size clause is specified.
<E_Record_Subtype>: For an array type used to implement a packed
array, get the component type from the original array type.
Try to get a smaller form of the component for packing, if possible,
as well as if a component size clause is specified.
(round_up_to_align): New function.
(make_packable_type): Add in_record parameter.
For a padding record, preserve the size.  If not in_record and the
size is too large for an integral mode, attempt to shrink the size
by lowering the alignment.
Ditch the padding bits of the last component.
Compute sizes and mode manually, and propagate the RM size.
Return a BLKmode record type if its size has shrunk.
(maybe_pad_type): Use MAX_FIXED_MODE_SIZE instead of BIGGEST_ALIGNMENT.
Use Original_Array_Type to retrieve the type in case of an error.
Adjust call to make_packable_type.
(gnat_to_gnu_field): Likewise.
(concat_id_with_name): Minor tweak.
* trans.c (larger_record_type_p): New predicate.
(call_to_gnu): Compute the nominal type of the object only if the
parameter is by-reference.  Do the conversion actual type -> nominal
type if the nominal type is a larger record.
(gnat_to_gnu): Do not require integral modes on the source type to
avoid the conversion for types with identical names.
(addressable_p): Add gnu_type parameter.  If it is specified, do not
return true if the expression is not addressable in gnu_type.
Adjust recursive calls.
* utils.c (finish_record_type): Remove dead code.

From-SVN: r133011

gcc/ada/ChangeLog
gcc/ada/decl.c
gcc/ada/trans.c
gcc/ada/utils.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/pack3.adb [new file with mode: 0644]

index a67aae4019fc3c511891e5e07a957be5f4ab1779..44879fd8c7bea4e885eed8024058e9838ee60da5 100644 (file)
@@ -1,3 +1,37 @@
+2008-03-07  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * decl.c (MAX_FIXED_MODE_SIZE): Define if not already defined.
+       (gnat_to_gnu_entity) <E_Record_Type>: Try to get a smaller form of
+       the component for packing, if possible, as well as if a component
+       size clause is specified.
+       <E_Record_Subtype>: For an array type used to implement a packed
+       array, get the component type from the original array type.
+       Try to get a smaller form of the component for packing, if possible,
+       as well as if a component size clause is specified.
+       (round_up_to_align): New function.
+       (make_packable_type): Add in_record parameter.
+       For a padding record, preserve the size.  If not in_record and the
+       size is too large for an integral mode, attempt to shrink the size
+       by lowering the alignment.
+       Ditch the padding bits of the last component.
+       Compute sizes and mode manually, and propagate the RM size.
+       Return a BLKmode record type if its size has shrunk.
+       (maybe_pad_type): Use MAX_FIXED_MODE_SIZE instead of BIGGEST_ALIGNMENT.
+       Use Original_Array_Type to retrieve the type in case of an error.
+       Adjust call to make_packable_type.
+       (gnat_to_gnu_field): Likewise.
+       (concat_id_with_name): Minor tweak.
+       * trans.c (larger_record_type_p): New predicate.
+       (call_to_gnu): Compute the nominal type of the object only if the
+       parameter is by-reference.  Do the conversion actual type -> nominal
+       type if the nominal type is a larger record.
+       (gnat_to_gnu): Do not require integral modes on the source type to
+       avoid the conversion for types with identical names.
+       (addressable_p): Add gnu_type parameter.  If it is specified, do not
+       return true if the expression is not addressable in gnu_type.
+       Adjust recursive calls.
+       * utils.c (finish_record_type): Remove dead code.
+
 2008-03-05  Eric Botcazou  <ebotcazou@adacore.com>
 
        PR ada/35186
index 237d1a4a282c400ae84da751dbc63c919659bd64..7c75666f5d4390664d802e8ac6d7c870a2512f67 100644 (file)
 #include "ada-tree.h"
 #include "gigi.h"
 
+#ifndef MAX_FIXED_MODE_SIZE
+#define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode)
+#endif
+
 /* Convention_Stdcall should be processed in a specific way on Windows targets
    only.  The macro below is a helper to avoid having to check for a Windows
    specific attribute throughout this unit.  */
@@ -98,7 +102,7 @@ static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
 static bool is_variable_size (tree);
 static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree,
                                    bool, bool);
-static tree make_packable_type (tree);
+static tree make_packable_type (tree, bool);
 static tree gnat_to_gnu_field (Entity_Id, tree, int, bool);
 static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
                               bool *);
@@ -1608,12 +1612,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          = (Convention (gnat_entity) == Convention_Fortran) ? ndim - 1 : 0;
        int nextdim
          = (Convention (gnat_entity) == Convention_Fortran) ? - 1 : 1;
+       int index;
        tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree *));
        tree *gnu_temp_fields = (tree *) alloca (ndim * sizeof (tree *));
        tree gnu_comp_size = 0;
        tree gnu_max_size = size_one_node;
        tree gnu_max_size_unit;
-       int index;
        Entity_Id gnat_ind_subtype;
        Entity_Id gnat_ind_base_subtype;
        tree gnu_template_reference;
@@ -1738,6 +1742,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           in the fat pointer.  Note that it is the first field.  */
        tem = gnat_to_gnu_type (Component_Type (gnat_entity));
 
+       /* Try to get a smaller form of the component if needed.  */
+       if ((Is_Packed (gnat_entity)
+            || Has_Component_Size_Clause (gnat_entity))
+           && !Is_Bit_Packed_Array (gnat_entity)
+           && !Has_Aliased_Components (gnat_entity)
+           && !Strict_Alignment (Component_Type (gnat_entity))
+           && TREE_CODE (tem) == RECORD_TYPE
+           && TYPE_MODE (tem) == BLKmode
+           && host_integerp (TYPE_SIZE (tem), 1))
+         tem = make_packable_type (tem, false);
+
+       if (Has_Atomic_Components (gnat_entity))
+         check_ok_for_atomic (tem, gnat_entity, true);
+
        /* Get and validate any specified Component_Size, but if Packed,
           ignore it since the front end will have taken care of it. */
        gnu_comp_size
@@ -1747,16 +1765,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                            ? TYPE_DECL : VAR_DECL),
                           true, Has_Component_Size_Clause (gnat_entity));
 
-       if (Has_Atomic_Components (gnat_entity))
-         check_ok_for_atomic (tem, gnat_entity, true);
-
        /* If the component type is a RECORD_TYPE that has a self-referential
           size, use the maxium size.  */
        if (!gnu_comp_size && TREE_CODE (tem) == RECORD_TYPE
            && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (tem)))
          gnu_comp_size = max_size (TYPE_SIZE (tem), true);
 
-       if (!Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size)
+       if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity))
          {
            tree orig_tem;
            tem = make_type_from_size (tem, gnu_comp_size, false);
@@ -1764,8 +1779,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            tem = maybe_pad_type (tem, gnu_comp_size, 0, gnat_entity,
                                  "C_PAD", false, definition, true);
            /* If a padding record was made, declare it now since it will
-              never be declared otherwise.  This is necessary in order to
-              ensure that its subtrees are properly marked.  */
+              never be declared otherwise.  This is necessary to ensure
+              that its subtrees are properly marked.  */
            if (tem != orig_tem)
              create_type_decl (TYPE_NAME (tem), tem, NULL, true, false,
                                gnat_entity);
@@ -2065,53 +2080,86 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                need_index_type_struct = true;
            }
 
-         /* Then flatten: create the array of arrays.  */
-
-         gnu_type = gnat_to_gnu_type (Component_Type (gnat_entity));
-
-         /* One of the above calls might have caused us to be elaborated,
-            so don't blow up if so.  */
-         if (present_gnu_tree (gnat_entity))
+         /* Then flatten: create the array of arrays.  For an array type
+            used to implement a packed array, get the component type from
+            the original array type since the representation clauses that
+            can affect it are on the latter.  */
+         if (Is_Packed_Array_Type (gnat_entity)
+             && !Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
            {
-             maybe_present = true;
-             break;
+             gnu_type = gnat_to_gnu_type (Original_Array_Type (gnat_entity));
+             for (index = array_dim - 1; index >= 0; index--)
+               gnu_type = TREE_TYPE (gnu_type);
+       
+             /* One of the above calls might have caused us to be elaborated,
+                so don't blow up if so.  */
+             if (present_gnu_tree (gnat_entity))
+               {
+                 maybe_present = true;
+                 break;
+               }
            }
-
-         /* Get and validate any specified Component_Size, but if Packed,
-            ignore it since the front end will have taken care of it. */
-         gnu_comp_size
-           = validate_size (Component_Size (gnat_entity), gnu_type,
-                            gnat_entity,
-                            (Is_Bit_Packed_Array (gnat_entity)
-                             ? TYPE_DECL : VAR_DECL),
-                            true, Has_Component_Size_Clause (gnat_entity));
-
-         /* If the component type is a RECORD_TYPE that has a self-referential
-            size, use the maxium size.  */
-         if (!gnu_comp_size && TREE_CODE (gnu_type) == RECORD_TYPE
-             && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
-           gnu_comp_size = max_size (TYPE_SIZE (gnu_type), true);
-
-         if (!Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size)
+         else
            {
-             tree orig_gnu_type;
-             gnu_type = make_type_from_size (gnu_type, gnu_comp_size, false);
-             orig_gnu_type = gnu_type;
-             gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0,
-                                        gnat_entity, "C_PAD", false,
-                                        definition, true);
-             /* If a padding record was made, declare it now since it will
-                never be declared otherwise.  This is necessary in order to
-                ensure that its subtrees are properly marked.  */
-             if (gnu_type != orig_gnu_type)
-               create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
-                                 false, gnat_entity);
-           }
+             gnu_type = gnat_to_gnu_type (Component_Type (gnat_entity));
 
-         if (Has_Volatile_Components (Base_Type (gnat_entity)))
-           gnu_type = build_qualified_type (gnu_type,
-                                            (TYPE_QUALS (gnu_type)
-                                             | TYPE_QUAL_VOLATILE));
+             /* One of the above calls might have caused us to be elaborated,
+                so don't blow up if so.  */
+             if (present_gnu_tree (gnat_entity))
+               {
+                 maybe_present = true;
+                 break;
+               }
+
+             /* Try to get a smaller form of the component if needed.  */
+             if ((Is_Packed (gnat_entity)
+                  || Has_Component_Size_Clause (gnat_entity))
+                 && !Is_Bit_Packed_Array (gnat_entity)
+                 && !Has_Aliased_Components (gnat_entity)
+                 && !Strict_Alignment (Component_Type (gnat_entity))
+                 && TREE_CODE (gnu_type) == RECORD_TYPE
+                 && TYPE_MODE (gnu_type) == BLKmode
+                 && host_integerp (TYPE_SIZE (gnu_type), 1))
+               gnu_type = make_packable_type (gnu_type, false);
+
+             /* Get and validate any specified Component_Size, but if Packed,
+                ignore it since the front end will have taken care of it. */
+             gnu_comp_size
+               = validate_size (Component_Size (gnat_entity), gnu_type,
+                                gnat_entity,
+                                (Is_Bit_Packed_Array (gnat_entity)
+                                 ? TYPE_DECL : VAR_DECL), true,
+                                Has_Component_Size_Clause (gnat_entity));
+
+             /* If the component type is a RECORD_TYPE that has a
+                self-referential size, use the maxium size.  */
+             if (!gnu_comp_size
+                 && TREE_CODE (gnu_type) == RECORD_TYPE
+                 && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+               gnu_comp_size = max_size (TYPE_SIZE (gnu_type), true);
+
+             if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity))
+               {
+                 tree orig_gnu_type;
+                 gnu_type
+                   = make_type_from_size (gnu_type, gnu_comp_size, false);
+                 orig_gnu_type = gnu_type;
+                 gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0,
+                                            gnat_entity, "C_PAD", false,
+                                            definition, true);
+                 /* If a padding record was made, declare it now since it
+                    will never be declared otherwise.  This is necessary
+                    to ensure that its subtrees are properly marked.  */
+                 if (gnu_type != orig_gnu_type)
+                   create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL,
+                                     true, false, gnat_entity);
+               }
+
+             if (Has_Volatile_Components (Base_Type (gnat_entity)))
+               gnu_type = build_qualified_type (gnu_type,
+                                                (TYPE_QUALS (gnu_type)
+                                                 | TYPE_QUAL_VOLATILE));
+           }
 
          gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
                                          TYPE_SIZE_UNIT (gnu_type));
@@ -2795,7 +2843,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                        if (TYPE_MODE (gnu_field_type) == BLKmode
                            && TREE_CODE (gnu_field_type) == RECORD_TYPE
                            && host_integerp (TYPE_SIZE (gnu_field_type), 1))
-                         gnu_field_type = make_packable_type (gnu_field_type);
+                         gnu_field_type
+                           = make_packable_type (gnu_field_type, true);
                      }
 
                    if (CONTAINS_PLACEHOLDER_P (gnu_pos))
@@ -5197,54 +5246,99 @@ make_aligning_type (tree type, unsigned int align, tree size,
   return record_type;
 }
 \f
-/* TYPE is a RECORD_TYPE, UNION_TYPE, or QUAL_UNION_TYPE, with BLKmode that's
-   being used as the field type of a packed record.  See if we can rewrite it
-   as a record that has a non-BLKmode type, which we can pack tighter.  If so,
-   return the new type.  If not, return the original type.  */
+/* Return the result of rounding T up to ALIGN.  */
+
+static inline unsigned HOST_WIDE_INT
+round_up_to_align (unsigned HOST_WIDE_INT t, unsigned int align)
+{
+  t += align - 1;
+  t /= align;
+  t *= align;
+  return t;
+}
+
+/* TYPE is a RECORD_TYPE, UNION_TYPE, or QUAL_UNION_TYPE, with BLKmode 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, or as a smaller type with BLKmode.  If so, return the
+   new type.  If not, return the original type.  */
 
 static tree
-make_packable_type (tree type)
+make_packable_type (tree type, bool in_record)
 {
-  tree new_type = make_node (TREE_CODE (type));
-  tree field_list = NULL_TREE;
-  tree old_field;
+  unsigned HOST_WIDE_INT size = tree_low_cst (TYPE_SIZE (type), 1);
+  unsigned HOST_WIDE_INT new_size;
+  tree new_type, old_field, field_list = NULL_TREE;
+
+  /* No point in doing anything if the size is zero.  */
+  if (size == 0)
+    return type;
+
+  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 TYPE_NAME at
-     the end of gnat_to_gnu.  For QUAL_UNION_TYPE, also copy the size.  */
+     the end of gnat_to_gnu.  */
   TYPE_NAME (new_type) = TYPE_NAME (type);
   TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type);
   TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type);
-
   if (TREE_CODE (type) == RECORD_TYPE)
     TYPE_IS_PADDING_P (new_type) = TYPE_IS_PADDING_P (type);
-  else if (TREE_CODE (type) == QUAL_UNION_TYPE)
+
+  /* If we are in a record and have a small size, set the alignment to
+     try for an integral mode.  Otherwise set it to try for a smaller
+     type with BLKmode.  */
+  if (in_record && size <= MAX_FIXED_MODE_SIZE)
     {
-      TYPE_SIZE (new_type) = TYPE_SIZE (type);
-      TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type);
+      TYPE_ALIGN (new_type) = ceil_alignment (size);
+      new_size = round_up_to_align (size, TYPE_ALIGN (new_type));
+    }
+  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)
+         || !host_integerp (TYPE_ADA_SIZE (type), 1))
+       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.  */
+      new_size = TREE_INT_CST_LOW (TYPE_ADA_SIZE (type));
+      new_size = round_up_to_align (new_size, BITS_PER_UNIT);
+      if (new_size == size)
+       return type;
+
+      align = new_size & -new_size;
+      TYPE_ALIGN (new_type) = MIN (TYPE_ALIGN (type), align);
     }
 
-  /* Set the alignment to try for an integral type.  */
-  TYPE_ALIGN (new_type) = ceil_alignment (tree_low_cst (TYPE_SIZE (type), 1));
   TYPE_USER_ALIGN (new_type) = 1;
 
-  /* Now copy the fields, keeping the position and size.  */
+  /* Now copy the fields, keeping the position and size as we don't
+     want to propagate packedness downward.  But make an exception
+     for the last field in order to ditch the padding bits.  */
   for (old_field = TYPE_FIELDS (type); old_field;
        old_field = TREE_CHAIN (old_field))
     {
       tree new_field_type = TREE_TYPE (old_field);
-      tree new_field;
+      tree new_field, new_size;
 
       if (TYPE_MODE (new_field_type) == BLKmode
          && (TREE_CODE (new_field_type) == RECORD_TYPE
              || TREE_CODE (new_field_type) == UNION_TYPE
              || TREE_CODE (new_field_type) == QUAL_UNION_TYPE)
          && host_integerp (TYPE_SIZE (new_field_type), 1))
-       new_field_type = make_packable_type (new_field_type);
+       new_field_type = make_packable_type (new_field_type, true);
+
+      if (!TREE_CHAIN (old_field) && !TYPE_PACKED (type))
+       new_size = rm_size (new_field_type);
+      else
+       new_size = DECL_SIZE (old_field);
 
       new_field = create_field_decl (DECL_NAME (old_field), new_field_type,
-                                    new_type, TYPE_PACKED (type),
-                                    DECL_SIZE (old_field),
+                                    new_type, TYPE_PACKED (type), new_size,
                                     bit_position (old_field),
                                     !DECL_NONADDRESSABLE_P (old_field));
 
@@ -5260,16 +5354,40 @@ make_packable_type (tree type)
       field_list = new_field;
     }
 
-  finish_record_type (new_type, nreverse (field_list), 1, true);
+  finish_record_type (new_type, nreverse (field_list), 2, true);
   copy_alias_set (new_type, type);
 
+  /* If this is a padding record, we never want to make the size smaller
+     than what was specified.  For QUAL_UNION_TYPE, also copy the size.  */
+  if ((TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
+      || TREE_CODE (type) == QUAL_UNION_TYPE)
+    {
+      TYPE_SIZE (new_type) = TYPE_SIZE (type);
+      TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type);
+    }
+  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);
+    }
+
+  if (!TYPE_CONTAINS_TEMPLATE_P (type))
+    SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (type));
+
+  compute_record_mode (new_type);
+
   /* Try harder to get a packable type if necessary, for example
      in case the record itself contains a BLKmode field.  */
-  if (TYPE_MODE (new_type) == BLKmode)
+  if (in_record && TYPE_MODE (new_type) == BLKmode)
     TYPE_MODE (new_type)
       = mode_for_size_tree (TYPE_SIZE (new_type), MODE_INT, 1);
 
-  return TYPE_MODE (new_type) == BLKmode ? type : new_type;
+  /* If neither the mode nor the size has shrunk, return the old type.  */
+  if (TYPE_MODE (new_type) == BLKmode && new_size >= size)
+    return type;
+
+  return new_type;
 }
 \f
 /* Ensure that TYPE has SIZE and ALIGN.  Make and return a new padded type
@@ -5372,19 +5490,19 @@ maybe_pad_type (tree type, tree size, unsigned int align,
      BLKmode and a small constant size, try to make a form that has an
      integral mode.  That might allow this record to have an integral mode,
      which will be much more efficient.  There is no point in doing this if a
-     size is specified unless it is also smaller than the biggest alignment
+     size is specified unless it is also smaller than the maximum mode size
      and it is incorrect to do this if the size of the original type is not a
      multiple of the alignment.  */
   if (align != 0
       && TREE_CODE (type) == RECORD_TYPE
       && TYPE_MODE (type) == BLKmode
       && host_integerp (orig_size, 1)
-      && compare_tree_int (orig_size, BIGGEST_ALIGNMENT) <= 0
+      && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0
       && (!size
          || (TREE_CODE (size) == INTEGER_CST
-             && compare_tree_int (size, BIGGEST_ALIGNMENT) <= 0))
+             && compare_tree_int (size, MAX_FIXED_MODE_SIZE) <= 0))
       && tree_low_cst (orig_size, 1) % align == 0)
-    type = make_packable_type (type);
+    type = make_packable_type (type, true);
 
   field  = create_field_decl (get_identifier ("F"), type, record, 0,
                              NULL_TREE, bitsize_zero_node, 1);
@@ -5462,7 +5580,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
       Node_Id gnat_error_node = Empty;
 
       if (Is_Packed_Array_Type (gnat_entity))
-       gnat_entity = Associated_Node_For_Itype (gnat_entity);
+       gnat_entity = Original_Array_Type (gnat_entity);
 
       if ((Ekind (gnat_entity) == E_Component
           || Ekind (gnat_entity) == E_Discriminant)
@@ -5640,12 +5758,12 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
 
   /* 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 also a record that's
-     BLKmode and with a small constant size, see if we can get an integral
-     mode form of the type when appropriate.  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.
+     BLKmode, see if we can get either an integral mode form of the type or
+     a smaller BLKmode 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 can then
+     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.
 
@@ -5665,14 +5783,13 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   if (TREE_CODE (gnu_field_type) == RECORD_TYPE
       && TYPE_MODE (gnu_field_type) == BLKmode
       && host_integerp (TYPE_SIZE (gnu_field_type), 1)
-      && compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0
       && (packed == 1
          || (gnu_size
              && (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))
                  || Present (Component_Clause (gnat_field))))))
     {
       /* See what the alternate type and size would be.  */
-      tree gnu_packable_type = make_packable_type (gnu_field_type);
+      tree gnu_packable_type = make_packable_type (gnu_field_type, true);
 
       bool has_byte_aligned_clause
        = Present (Component_Clause (gnat_field))
@@ -7238,8 +7355,7 @@ concat_id_with_name (tree gnu_id, const char *suffix)
 {
   int len = IDENTIFIER_LENGTH (gnu_id);
 
-  strncpy (Name_Buffer, IDENTIFIER_POINTER (gnu_id),
-          IDENTIFIER_LENGTH (gnu_id));
+  strncpy (Name_Buffer, IDENTIFIER_POINTER (gnu_id), len);
   strncpy (Name_Buffer + len, "___", 3);
   len += 3;
   strcpy (Name_Buffer + len, suffix);
index 34cb297d24554ebd3f0f872067438bd32b96468e..6a9af59095a0237811f33355f48846a154598781 100644 (file)
@@ -202,7 +202,8 @@ static tree emit_range_check (tree, Node_Id);
 static tree emit_index_check (tree, tree, tree, tree);
 static tree emit_check (tree, tree, int);
 static tree convert_with_check (Entity_Id, tree, bool, bool, bool);
-static bool addressable_p (tree);
+static bool larger_record_type_p (tree, tree);
+static bool addressable_p (tree, tree);
 static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
 static tree extract_values (tree, tree);
 static tree pos_to_constructor (Node_Id, tree, Entity_Id);
@@ -2089,8 +2090,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
               && Is_Composite_Type (Underlying_Type (Etype (gnat_formal)))));
       Node_Id gnat_name = (suppress_type_conversion
                           ? Expression (gnat_actual) : gnat_actual);
-      tree gnu_name = gnat_to_gnu (gnat_name);
-      tree gnu_name_type = gnat_to_gnu_type (Etype (gnat_name));
+      tree gnu_name = gnat_to_gnu (gnat_name), gnu_name_type;
       tree gnu_actual;
 
       /* If it's possible we may need to use this expression twice, make sure
@@ -2109,7 +2109,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
              || (TREE_CODE (gnu_formal) == PARM_DECL
                  && (DECL_BY_COMPONENT_PTR_P (gnu_formal)
                      || (DECL_BY_DESCRIPTOR_P (gnu_formal)))))
-         && !addressable_p (gnu_name))
+         && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name)))
+         && !addressable_p (gnu_name, gnu_name_type))
        {
          tree gnu_copy = gnu_name, gnu_temp;
 
@@ -2136,8 +2137,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
                             gnat_formal);
            }
 
-         /* Remove any unpadding and make a copy.  But if it's a justified
-            modular type, just convert to it.  */
+         /* Remove any unpadding from the object and reset the copy.  */
          if (TREE_CODE (gnu_name) == COMPONENT_REF
              && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
                   == RECORD_TYPE)
@@ -2145,14 +2145,23 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
                      (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
            gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
 
+         /* Otherwise convert to the nominal type of the object if it's
+            a record type.  There are several cases in which we need to
+            make the temporary using this type instead of the actual type
+            of the object if they are distinct, because the expectations
+            of the callee would otherwise not be met:
+              - if it's a justified modular type,
+              - if the actual type is a packed version of it.  */
          else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
-                  && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)))
+                  && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
+                      || larger_record_type_p (gnu_name_type,
+                                               TREE_TYPE (gnu_name))))
            gnu_name = convert (gnu_name_type, gnu_name);
 
          /* Make a SAVE_EXPR to both properly account for potential side
             effects and handle the creation of a temporary copy.  Special
             code in gnat_gimplify_expr ensures that the same temporary is
-            used as the actual and copied back after the call if needed.  */
+            used as the object and copied back after the call if needed.  */
          gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
          TREE_SIDE_EFFECTS (gnu_name) = 1;
          TREE_INVARIANT (gnu_name) = 1;
@@ -4837,15 +4846,13 @@ gnat_to_gnu (Node_Id gnat_node)
      statement or a parameter of a procedure call, return what we have since
      the RHS has to be converted to our type there in that case, unless
      GNU_RESULT_TYPE has a simpler size.  Similarly, if the two types are
-     record types with the same name, the expression type has integral mode,
-     and GNU_RESULT_TYPE BLKmode, don't convert.  This will be the case when
-     we are converting from a packable type to its actual type and we need
-     those conversions to be NOPs in order for assignments into these types to
-     work properly if the inner object is a bitfield and hence can't have
-     its address taken.  Finally, don't convert integral types that are the
-     operand of an unchecked conversion since we need to ignore those
-     conversions (for 'Valid).  Otherwise, convert the result to the proper
-     type.  */
+     record types with the same name and GNU_RESULT_TYPE has BLKmode, don't
+     convert.  This will be the case when we are converting from a packable
+     type to its actual type and we need those conversions to be NOPs in
+     order for assignments into these types to work properly.  Finally,
+     don't convert integral types that are the operand of an unchecked
+     conversion since we need to ignore those conversions (for 'Valid).
+     Otherwise, convert the result to the proper type.  */
 
   if (Present (Parent (gnat_node))
       && ((Nkind (Parent (gnat_node)) == N_Assignment_Statement
@@ -4895,9 +4902,7 @@ gnat_to_gnu (Node_Id gnat_node)
                == TYPE_NAME (TREE_TYPE (gnu_result)))
               && TREE_CODE (gnu_result_type) == RECORD_TYPE
               && TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
-              && TYPE_MODE (gnu_result_type) == BLKmode
-              && (GET_MODE_CLASS (TYPE_MODE (TREE_TYPE (gnu_result)))
-                  == MODE_INT)))
+              && TYPE_MODE (gnu_result_type) == BLKmode))
     {
       /* Remove any padding record, but do nothing more in this case.  */
       if (TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
@@ -6047,13 +6052,44 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
   return convert (gnu_type, gnu_result);
 }
 \f
-/* Return 1 if GNU_EXPR can be directly addressed.  This is the case unless
-   it is an expression involving computation or if it involves a reference
-   to a bitfield or to a field not sufficiently aligned for its type.  */
+/* Return true if RECORD_TYPE, a record type, is larger than TYPE.  */
 
 static bool
-addressable_p (tree gnu_expr)
+larger_record_type_p (tree record_type, tree type)
 {
+  tree rsize, size;
+
+  /* Padding types are not considered larger on their own.  */
+  if (TYPE_IS_PADDING_P (record_type))
+    return false;
+
+  rsize = TYPE_SIZE (record_type);
+  size = TYPE_SIZE (type);
+
+  if (!(TREE_CODE (rsize) == INTEGER_CST && TREE_CODE (size) == INTEGER_CST))
+    return false;
+
+  return tree_int_cst_lt (size, rsize) != 0;
+}
+
+/* Return true if GNU_EXPR can be directly addressed.  This is the case
+   unless it is an expression involving computation or if it involves a
+   reference to a bitfield or to an object not sufficiently aligned for
+   its type.  If GNU_TYPE is non null, return true only if GNU_EXPR can
+   be directly addressed as an object of this type.  */
+
+static bool
+addressable_p (tree gnu_expr, tree gnu_type)
+{
+  /* The size of the real type of the object must not be smaller than
+     that of the expected type, otherwise an indirect access in the
+     latter type would be larger than the object.  Only records need
+     to be considered in practice.  */
+  if (gnu_type
+      && TREE_CODE (gnu_type) == RECORD_TYPE
+      && larger_record_type_p (gnu_type, TREE_TYPE (gnu_expr)))
+    return false;
+
   switch (TREE_CODE (gnu_expr))
     {
     case VAR_DECL:
@@ -6085,23 +6121,22 @@ addressable_p (tree gnu_expr)
                     aligned field that is not a bit-field.  */
                  || DECL_ALIGN (TREE_OPERAND (gnu_expr, 1))
                       >= TYPE_ALIGN (TREE_TYPE (gnu_expr)))
-             && addressable_p (TREE_OPERAND (gnu_expr, 0)));
+             && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE));
 
     case ARRAY_REF:  case ARRAY_RANGE_REF:
     case REALPART_EXPR:  case IMAGPART_EXPR:
     case NOP_EXPR:
-      return addressable_p (TREE_OPERAND (gnu_expr, 0));
+      return addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE);
 
     case CONVERT_EXPR:
       return (AGGREGATE_TYPE_P (TREE_TYPE (gnu_expr))
-             && addressable_p (TREE_OPERAND (gnu_expr, 0)));
+             && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE));
 
     case VIEW_CONVERT_EXPR:
       {
        /* This is addressable if we can avoid a copy.  */
        tree type = TREE_TYPE (gnu_expr);
        tree inner_type = TREE_TYPE (TREE_OPERAND (gnu_expr, 0));
-
        return (((TYPE_MODE (type) == TYPE_MODE (inner_type)
                  && (!STRICT_ALIGNMENT
                      || TYPE_ALIGN (type) <= TYPE_ALIGN (inner_type)
@@ -6113,7 +6148,7 @@ addressable_p (tree gnu_expr)
                         || TYPE_ALIGN (inner_type) >= BIGGEST_ALIGNMENT
                         || TYPE_ALIGN_OK (type)
                         || TYPE_ALIGN_OK (inner_type))))
-               && addressable_p (TREE_OPERAND (gnu_expr, 0)));
+               && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE));
       }
 
     default:
index 32cbbffa2a962275aa6591c04458e7896fc05055..bdce72a6d4dfa51bdd23883e1412deae6be16313 100644 (file)
@@ -750,7 +750,6 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
   tree name = TYPE_NAME (record_type);
   tree ada_size = bitsize_zero_node;
   tree size = bitsize_zero_node;
-  bool var_size = false;
   bool had_size = TYPE_SIZE (record_type) != 0;
   bool had_size_unit = TYPE_SIZE_UNIT (record_type) != 0;
   tree field;
@@ -811,15 +810,6 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
       tree this_size = DECL_SIZE (field);
       tree this_ada_size = DECL_SIZE (field);
 
-      /* We need to make an XVE/XVU record if any field has variable size,
-        whether or not the record does.  For example, if we have a union,
-        it may be that all fields, rounded up to the alignment, have the
-        same size, in which case we'll use that size.  But the debug
-        output routines (except Dwarf2) won't be able to output the fields,
-        so we need to make the special record.  */
-      if (TREE_CODE (this_size) != INTEGER_CST)
-       var_size = true;
-
       if ((TREE_CODE (type) == RECORD_TYPE || TREE_CODE (type) == UNION_TYPE
          || TREE_CODE (type) == QUAL_UNION_TYPE)
          && !TYPE_IS_FAT_POINTER_P (type)
index d9566e9c5c5f67492c1b85ce19c80ddf21e1dd3c..1a5302d2486e2bca1f102fd2532ea84459b68239 100644 (file)
@@ -1,3 +1,7 @@
+2008-03-07  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/pack3.adb: New test.
+
 2008-03-07  Peter O'Gorman  <pogma@thewrittenword.com>
 
        PR c++/20366
diff --git a/gcc/testsuite/gnat.dg/pack3.adb b/gcc/testsuite/gnat.dg/pack3.adb
new file mode 100644 (file)
index 0000000..06f71cb
--- /dev/null
@@ -0,0 +1,31 @@
+-- { dg-do run }
+
+procedure Pack3 is
+
+  type U32 is mod 2 ** 32;
+
+  type Key is record
+    Value : U32;
+    Valid : Boolean;
+  end record;
+
+  type Key_Buffer is record
+    Current, Latch : Key;
+  end record;
+
+  type Block is record
+    Keys  : Key_Buffer;
+    Stamp : U32;
+  end record;
+  pragma Pack (Block);
+
+  My_Block : Block;
+  My_Stamp : constant := 16#01234567#;
+
+begin
+  My_Block.Stamp := My_Stamp;
+  My_Block.Keys.Latch := My_Block.Keys.Current;
+  if My_Block.Stamp /= My_Stamp then
+    raise Program_Error;
+  end if;
+end;