From: Eric Botcazou Date: Tue, 5 Aug 2025 07:14:44 +0000 (+0200) Subject: ada: Get rid of TYPE_ALIGN_OK flag in gcc-interface X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=88a389ac8664360aaf8b2a628df8da24b678daa8;p=thirdparty%2Fgcc.git ada: Get rid of TYPE_ALIGN_OK flag in gcc-interface The TYPE_ALIGN_OK flag had originally been a GCC flag tested in the RTL expander and was at some point kicked out of the middle-end to become a pure Gigi flag. But it's only set for tagged types and CW-equivalent types and can be replaced by a explicit predicate without too much work. gcc/ada/ChangeLog: * gcc-interface/ada-tree.h (TYPE_ALIGN_OK): Delete. * gcc-interface/decl.cc (gnat_to_gnu_entity): Do not set it. * gcc-interface/gigi.h (standard_datatypes): Add ADT_tag_name_id. (tag_name_id): New macro. (type_is_tagged_or_cw_equivalent): New inline predicate. * gcc-interface/trans.cc (gigi): Initialize tag_name_id. (gnat_to_gnu) : Replace tests on TYPE_ALIGN_OK with calls to type_is_tagged_or_cw_equivalent. (addressable_p): Likewise. * gcc-interface/utils.cc (convert): Likewise. * gcc-interface/utils2.cc (build_binary_op): Likewise. --- diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 205136bc8ef..8f930dd8541 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -184,9 +184,6 @@ do { \ /* True for a dummy type if TYPE appears in a profile. */ #define TYPE_DUMMY_IN_PROFILE_P(NODE) TYPE_LANG_FLAG_6 (NODE) -/* True if objects of this type are guaranteed to be properly aligned. */ -#define TYPE_ALIGN_OK(NODE) TYPE_LANG_FLAG_7 (NODE) - /* True for types that implement a packed array and for original packed array types. */ #define TYPE_IMPL_PACKED_ARRAY_P(NODE) \ diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 86cbf5ba4fb..771325d8ce6 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -4821,14 +4821,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) { bool align_clause; - /* Record the property that objects of tagged types are guaranteed to - be properly aligned. This is necessary because conversions to the - class-wide type are translated into conversions to the root type, - which can be less aligned than some of its derived types. */ - if (Is_Tagged_Type (gnat_entity) - || Is_Class_Wide_Equivalent_Type (gnat_entity)) - TYPE_ALIGN_OK (gnu_type) = 1; - /* Record whether the type is passed by reference. */ if (is_by_ref && !VOID_TYPE_P (gnu_type)) TYPE_BY_REFERENCE_P (gnu_type) = 1; diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 45b1bfd23e3..2533bd49434 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -399,6 +399,9 @@ enum standard_datatypes /* Identifier for the name of the _Parent field in tagged record types. */ ADT_parent_name_id, + /* Identifier for the name of the _Tag field in tagged record types. */ + ADT_tag_name_id, + /* Identifier for the name of the Not_Handled_By_Others field. */ ADT_not_handled_by_others_name_id, @@ -461,6 +464,7 @@ extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1]; #define mulv128_decl gnat_std_decls[(int) ADT_mulv128_decl] #define uns_mulv128_decl gnat_std_decls[(int) ADT_uns_mulv128_decl] #define parent_name_id gnat_std_decls[(int) ADT_parent_name_id] +#define tag_name_id gnat_std_decls[(int) ADT_tag_name_id] #define not_handled_by_others_name_id \ gnat_std_decls[(int) ADT_not_handled_by_others_name_id] #define reraise_zcx_decl gnat_std_decls[(int) ADT_reraise_zcx_decl] @@ -1124,6 +1128,28 @@ call_is_atomic_load (tree exp) return BUILT_IN_ATOMIC_LOAD_N <= code && code <= BUILT_IN_ATOMIC_LOAD_16; } +/* Return true if TYPE is a tagged type or a CW-equivalent type. */ + +static inline bool +type_is_tagged_or_cw_equivalent (tree type) +{ + if (!RECORD_OR_UNION_TYPE_P (type)) + return false; + + tree field = TYPE_FIELDS (type); + if (!field) + return false; + + /* The tag can be put into the REP part of a record type. */ + if (DECL_INTERNAL_P (field)) + return type_is_tagged_or_cw_equivalent (TREE_TYPE (field)); + + tree name = DECL_NAME (field); + + /* See Exp_Util.Make_CW_Equivalent_Type for the CW-equivalent case. */ + return name == tag_name_id || name == parent_name_id; +} + /* Return true if TYPE is padding a self-referential type. */ static inline bool diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 3c6e87e52c0..e8baa5ca55c 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -512,6 +512,9 @@ gigi (Node_Id gnat_root, /* Name of the _Parent field in tagged record types. */ parent_name_id = get_identifier (Get_Name_String (Name_uParent)); + /* Name of the _Tag field in tagged record types. */ + tag_name_id = get_identifier (Get_Name_String (Name_uTag)); + /* Name of the Not_Handled_By_Others field in exception record types. */ not_handled_by_others_name_id = get_identifier ("not_handled_by_others"); @@ -7304,7 +7307,12 @@ gnat_to_gnu (Node_Id gnat_node) tree gnu_obj_type = TREE_TYPE (gnu_result_type); unsigned int oalign = TYPE_ALIGN (gnu_obj_type); - if (align != 0 && align < oalign && !TYPE_ALIGN_OK (gnu_obj_type)) + /* Skip tagged types because conversions to the class-wide type are + translated into conversions to the root type, which may be less + aligned than some of its derived types. */ + if (align != 0 + && align < oalign + && !type_is_tagged_or_cw_equivalent (gnu_obj_type)) post_error_ne_tree_2 ("??source alignment (^) '< alignment of & (^)", gnat_node, Designated_Type (Etype (gnat_node)), @@ -10612,8 +10620,8 @@ addressable_p (tree gnu_expr, tree gnu_type, bool compg) && (!STRICT_ALIGNMENT || TYPE_ALIGN (type) <= TYPE_ALIGN (inner_type) || TYPE_ALIGN (inner_type) >= BIGGEST_ALIGNMENT - || TYPE_ALIGN_OK (type) - || TYPE_ALIGN_OK (inner_type)))) + || type_is_tagged_or_cw_equivalent (type) + || type_is_tagged_or_cw_equivalent (inner_type)))) && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE, compg)); } diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index f501915e82f..ccb0752a11f 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -5139,7 +5139,8 @@ convert (tree type, tree expr) But don't do it if we are just annotating types since tagged types aren't fully laid out in this mode. */ else if (ecode == RECORD_TYPE && code == RECORD_TYPE - && TYPE_ALIGN_OK (etype) && TYPE_ALIGN_OK (type) + && type_is_tagged_or_cw_equivalent (etype) + && type_is_tagged_or_cw_equivalent (type) && !type_annotate_only) { tree child_etype = etype; diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc index 58418ea7236..b76054c1769 100644 --- a/gcc/ada/gcc-interface/utils2.cc +++ b/gcc/ada/gcc-interface/utils2.cc @@ -1041,9 +1041,7 @@ build_binary_op (enum tree_code op_code, tree result_type, } /* If a class-wide type may be involved, force use of the RHS type. */ - if ((TREE_CODE (right_type) == RECORD_TYPE - || TREE_CODE (right_type) == UNION_TYPE) - && TYPE_ALIGN_OK (right_type)) + if (type_is_tagged_or_cw_equivalent (right_type)) operation_type = right_type; /* If we are copying between padded objects with compatible types, use @@ -1118,7 +1116,7 @@ build_binary_op (enum tree_code op_code, tree result_type, == TREE_CODE (operand_type (result)) && TYPE_MODE (restype) == TYPE_MODE (operand_type (result)))) - || TYPE_ALIGN_OK (restype)))) + || type_is_tagged_or_cw_equivalent (restype)))) result = TREE_OPERAND (result, 0); else if (TREE_CODE (result) == VIEW_CONVERT_EXPR)