From fc130ab54fd9a254f07426f9c180c367b039d7f9 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 3 Feb 2021 11:11:26 +0100 Subject: [PATCH] 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(-) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 5ea1b16af67..8120d4e33cf 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 c503bfbb36d..2656f117fa9 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. */ -- 2.30.2