diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 97 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 48 |
2 files changed, 101 insertions, 44 deletions
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 5ea1b16..aea191c 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++; @@ -8320,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 @@ -8343,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 @@ -8378,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 c503bfb..952f032 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. */ @@ -2046,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) @@ -2089,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 @@ -2124,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: @@ -2427,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; @@ -2451,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 |