[Ada] Fix ACATS c41103a & c41103b on some 64-bit platforms

[Eric Botcazou <ebotcazou at adacore dot com>]

It's a double aliasing issue pertaining to the TYPE_NONALIASED_COMPONENT flag.

This flag is the counterpart of DECL_NONADDRESSABLE_P for array, but it is set 
on the array type instead of on the individual components like the other.  It 
is meant to declare that the components of the array cannot be indirectly 
accessed individually; as a consequence, an access to such a component cannot 
conflict with the dereference of a pointer whose type is that of the 
component.  The implementation is the same as that of DECL_NONADDRESSABLE_P 
(see alias.c); only Ada (heavily) and Java (sparingly) use it.

The first problem is that the structural aliasing machinery doesn't consider 
that the SMT built for the array type can alias the SFTs of the components, 
because the alias sets don't conflict (see record_component_aliases).  The
fix is exactly the same as for DECL_NONADDRESSABLE_P, i.e. to give the SFTs 
the alias set of the array type.

The second problem is in Gigi, where we set TYPE_NONALIASED_COMPONENT on 
multi-dimensional arrays while we take the address of some components in the 
outer dimension.

Bootstrapped/regtested on x86_64-suse-linux, applied to mainline, as obvious 
for the tree-ssa-structalias.c part since it mimics DECL_NONADDRESSABLE_P.


2007-09-11  Eric Botcazou  <ebotcazou@adacore.com>

	* tree-ssa-structalias.c (push_fields_onto_fieldstack): Deal with
	TYPE_NONALIASED_COMPONENT like with DECL_NONADDRESSABLE_P.

ada/
        * decl.c (array_type_has_nonaliased_component): New predicate.
        (gnat_to_gnu_field) <E_Array_Type>: Invoke the above predicate to
        set the TYPE_NONALIASED_COMPONENT flag on the type.
        <E_Array_Subtype>: Likewise.
        * gigi.h (type_for_nonaliased_component_p): Declare.
        * utils.c (type_for_nonaliased_component_p): New predicate.
        (create_field_decl): Invoke the above predicate to set the
        DECL_NONADDRESSABLE_P flag on the field.


-- 
Eric Botcazou

Index: tree-ssa-structalias.c
===================================================================
--- tree-ssa-structalias.c	(revision 128261)
+++ tree-ssa-structalias.c	(working copy)
@@ -4114,7 +4114,9 @@ push_fields_onto_fieldstack (tree type, 
 	  else if (!(pushed = push_fields_onto_fieldstack
 		     (TREE_TYPE (type), fieldstack,
 		      offset + i * TREE_INT_CST_LOW (elsz), has_union,
-		      TREE_TYPE (type))))
+		      (TYPE_NONALIASED_COMPONENT (type)
+		       ? addressable_type
+		       : TREE_TYPE (type)))))
 	    /* Empty structures may have actual size, like in C++. So
 	       see if we didn't push any subfields and the size is
 	       nonzero, push the field onto the stack */
@@ -4129,7 +4131,10 @@ push_fields_onto_fieldstack (tree type, 
 	      pair->size = elsz;
 	      pair->decl = NULL_TREE;
 	      pair->offset = offset + i * TREE_INT_CST_LOW (elsz);
-	      pair->alias_set = -1;
+	      if (TYPE_NONALIASED_COMPONENT (type))
+		pair->alias_set = get_alias_set (addressable_type);
+	      else
+		pair->alias_set = -1;
 	      count++;
 	    }
 	  else
Index: ada/decl.c
===================================================================
--- ada/decl.c	(revision 128327)
+++ ada/decl.c	(working copy)
@@ -103,6 +103,7 @@ static tree gnat_to_gnu_field (Entity_Id
 static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
 			       bool *);
 static bool same_discriminant_p (Entity_Id, Entity_Id);
+static bool array_type_has_nonaliased_component (Entity_Id, tree);
 static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
 				  bool, bool, bool, bool);
 static Uint annotate_value (tree);
@@ -1788,16 +1789,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	  {
 	    tem = build_array_type (tem, gnu_index_types[index]);
 	    TYPE_MULTI_ARRAY_P (tem) = (index > 0);
-
-	    /* If the type below this is a multi-array type, then this
-	       does not have aliased components.  But we have to make
-	       them addressable if it must be passed by reference or
-	       if that is the default.  */
-	    if ((TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE
-		 && TYPE_MULTI_ARRAY_P (TREE_TYPE (tem)))
-		|| (!Has_Aliased_Components (gnat_entity)
-		    && !must_pass_by_ref (TREE_TYPE (tem))
-		    && !default_pass_by_ref (TREE_TYPE (tem))))
+	    if (array_type_has_nonaliased_component (gnat_entity, tem))
 	      TYPE_NONALIASED_COMPONENT (tem) = 1;
 	  }
 
