[Ada] Implement restricted aliasing for parameters

[Ada] Implement restricted aliasing for parameters

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 1632 bytes --]

In Ada, parameters can be passed by reference or by copy and, for some types, 
the mechanism is specified by the language whereas, for other types, it's up 
to the implementation.  In the former case, if the mechanism is by reference, 
full aliasing is allowed between parameters but, in the latter case, if the 
mechanism is by reference, only a limited form of aliasing is allowed (it's 
equivalent to what the language would allow if the mechanism was by copy).

So it's a weaker than 'restrict', in particular WAR (aka anti-) dependence 
must be honored between parameters, but it nevertheless makes it possible to 
vectorize certain classes of loops by making the iterations independent.
The patch implements minimal support for this by means of pragma ivdep.

Tested on x86_64-suse-linux, applied on the mainline.


2015-10-02  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/ada-tree.h (DECL_RESTRICTED_ALIASING_P): New flag.
	* gcc-interface/decl.c (gnat_to_gnu_param): For parameters passed by
	reference but whose type isn't by-ref and whose mechanism hasn't been
	forced to by-ref, set the DECL_RESTRICTED_ALIASING_P flag directly on
	them instead of changing their type.
	* gcc-interface/trans.c (scan_rhs_r): New helper function.
	(independent_iterations_p): New predicate.
	(Loop_Statement_to_gnu): For a loop with an iteration scheme, set an
	ivdep pragma if the iterations are independent.


2015-10-02  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/vect15.ad[sb]: New test.
	* gnat.dg/vect16.ad[sb]: Likewise.
	* gnat.dg/vect17.ad[sb]: Likewise.
	* gnat.dg/vect18.ad[sb]: Likewise.


-- 
Eric Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 6412 bytes --]

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 228315)
+++ gcc-interface/decl.c	(working copy)
@@ -5585,6 +5585,7 @@ gnat_to_gnu_param (Entity_Id gnat_param,
   bool ro_param = in_param && !Address_Taken (gnat_param);
   bool by_return = false, by_component_ptr = false;
   bool by_ref = false;
+  bool restricted_aliasing_p = false;
   tree gnu_param;
 
   /* Copy-return is used only for the first parameter of a valued procedure.
@@ -5675,15 +5676,12 @@ gnat_to_gnu_param (Entity_Id gnat_param,
 		   || (!foreign
 		       && default_pass_by_ref (gnu_param_type)))))
     {
+      gnu_param_type = build_reference_type (gnu_param_type);
       /* We take advantage of 6.2(12) by considering that references built for
 	 parameters whose type isn't by-ref and for which the mechanism hasn't
-	 been forced to by-ref are restrict-qualified in the C sense.  */
-      bool restrict_p
+	 been forced to by-ref allow only a restricted form of aliasing.  */
+      restricted_aliasing_p
 	= !TYPE_IS_BY_REFERENCE_P (gnu_param_type) && mech != By_Reference;
-      gnu_param_type = build_reference_type (gnu_param_type);
-      if (restrict_p)
-	gnu_param_type
-	  = change_qualified_type (gnu_param_type, TYPE_QUAL_RESTRICT);
       by_ref = true;
     }
 
@@ -5731,6 +5729,7 @@ gnat_to_gnu_param (Entity_Id gnat_param,
   DECL_POINTS_TO_READONLY_P (gnu_param)
     = (ro_param && (by_ref || by_component_ptr));
   DECL_CAN_NEVER_BE_NULL_P (gnu_param) = Can_Never_Be_Null (gnat_param);
+  DECL_RESTRICTED_ALIASING_P (gnu_param) = restricted_aliasing_p;
 
   /* If no Mechanism was specified, indicate what we're using, then
      back-annotate it.  */
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 228373)
+++ gcc-interface/trans.c	(working copy)
@@ -2714,6 +2714,89 @@ can_be_lower_p (tree val1, tree val2)
   return tree_int_cst_lt (val1, val2);
 }
 
