This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix and improve record packing
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Fri, 7 Mar 2008 18:14:17 +0100
- Subject: [Ada] Fix and improve record packing
This patch lifts an old limitation of the compiler: components of packed
arrays or records that are not bit-packed are not packed, i.e. their size
is not made smaller than that of their type. This is all the more annoying
that a component size clause corresponding to the theoritical packed size is
accepted and, consequently, not honored.
Conversely, if a component of a packed record is bit-packed and happens to be
of a record type itself, accessing inner fields within the outer record may
overrun the component. This is fixed by locally rewriting the type.
Finally, the patch makes it possible for a component size clause on an array
type to override the type size of the component.
Tested on i586-suse-linux, applied on the mainline.
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-07 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/pack3.adb: New test.
--
Eric Botcazou
Index: decl.c
===================================================================
--- decl.c (revision 132963)
+++ decl.c (working copy)
@@ -53,6 +53,10 @@
#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_I
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_entit
= (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_entit
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_entit
? 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_entit
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_entit
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;
+ }
}
+ else
+ {
+ gnu_type = gnat_to_gnu_type (Component_Type (gnat_entity));
- /* 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);
+ /* 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;
+ }
- if (!Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size)
- {
- 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);
- }
+ /* 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 (Has_Volatile_Components (Base_Type (gnat_entity)))
- gnu_type = build_qualified_type (gnu_type,
- (TYPE_QUALS (gnu_type)
- | TYPE_QUAL_VOLATILE));
+ 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_entit
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
return record_type;
}
-/* 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;
}
/* 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, un
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, un
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,
/* 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,
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
{
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: trans.c
===================================================================
--- trans.c (revision 132854)
+++ trans.c (working copy)
@@ -202,7 +202,8 @@ static tree emit_range_check (tree, Node
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 *gn
&& 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 *gn
|| (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 *gn
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 *gn
(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,
return convert (gnu_type, gnu_result);
}
-/* 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: utils.c
===================================================================
--- utils.c (revision 132854)
+++ utils.c (working copy)
@@ -750,7 +750,6 @@ finish_record_type (tree record_type, tr
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, tr
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)
-- { 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;