@@ -2123,16 +2115,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	    {
 	      gnu_type = build_array_type (gnu_type, gnu_index_type[index]);
 	      TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
-
-	      /* If the type below this is a multi-array type, then this
-		 does not have aliased components.  But we have to make
-		 them addressable if it must be passed by reference or
-		 if that is the default.  */
-	      if ((TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
-		   && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
-		  || (!Has_Aliased_Components (gnat_entity)
-		      && !must_pass_by_ref (TREE_TYPE (gnu_type))
-		      && !default_pass_by_ref (TREE_TYPE (gnu_type))))
+	      if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
 		TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
 	    }
 
@@ -4625,6 +4608,24 @@ same_discriminant_p (Entity_Id discr1, E
   return
     Original_Record_Component (discr1) == Original_Record_Component (discr2);
 }
+
+/* Return true if the array type specified by GNAT_TYPE and GNU_TYPE has
+   a non-aliased component in the back-end sense.  */
+
+static bool
+array_type_has_nonaliased_component (Entity_Id gnat_type, tree gnu_type)
+{
+  /* If the type below this is a multi-array type, then
+     this does not have aliased components.  */
+  if (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
+      && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
+    return true;
+
+  if (Has_Aliased_Components (gnat_type))
+    return false;
+
+  return type_for_nonaliased_component_p (TREE_TYPE (gnu_type));
+}
 
 /* Given GNAT_ENTITY, elaborate all expressions that are required to
    be elaborated at the point of its definition, but do nothing else.  */
Index: ada/gigi.h
===================================================================
--- ada/gigi.h	(revision 128261)
+++ ada/gigi.h	(working copy)
@@ -704,6 +704,10 @@ extern tree unchecked_convert (tree type
    the latter being a record type as predicated by Is_Record_Type.  */
 extern enum tree_code tree_code_for_record_type (Entity_Id);
 
+/* Return true if GNU_TYPE is suitable as the type of a non-aliased
+   component of an aggregate type.  */
+extern bool type_for_nonaliased_component_p (tree);
+
 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR or other logical
    operation.
 
Index: ada/utils.c
===================================================================
--- ada/utils.c	(revision 128261)
+++ ada/utils.c	(working copy)
@@ -1625,21 +1625,14 @@ create_field_decl (tree field_name, tree
     }
 
   /* In addition to what our caller says, claim the field is addressable if we
-     know we might ever attempt to take its address, then mark the decl as
-     nonaddressable accordingly.
+     know that its type is not suitable.
 
      The field may also be "technically" nonaddressable, meaning that even if
      we attempt to take the field's address we will actually get the address
      of a copy.  This is the case for true bitfields, but the DECL_BIT_FIELD
      value we have at this point is not accurate enough, so we don't account
      for this here and let finish_record_type decide.  */
-
-  /* We will take the address in any argument passing sequence if the field
-     type is passed by reference, and we might need the address for any array
-     type, even if normally passed by-copy, to construct a fat pointer if the
-     field is used as an actual for an unconstrained formal.  */
-  if (TREE_CODE (field_type) == ARRAY_TYPE
-      || must_pass_by_ref (field_type) || default_pass_by_ref (field_type))
+  if (!type_for_nonaliased_component_p (field_type))
     addressable = 1;
 
   DECL_NONADDRESSABLE_P (field_decl) = !addressable;
@@ -4004,6 +3997,26 @@ tree_code_for_record_type (Entity_Id gna
   return UNION_TYPE;
 }
 
+/* Return true if GNU_TYPE is suitable as the type of a non-aliased
+   component of an aggregate type.  */
+
+bool
+type_for_nonaliased_component_p (tree gnu_type)
+{
+  /* If the type is passed by reference, we may have pointers to the
+     component so it cannot be made non-aliased. */
+  if (must_pass_by_ref (gnu_type) || default_pass_by_ref (gnu_type))
+    return false;
+
+  /* We might need the address for any array type, even if normally
+     passed by copy, to construct a fat pointer if the component is
+     used as an actual for an unconstrained formal.  */
+  if (TREE_CODE (gnu_type) == ARRAY_TYPE)
+    return false;
+
+  return true;
+}
+
 /* Perform final processing on global variables.  */
 
 void