+/* Helper function for walk_tree, used by independent_iterations_p below.  */
+
+static tree
+scan_rhs_r (tree *tp, int *walk_subtrees, void *data)
+{
+  bitmap *params = (bitmap *)data;
+  tree t = *tp;
+
+  /* No need to walk into types or decls.  */
+  if (IS_TYPE_OR_DECL_P (t))
+    *walk_subtrees = 0;
+
+  if (TREE_CODE (t) == PARM_DECL && bitmap_bit_p (*params, DECL_UID (t)))
+    return t;
+
+  return NULL_TREE;
+}
+
+/* Return true if STMT_LIST generates independent iterations in a loop.  */
+
+static bool
+independent_iterations_p (tree stmt_list)
+{
+  tree_stmt_iterator tsi;
+  bitmap params = BITMAP_GGC_ALLOC();
+  auto_vec<tree> rhs;
+  tree iter;
+  int i;
+
+  if (TREE_CODE (stmt_list) == BIND_EXPR)
+    stmt_list = BIND_EXPR_BODY (stmt_list);
+
+  /* Scan the list and return false on anything that is not either a check
+     or an assignment to a parameter with restricted aliasing.  */
+  for (tsi = tsi_start (stmt_list); !tsi_end_p (tsi); tsi_next (&tsi))
+    {
+      tree stmt = tsi_stmt (tsi);
+
+      switch (TREE_CODE (stmt))
+	{
+	case COND_EXPR:
+	  {
+	    if (COND_EXPR_ELSE (stmt))
+	      return false;
+	    if (TREE_CODE (COND_EXPR_THEN (stmt)) != CALL_EXPR)
+	      return false;
+	    tree func = get_callee_fndecl (COND_EXPR_THEN (stmt));
+	    if (!(func && TREE_THIS_VOLATILE (func)))
+	      return false;
+	    break;
+	  }
+
+	case MODIFY_EXPR:
+	  {
+	    tree lhs = TREE_OPERAND (stmt, 0);
+	    while (handled_component_p (lhs))
+	      lhs = TREE_OPERAND (lhs, 0);
+	    if (TREE_CODE (lhs) != INDIRECT_REF)
+	      return false;
+	    lhs = TREE_OPERAND (lhs, 0);
+	    if (!(TREE_CODE (lhs) == PARM_DECL
+		  && DECL_RESTRICTED_ALIASING_P (lhs)))
+	      return false;
+	    bitmap_set_bit (params, DECL_UID (lhs));
+	    rhs.safe_push (TREE_OPERAND (stmt, 1));
+	    break;
+	  }
+
+	default:
+	  return false;
+	}
+    }
+
+  /* At this point we know that the list contains only statements that will
+     modify parameters with restricted aliasing.  Check that the statements
+     don't at the time read from these parameters.  */
+  FOR_EACH_VEC_ELT (rhs, i, iter)
+    if (walk_tree_without_duplicates (&iter, scan_rhs_r, &params))
+      return false;
+
+  return true;
+}
+
 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Loop_Statement,
    to a GCC tree, which is returned.  */
 
@@ -3038,6 +3121,13 @@ Loop_Statement_to_gnu (Node_Id gnat_node
 	    add_stmt_with_node_force (rci->invariant_cond, gnat_node);
 	  }
 
+      /* Second, if loop vectorization is enabled and the iterations of the
+	 loop can easily be proved as independent, mark the loop.  */
+      if (optimize
+	  && flag_tree_loop_vectorize
+	  && independent_iterations_p (LOOP_STMT_BODY (gnu_loop_stmt)))
+	LOOP_STMT_IVDEP (gnu_loop_stmt) = 1;
+
       add_stmt (gnu_loop_stmt);
       gnat_poplevel ();
       gnu_loop_stmt = end_stmt_group ();
