From fc130ab54fd9a254f07426f9c180c367b039d7f9 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 3 Feb 2021 11:11:26 +0100 Subject: Assorted LTO fixes for Ada This polishes a few rough edges visible in LTO mode. gcc/ada/ * gcc-interface/decl.c (gnat_to_gnu_entity) : Make the two fields of the fat pointer type addressable, and do not make the template type read-only. : If the type has discriminants mark it as may_alias. * gcc-interface/utils.c (make_dummy_type): Likewise. (build_dummy_unc_pointer_types): Likewise. --- gcc/ada/gcc-interface/decl.c | 20 +++++++++++++++----- gcc/ada/gcc-interface/utils.c | 9 +++++++-- 2 files changed, 22 insertions(+), 7 deletions(-) (limited to 'gcc/ada/gcc-interface') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 5ea1b16..8120d4e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2197,14 +2197,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) } else { + /* We make the fields addressable for the sake of compatibility + with languages for which the regular fields are addressable. */ tem = create_field_decl (get_identifier ("P_ARRAY"), ptr_type_node, gnu_fat_type, - NULL_TREE, NULL_TREE, 0, 0); + NULL_TREE, NULL_TREE, 0, 1); DECL_CHAIN (tem) = create_field_decl (get_identifier ("P_BOUNDS"), gnu_ptr_template, gnu_fat_type, - NULL_TREE, NULL_TREE, 0, 0); + NULL_TREE, NULL_TREE, 0, 1); finish_fat_pointer_type (gnu_fat_type, tem); SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type); } @@ -2327,7 +2329,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) finish_record_type (gnu_template_type, gnu_template_fields, 0, debug_info_p); TYPE_CONTEXT (gnu_template_type) = current_function_decl; - TYPE_READONLY (gnu_template_type) = 1; /* If Component_Size is not already specified, annotate it with the size of the component. */ @@ -3054,15 +3055,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) || type_annotate_only); } - /* Make a node for the record. If we are not defining the record, - suppress expanding incomplete types. */ + /* Make a node for the record type. */ gnu_type = make_node (tree_code_for_record_type (gnat_entity)); TYPE_NAME (gnu_type) = gnu_entity_name; TYPE_PACKED (gnu_type) = (packed != 0) || has_align || has_rep; TYPE_REVERSE_STORAGE_ORDER (gnu_type) = Reverse_Storage_Order (gnat_entity); + + /* If the record type has discriminants, pointers to it may also point + to constrained subtypes of it, so mark it as may_alias for LTO. */ + if (has_discr) + prepend_one_attribute + (&attr_list, ATTR_MACHINE_ATTRIBUTE, + get_identifier ("may_alias"), NULL_TREE, + gnat_entity); + process_attributes (&gnu_type, &attr_list, true, gnat_entity); + /* If we are not defining it, suppress expanding incomplete types. */ if (!definition) { defer_incomplete_level++; diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index c503bfb..2656f11 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -467,6 +467,11 @@ make_dummy_type (Entity_Id gnat_type) = create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type); if (Is_By_Reference_Type (gnat_equiv)) TYPE_BY_REFERENCE_P (gnu_type) = 1; + if (Has_Discriminants (gnat_equiv)) + decl_attributes (&gnu_type, + tree_cons (get_identifier ("may_alias"), NULL_TREE, + NULL_TREE), + ATTR_FLAG_TYPE_IN_PLACE); SET_DUMMY_NODE (gnat_equiv, gnu_type); @@ -516,10 +521,10 @@ build_dummy_unc_pointer_types (Entity_Id gnat_desig_type, tree gnu_desig_type) = create_type_stub_decl (create_concat_name (gnat_desig_type, "XUP"), gnu_fat_type); fields = create_field_decl (get_identifier ("P_ARRAY"), gnu_ptr_array, - gnu_fat_type, NULL_TREE, NULL_TREE, 0, 0); + gnu_fat_type, NULL_TREE, NULL_TREE, 0, 1); DECL_CHAIN (fields) = create_field_decl (get_identifier ("P_BOUNDS"), gnu_ptr_template, - gnu_fat_type, NULL_TREE, NULL_TREE, 0, 0); + gnu_fat_type, NULL_TREE, NULL_TREE, 0, 1); finish_fat_pointer_type (gnu_fat_type, fields); SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_desig_type); /* Suppress debug info until after the type is completed. */ -- cgit v1.1 From e8c87bc07b5c98101b47caaee84650cd8abdfa5f Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 3 Feb 2021 11:38:04 +0100 Subject: Fix regression with partial rep clause on variant record type It can yield an incorrect layout when there is a partial representation clause on a discriminated record type with a variant part. gcc/ada/ * gcc-interface/decl.c (components_to_record): If the first component with rep clause is the _Parent field with variable size, temporarily set it aside when computing the internal layout of the REP part again. * gcc-interface/utils.c (finish_record_type): Revert to taking the maximum when merging sizes for all record types with rep clause. (merge_sizes): Put SPECIAL parameter last and adjust recursive calls. --- gcc/ada/gcc-interface/decl.c | 77 +++++++++++++++++++++++++++++++++---------- gcc/ada/gcc-interface/utils.c | 39 +++++++++++----------- 2 files changed, 79 insertions(+), 37 deletions(-) (limited to 'gcc/ada/gcc-interface') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 8120d4e..aea191c 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -8330,12 +8330,12 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, if (p_gnu_rep_list && gnu_rep_list) *p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_rep_list); - /* Deal with the annoying case of an extension of a record with variable size - and partial rep clause, for which the _Parent field is forced at offset 0 - and has variable size, which we do not support below. Note that we cannot - do it if the field has fixed size because we rely on the presence of the - REP part built below to trigger the reordering of the fields in a derived - record type when all the fields have a fixed position. */ + /* Deal with the case of an extension of a record type with variable size and + partial rep clause, for which the _Parent field is forced at offset 0 and + has variable size. Note that we cannot do it if the field has fixed size + because we rely on the presence of the REP part built below to trigger the + reordering of the fields in a derived record type when all the fields have + a fixed position. */ else if (gnu_rep_list && !DECL_CHAIN (gnu_rep_list) && TREE_CODE (DECL_SIZE (gnu_rep_list)) != INTEGER_CST @@ -8353,33 +8353,52 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, record, before the others, if we also have fields without rep clause. */ else if (gnu_rep_list) { - tree gnu_rep_type, gnu_rep_part; - int i, len = list_length (gnu_rep_list); - tree *gnu_arr = XALLOCAVEC (tree, len); + tree gnu_parent, gnu_rep_type; /* If all the fields have a rep clause, we can do a flat layout. */ layout_with_rep = !gnu_field_list && (!gnu_variant_part || variants_have_rep); + + /* Same as above but the extension itself has a rep clause, in which case + we need to set aside the _Parent field to lay out the REP part. */ + if (TREE_CODE (DECL_SIZE (gnu_rep_list)) != INTEGER_CST + && !layout_with_rep + && !variants_have_rep + && first_free_pos + && integer_zerop (first_free_pos) + && integer_zerop (bit_position (gnu_rep_list))) + { + gnu_parent = gnu_rep_list; + gnu_rep_list = DECL_CHAIN (gnu_rep_list); + } + else + gnu_parent = NULL_TREE; + gnu_rep_type = layout_with_rep ? gnu_record_type : make_node (RECORD_TYPE); - for (gnu_field = gnu_rep_list, i = 0; - gnu_field; - gnu_field = DECL_CHAIN (gnu_field), i++) - gnu_arr[i] = gnu_field; + /* Sort the fields in order of increasing bit position. */ + const int len = list_length (gnu_rep_list); + tree *gnu_arr = XALLOCAVEC (tree, len); + + gnu_field = gnu_rep_list; + for (int i = 0; i < len; i++) + { + gnu_arr[i] = gnu_field; + gnu_field = DECL_CHAIN (gnu_field); + } qsort (gnu_arr, len, sizeof (tree), compare_field_bitpos); - /* Put the fields in the list in order of increasing position, which - means we start from the end. */ gnu_rep_list = NULL_TREE; - for (i = len - 1; i >= 0; i--) + for (int i = len - 1; i >= 0; i--) { DECL_CHAIN (gnu_arr[i]) = gnu_rep_list; gnu_rep_list = gnu_arr[i]; DECL_CONTEXT (gnu_arr[i]) = gnu_rep_type; } + /* Do the layout of the REP part, if any. */ if (layout_with_rep) gnu_field_list = gnu_rep_list; else @@ -8388,14 +8407,36 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, = create_concat_name (gnat_record_type, "REP"); TYPE_REVERSE_STORAGE_ORDER (gnu_rep_type) = TYPE_REVERSE_STORAGE_ORDER (gnu_record_type); - finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info); + finish_record_type (gnu_rep_type, gnu_rep_list, 1, false); /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields without rep clause are laid out starting from this position. Therefore, we force it as a minimal size on the REP part. */ - gnu_rep_part + tree gnu_rep_part = create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos); + /* If this is an extension, put back the _Parent field as the first + field of the REP part at offset 0 and update its layout. */ + if (gnu_parent) + { + const unsigned int align = DECL_ALIGN (gnu_parent); + DECL_CHAIN (gnu_parent) = TYPE_FIELDS (gnu_rep_type); + TYPE_FIELDS (gnu_rep_type) = gnu_parent; + DECL_CONTEXT (gnu_parent) = gnu_rep_type; + if (align > TYPE_ALIGN (gnu_rep_type)) + { + SET_TYPE_ALIGN (gnu_rep_type, align); + TYPE_SIZE (gnu_rep_type) + = round_up (TYPE_SIZE (gnu_rep_type), align); + TYPE_SIZE_UNIT (gnu_rep_type) + = round_up (TYPE_SIZE_UNIT (gnu_rep_type), align); + SET_DECL_ALIGN (gnu_rep_part, align); + } + } + + if (debug_info) + rest_of_record_type_compilation (gnu_rep_type); + /* Chain the REP part at the beginning of the field list. */ DECL_CHAIN (gnu_rep_part) = gnu_field_list; gnu_field_list = gnu_rep_part; diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 2656f11..952f032 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -2051,7 +2051,6 @@ finish_record_type (tree record_type, tree field_list, int rep_level, this_ada_size = this_size; const bool variant_part = (TREE_CODE (type) == QUAL_UNION_TYPE); - const bool variant_part_at_zero = variant_part && integer_zerop (pos); /* Clear DECL_BIT_FIELD for the cases layout_decl does not handle. */ if (DECL_BIT_FIELD (field) @@ -2094,7 +2093,7 @@ finish_record_type (tree record_type, tree field_list, int rep_level, /* Clear DECL_BIT_FIELD_TYPE for a variant part at offset 0, it's simply not supported by the DECL_BIT_FIELD_REPRESENTATIVE machinery because the variant part is always the last field in the list. */ - if (variant_part_at_zero) + if (variant_part && integer_zerop (pos)) DECL_BIT_FIELD_TYPE (field) = NULL_TREE; /* If we still have DECL_BIT_FIELD set at this point, we know that the @@ -2129,18 +2128,20 @@ finish_record_type (tree record_type, tree field_list, int rep_level, case RECORD_TYPE: /* Since we know here that all fields are sorted in order of increasing bit position, the size of the record is one - higher than the ending bit of the last field processed, - unless we have a variant part at offset 0, since in this - case we might have a field outside the variant part that - has a higher ending position; so use a MAX in this case. - Also, if this field is a QUAL_UNION_TYPE, we need to take - into account the previous size in the case of empty variants. */ + higher than the ending bit of the last field processed + unless we have a rep clause, because we might be processing + the REP part of a record with a variant part for which the + variant part has a rep clause but not the fixed part, in + which case this REP part may contain overlapping fields + and thus needs to be treated like a union tyoe above, so + use a MAX in that case. Also, if this field is a variant + part, we need to take into account the previous size in + the case of empty variants. */ ada_size - = merge_sizes (ada_size, pos, this_ada_size, variant_part, - variant_part_at_zero); + = merge_sizes (ada_size, pos, this_ada_size, rep_level > 0, + variant_part); size - = merge_sizes (size, pos, this_size, variant_part, - variant_part_at_zero); + = merge_sizes (size, pos, this_size, rep_level > 0, variant_part); break; default: @@ -2432,14 +2433,14 @@ rest_of_record_type_compilation (tree record_type) } /* Utility function of above to merge LAST_SIZE, the previous size of a record - with FIRST_BIT and SIZE that describe a field. SPECIAL is true if this - represents a QUAL_UNION_TYPE in which case we must look for COND_EXPRs and - replace a value of zero with the old size. If MAX is true, we take the + with FIRST_BIT and SIZE that describe a field. If MAX is true, we take the MAX of the end position of this field with LAST_SIZE. In all other cases, - we use FIRST_BIT plus SIZE. Return an expression for the size. */ + we use FIRST_BIT plus SIZE. SPECIAL is true if it's for a QUAL_UNION_TYPE, + in which case we must look for COND_EXPRs and replace a value of zero with + the old size. Return an expression for the size. */ static tree -merge_sizes (tree last_size, tree first_bit, tree size, bool special, bool max) +merge_sizes (tree last_size, tree first_bit, tree size, bool max, bool special) { tree type = TREE_TYPE (last_size); tree new_size; @@ -2456,11 +2457,11 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special, bool max) integer_zerop (TREE_OPERAND (size, 1)) ? last_size : merge_sizes (last_size, first_bit, TREE_OPERAND (size, 1), - 1, max), + max, special), integer_zerop (TREE_OPERAND (size, 2)) ? last_size : merge_sizes (last_size, first_bit, TREE_OPERAND (size, 2), - 1, max)); + max, special)); /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially when fed through SUBSTITUTE_IN_EXPR) into thinking that a constant -- cgit v1.1