This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix alignment of array aggregates
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Mon, 20 Jan 2014 11:51:10 +0100
- Subject: [Ada] Fix alignment of array aggregates
- Authentication-results: sourceware.org; auth=none
This fixes a long-standing issue in the Ada compiler, whereby the alignment of
aggregates whose type is an over-aligned array is lost in translation.
Tested on x86_64-suse-linux, applied on the mainline.
2014-01-20 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Record_Subtype>:
Tidy up. For a subtype with discriminants and variant part, if a
variant is statically selected and the fields all have a constant
position, put them in order of increasing position. Likewise if
no variant part but representation clause is present.
* gcc-interface/utils.c (make_packable_type): Robustify.
(maybe_pad_type): Use local variable and tidy up condition. If no
alignment is specified, use the original one.
(create_type_stub_decl): Minor tweak.
(convert) <case VECTOR_CST>: Fix typo.
<case CONSTRUCTOR>: Deal with padding types around the same type.
Do not punt on missing fields.
(unchecked_convert): Call finish_record_type to lay out the special
record types made for conversions from/to problematic integer types.
Bump the alignment of CONSTRUCTORs before converting them to a more
aligned type.
--
Eric Botcazou
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 206790)
+++ gcc-interface/utils.c (working copy)
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2013, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2014, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -869,8 +869,9 @@ make_packable_type (tree type, bool in_r
finish_record_type (new_type, nreverse (field_list), 2, false);
relate_alias_sets (new_type, type, ALIAS_SET_COPY);
- SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
- DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
+ if (TYPE_STUB_DECL (type))
+ SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
+ DECL_PARALLEL_TYPE (TYPE_STUB_DECL (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. */
@@ -1049,6 +1050,7 @@ maybe_pad_type (tree type, tree size, un
bool is_user_type, bool definition, bool set_rm_size)
{
tree orig_size = TYPE_SIZE (type);
+ unsigned int orig_align = TYPE_ALIGN (type);
tree record, field;
/* If TYPE is a padded type, see if it agrees with any size and alignment
@@ -1059,21 +1061,18 @@ maybe_pad_type (tree type, tree size, un
if (TYPE_IS_PADDING_P (type))
{
if ((!size
- || operand_equal_p (round_up (size,
- MAX (align, TYPE_ALIGN (type))),
- round_up (TYPE_SIZE (type),
- MAX (align, TYPE_ALIGN (type))),
- 0))
- && (align == 0 || align == TYPE_ALIGN (type)))
+ || operand_equal_p (round_up (size, orig_align), orig_size, 0))
+ && (align == 0 || align == orig_align))
return type;
if (!size)
- size = TYPE_SIZE (type);
+ size = orig_size;
if (align == 0)
- align = TYPE_ALIGN (type);
+ align = orig_align;
type = TREE_TYPE (TYPE_FIELDS (type));
orig_size = TYPE_SIZE (type);
+ orig_align = TYPE_ALIGN (type);
}
/* If the size is either not being changed or is being made smaller (which
@@ -1086,7 +1085,7 @@ maybe_pad_type (tree type, tree size, un
&& tree_int_cst_lt (size, orig_size))))
size = NULL_TREE;
- if (align == TYPE_ALIGN (type))
+ if (align == orig_align)
align = 0;
if (align == 0 && !size)
@@ -1110,7 +1109,7 @@ maybe_pad_type (tree type, tree size, un
if (Present (gnat_entity))
TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
- TYPE_ALIGN (record) = align;
+ TYPE_ALIGN (record) = align ? align : orig_align;
TYPE_SIZE (record) = size ? size : orig_size;
TYPE_SIZE_UNIT (record)
= convert (sizetype,
@@ -2063,8 +2062,7 @@ create_type_stub_decl (tree type_name, t
/* Using a named TYPE_DECL ensures that a type name marker is emitted in
STABS while setting DECL_ARTIFICIAL ensures that no DW_TAG_typedef is
emitted in DWARF. */
- tree type_decl = build_decl (input_location,
- TYPE_DECL, type_name, type);
+ tree type_decl = build_decl (input_location, TYPE_DECL, type_name, type);
DECL_ARTIFICIAL (type_decl) = 1;
TYPE_ARTIFICIAL (type) = 1;
return type_decl;
@@ -4626,7 +4624,7 @@ convert (tree type, tree expr)
break;
case VECTOR_CST:
- /* If we are converting a VECTOR_CST to a mere variant type, just make
+ /* If we are converting a VECTOR_CST to a mere type variant, just make
a new one in the proper type. */
if (code == ecode && gnat_types_compatible_p (type, etype))
{
@@ -4636,9 +4634,15 @@ convert (tree type, tree expr)
}
case CONSTRUCTOR:
- /* If we are converting a CONSTRUCTOR to a mere variant type, just make
- a new one in the proper type. */
- if (code == ecode && gnat_types_compatible_p (type, etype))
+ /* If we are converting a CONSTRUCTOR to a mere type variant, or to
+ another padding type around the same type, just make a new one in
+ the proper type. */
+ if (code == ecode
+ && (gnat_types_compatible_p (type, etype)
+ || (code == RECORD_TYPE
+ && TYPE_PADDING_P (type) && TYPE_PADDING_P (etype)
+ && TREE_TYPE (TYPE_FIELDS (type))
+ == TREE_TYPE (TYPE_FIELDS (etype)))))
{
expr = copy_node (expr);
TREE_TYPE (expr) = type;
@@ -4669,13 +4673,17 @@ convert (tree type, tree expr)
FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
{
- /* We expect only simple constructors. */
- if (!SAME_FIELD_P (index, efield))
- break;
+ /* Skip the missing fields in the CONSTRUCTOR. */
+ while (efield && field && !SAME_FIELD_P (efield, index))
+ {
+ efield = DECL_CHAIN (efield);
+ field = DECL_CHAIN (field);
+ }
/* The field must be the same. */
- if (!SAME_FIELD_P (efield, field))
+ if (!(efield && field && SAME_FIELD_P (efield, field)))
break;
- constructor_elt elt = {field, convert (TREE_TYPE (field), value)};
+ constructor_elt elt
+ = {field, convert (TREE_TYPE (field), value)};
v->quick_push (elt);
/* If packing has made this field a bitfield and the input
@@ -5321,10 +5329,9 @@ unchecked_convert (tree type, tree expr,
SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (type));
field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type,
- NULL_TREE, NULL_TREE, 1, 0);
+ NULL_TREE, bitsize_zero_node, 1, 0);
- TYPE_FIELDS (rec_type) = field;
- layout_type (rec_type);
+ finish_record_type (rec_type, field, 1, false);
expr = unchecked_convert (rec_type, expr, notrunc_p);
expr = build_component_ref (expr, NULL_TREE, field, false);
@@ -5352,10 +5359,9 @@ unchecked_convert (tree type, tree expr,
SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (etype));
field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type,
- NULL_TREE, NULL_TREE, 1, 0);
+ NULL_TREE, bitsize_zero_node, 1, 0);
- TYPE_FIELDS (rec_type) = field;
- layout_type (rec_type);
+ finish_record_type (rec_type, field, 1, false);
expr = fold_build1 (NOP_EXPR, field_type, expr);
CONSTRUCTOR_APPEND_ELT (v, field, expr);
@@ -5412,6 +5418,19 @@ unchecked_convert (tree type, tree expr,
etype))
expr = convert (type, expr);
+ /* If we are converting a CONSTRUCTOR to a more aligned RECORD_TYPE, bump
+ the alignment of the CONSTRUCTOR to speed up the copy operation. */
+ else if (TREE_CODE (expr) == CONSTRUCTOR
+ && code == RECORD_TYPE
+ && TYPE_ALIGN (etype) < TYPE_ALIGN (type))
+ {
+ expr = convert (maybe_pad_type (etype, NULL_TREE, TYPE_ALIGN (type),
+ Empty, false, false, false, true),
+ expr);
+ return unchecked_convert (type, expr, notrunc_p);
+ }
+
+ /* Otherwise, just build a VIEW_CONVERT_EXPR of the expression. */
else
{
expr = maybe_unconstrained_array (expr);
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 206794)
+++ gcc-interface/decl.c (working copy)
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2013, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2014, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -147,6 +147,7 @@ static bool array_type_has_nonaliased_co
static bool compile_time_known_address_p (Node_Id);
static bool cannot_be_superflat_p (Node_Id);
static bool constructor_address_p (tree);
+static int compare_field_bitpos (const PTR, const PTR);
static bool components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
bool, bool, bool, bool, bool, tree, tree *);
static Uint annotate_value (tree);
@@ -3341,9 +3342,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
{
vec<subst_pair> gnu_subst_list
= build_subst_list (gnat_entity, gnat_base_type, definition);
- tree gnu_unpad_base_type, gnu_rep_part, gnu_variant_part, t;
+ tree gnu_unpad_base_type, gnu_rep_part, gnu_variant_part;
tree gnu_pos_list, gnu_field_list = NULL_TREE;
- bool selected_variant = false;
+ bool selected_variant = false, all_constant_pos = true;
Entity_Id gnat_field;
vec<variant_desc> gnu_variant_list;
@@ -3362,7 +3363,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
else
gnu_unpad_base_type = gnu_base_type;
- /* Look for a variant part in the base type. */
+ /* Look for REP and variant parts in the base type. */
+ gnu_rep_part = get_rep_part (gnu_unpad_base_type);
gnu_variant_part = get_variant_part (gnu_unpad_base_type);
/* If there is a variant part, we must compute whether the
@@ -3414,13 +3416,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
selected_variant = false;
}
+ /* Make a list of fields and their position in the base type. */
gnu_pos_list
= build_position_list (gnu_unpad_base_type,
gnu_variant_list.exists ()
- && !selected_variant,
+ && !selected_variant,
size_zero_node, bitsize_zero_node,
BIGGEST_ALIGNMENT, NULL_TREE);
+ /* Now go down every component in the subtype and compute its
+ size and position from those of the component in the base
+ type and from the constraints of the subtype. */
for (gnat_field = First_Entity (gnat_entity);
Present (gnat_field);
gnat_field = Next_Entity (gnat_field))
@@ -3428,8 +3434,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
|| Ekind (gnat_field) == E_Discriminant)
&& !(Present (Corresponding_Discriminant (gnat_field))
&& Is_Tagged_Type (gnat_base_type))
- && Underlying_Type (Scope (Original_Record_Component
- (gnat_field)))
+ && Underlying_Type
+ (Scope (Original_Record_Component (gnat_field)))
== gnat_base_type)
{
Name_Id gnat_name = Chars (gnat_field);
@@ -3438,7 +3444,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
tree gnu_old_field
= gnat_to_gnu_field_decl (gnat_old_field);
tree gnu_context = DECL_CONTEXT (gnu_old_field);
- tree gnu_field, gnu_field_type, gnu_size;
+ tree gnu_field, gnu_field_type, gnu_size, gnu_pos;
tree gnu_cont_type, gnu_last = NULL_TREE;
/* If the type is the same, retrieve the GCC type from the
@@ -3489,24 +3495,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
and put the field either in the new type if there is a
selected variant or in one of the new variants. */
if (gnu_context == gnu_unpad_base_type
- || ((gnu_rep_part = get_rep_part (gnu_unpad_base_type))
+ || (gnu_rep_part
&& gnu_context == TREE_TYPE (gnu_rep_part)))
gnu_cont_type = gnu_type;
else
{
variant_desc *v;
unsigned int i;
+ tree rep_part;
- t = NULL_TREE;
FOR_EACH_VEC_ELT (gnu_variant_list, i, v)
if (gnu_context == v->type
- || ((gnu_rep_part = get_rep_part (v->type))
- && gnu_context == TREE_TYPE (gnu_rep_part)))
- {
- t = v->type;
- break;
- }
- if (t)
+ || ((rep_part = get_rep_part (v->type))
+ && gnu_context == TREE_TYPE (rep_part)))
+ break;
+ if (v)
{
if (selected_variant)
gnu_cont_type = gnu_type;
@@ -3525,6 +3528,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
= create_field_decl_from (gnu_old_field, gnu_field_type,
gnu_cont_type, gnu_size,
gnu_pos_list, gnu_subst_list);
+ gnu_pos = DECL_FIELD_OFFSET (gnu_field);
/* Put it in one of the new variants directly. */
if (gnu_cont_type != gnu_type)
@@ -3557,14 +3561,42 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
gnu_field_list = gnu_field;
if (!gnu_last)
gnu_last = gnu_field;
+ if (TREE_CODE (gnu_pos) != INTEGER_CST)
+ all_constant_pos = false;
}
save_gnu_tree (gnat_field, gnu_field, false);
}
+ /* If there is a variant list, a selected variant and the fields
+ all have a constant position, put them in order of increasing
+ position to match that of constant CONSTRUCTORs. Likewise if
+ there is no variant list but a REP part, since the latter has
+ been flattened in the process. */
+ if (((gnu_variant_list.exists () && selected_variant)
+ || (!gnu_variant_list.exists () && gnu_rep_part))
+ && all_constant_pos)
+ {
+ const int len = list_length (gnu_field_list);
+ tree *field_arr = XALLOCAVEC (tree, len), t;
+ int i;
+
+ for (t = gnu_field_list, i = 0; t; t = DECL_CHAIN (t), i++)
+ field_arr[i] = t;
+
+ qsort (field_arr, len, sizeof (tree), compare_field_bitpos);
+
+ gnu_field_list = NULL_TREE;
+ for (i = 0; i < len; i++)
+ {
+ DECL_CHAIN (field_arr[i]) = gnu_field_list;
+ gnu_field_list = field_arr[i];
+ }
+ }
+
/* If there is a variant list and no selected variant, we need
to create the nest of variant parts from the old nest. */
- if (gnu_variant_list.exists () && !selected_variant)
+ else if (gnu_variant_list.exists () && !selected_variant)
{
tree new_variant_part
= create_variant_part_from (gnu_variant_part,