From: Eric Botcazou <ebotcazou@adacore.com>
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) <N_Unchecked_Type_Conversion>: 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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/ada-tree.h | 3 ---
gcc/ada/gcc-interface/decl.cc | 8 --------
gcc/ada/gcc-interface/gigi.h | 26 ++++++++++++++++++++++++++
gcc/ada/gcc-interface/trans.cc | 14 +++++++++++---
gcc/ada/gcc-interface/utils.cc | 3 ++-
gcc/ada/gcc-interface/utils2.cc | 6 ++----
6 files changed, 41 insertions(+), 19 deletions(-)
@@ -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) \
@@ -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;
@@ -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
@@ -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));
}
@@ -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;
@@ -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)