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) <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.

diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 205136bc8ef234bd0963d25fb33c08edc7178062..8f930dd8541b0165ce984d1b74de795c5e94f063 100644 (file)
--- 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 86cbf5ba4fb577c608d731e7efac3649c240cc04..771325d8ce6cdd9fa4e62ea70c4f1fc8ac7cb358 100644 (file)
--- 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 45b1bfd23e3a7d20edebbe591b9237d4d9334daa..2533bd49434d1965d1d94c4aba46f8f7ab9913bc 100644 (file)
--- 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 3c6e87e52c0ac5845dc93f7e222be01f02a4ae50..e8baa5ca55cd27da66993dec680b1b053380e292 100644 (file)
--- 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 f501915e82f529dea65ef19468b7f8391c8aa84d..ccb0752a11f040ff46ec90ccaa9672cc939bb8ce 100644 (file)
--- 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 58418ea7236bfc04a2036286d2ed378cefcb5ca3..b76054c1769b88178ff4ab10e55fcd0cbc0e70bd 100644 (file)
--- 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)