Index: gcc-interface/ada-tree.h
===================================================================
--- gcc-interface/ada-tree.h	(revision 228315)
+++ gcc-interface/ada-tree.h	(working copy)
@@ -369,6 +369,21 @@ do {						   \
    in the main unit, i.e. the full declaration is available.  */
 #define DECL_TAFT_TYPE_P(NODE) DECL_LANG_FLAG_0 (TYPE_DECL_CHECK (NODE))
 
+/* Nonzero in a PARM_DECL passed by reference but for which only a restricted
+   form of aliasing is allowed.  The first restriction comes explicitly from
+   the RM 6.2(12) clause: there is no read-after-write dependency between a
+   store based on such a PARM_DECL and a load not based on this PARM_DECL,
+   so stores based on such PARM_DECLs can be sunk past all loads based on
+   a distinct object.  The second restriction can be inferred from the same
+   clause: there is no write-after-write dependency between a store based
+   on such a PARM_DECL and a store based on a distinct such PARM_DECL, as
+   the compiler would be allowed to pass the parameters by copy and the
+   order of assignment to actual parameters after a call is arbitrary as
+   per the RM 6.4.1(17) clause, so stores based on distinct such PARM_DECLs
+   can be swapped.  */
+#define DECL_RESTRICTED_ALIASING_P(NODE) \
+  DECL_LANG_FLAG_0 (PARM_DECL_CHECK (NODE))
+
 /* Nonzero in a DECL if it is always used by reference, i.e. an INDIRECT_REF
    is needed to access the object.  */
 #define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE)

[-- Attachment #3: vect15.ads --]
[-- Type: text/x-adasrc, Size: 163 bytes --]

package Vect15 is

   type Sarray is array (1 .. 4) of Long_Float;
   for Sarray'Alignment use 16;

   procedure Add (X, Y : Sarray; R : out Sarray);

end Vect15;

[-- Attachment #4: vect15.adb --]
[-- Type: text/x-adasrc, Size: 362 bytes --]

-- { dg-do compile { target i?86-*-* x86_64-*-* } }
-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }

package body Vect15 is

   procedure Add (X, Y : Sarray; R : out Sarray) is
   begin
      for I in Sarray'Range loop
         R(I) := X(I) + Y(I);
      end loop;
   end;

end Vect15;

-- { dg-final { scan-tree-dump-not "possible aliasing" "vect"  } }

[-- Attachment #5: vect17.ads --]
[-- Type: text/x-adasrc, Size: 179 bytes --]

package Vect17 is

   type Sarray is array (1 .. 4) of Long_Float;
   for Sarray'Alignment use 16;

   procedure Add (X, Y : aliased Sarray; R : aliased out Sarray);

end Vect17;

[-- Attachment #6: vect16.adb --]
[-- Type: text/x-adasrc, Size: 398 bytes --]

-- { dg-do compile { target i?86-*-* x86_64-*-* } }
-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }

package body Vect16 is

   procedure Add_Sub (X, Y : Sarray; R,S : out Sarray) is
   begin
      for I in Sarray'Range loop
         R(I) := X(I) + Y(I);
         S(I) := X(I) - Y(I);
      end loop;
   end;

end Vect16;

-- { dg-final { scan-tree-dump-not "possible aliasing" "vect"  } }

[-- Attachment #7: vect16.ads --]
[-- Type: text/x-adasrc, Size: 169 bytes --]

package Vect16 is

   type Sarray is array (1 .. 4) of Long_Float;
   for Sarray'Alignment use 16;

   procedure Add_Sub (X, Y : Sarray; R,S : out Sarray);

end Vect16;

[-- Attachment #8: vect17.adb --]
[-- Type: text/x-adasrc, Size: 374 bytes --]

-- { dg-do compile { target i?86-*-* x86_64-*-* } }
-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }

package body Vect17 is

   procedure Add (X, Y : aliased Sarray; R : aliased out Sarray) is
   begin
      for I in Sarray'Range loop
         R(I) := X(I) + Y(I);
      end loop;
   end;

end Vect17;

-- { dg-final { scan-tree-dump "possible aliasing" "vect"  } }

[-- Attachment #9: vect18.adb --]
[-- Type: text/x-adasrc, Size: 432 bytes --]

-- { dg-do compile { target i?86-*-* x86_64-*-* } }
-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }

package body Vect18 is

   procedure Comp (X, Y : Sarray; R : in out Sarray) is
      Tmp : Long_Float := R(4);
   begin
      for I in 1 .. 3 loop
         R(I+1) := R(I) + X(I) + Y(I);
      end loop;
      R(1) := Tmp + X(4) + Y(4);
   end;

end Vect18;

-- { dg-final { scan-tree-dump "bad data dependence" "vect"  } }

[-- Attachment #10: vect18.ads --]
[-- Type: text/x-adasrc, Size: 167 bytes --]

package Vect18 is

   type Sarray is array (1 .. 4) of Long_Float;
   for Sarray'Alignment use 16;

   procedure Comp (X, Y : Sarray; R : in out Sarray);

end Vect18;