re PR fortran/67170 (PRE can't hoist out a readonly argument)

2015-09-29  Richard Biener  <rguenther@suse.de>

	PR tree-optimization/67170
	* tree-ssa-alias.h (get_continuation_for_phi): Adjust
	the translate function pointer parameter to get the
	bool whether to disambiguate only by reference.
	(walk_non_aliased_vuses): Likewise.
	* tree-ssa-alias.c (maybe_skip_until): Adjust.
	(get_continuation_for_phi_1): Likewise.
	(get_continuation_for_phi): Likewise.
	(walk_non_aliased_vuses): Likewise.
	* tree-ssa-sccvn.c (const_parms): New bitmap.
	(vn_reference_lookup_3): Adjust for interface change.
	Disambiguate parameters pointing to readonly memory.
	(free_scc_vn): Free const_parms.
	(run_scc_vn): Initialize const_parms from a fn spec attribute.

	* gfortran.dg/pr67170.f90: New testcase.

From-SVN: r228244

gcc/ChangeLog

@@ -1,3 +1,20 @@
+2015-09-29  Richard Biener  <rguenther@suse.de>
+
+	PR tree-optimization/67170
+	* tree-ssa-alias.h (get_continuation_for_phi): Adjust
+	the translate function pointer parameter to get the
+	bool whether to disambiguate only by reference.
+	(walk_non_aliased_vuses): Likewise.
+	* tree-ssa-alias.c (maybe_skip_until): Adjust.
+	(get_continuation_for_phi_1): Likewise.
+	(get_continuation_for_phi): Likewise.
+	(walk_non_aliased_vuses): Likewise.
+	* tree-ssa-sccvn.c (const_parms): New bitmap.
+	(vn_reference_lookup_3): Adjust for interface change.
+	Disambiguate parameters pointing to readonly memory.
+	(free_scc_vn): Free const_parms.
+	(run_scc_vn): Initialize const_parms from a fn spec attribute.
+
 2015-09-29  Richard Biener  <rguenther@suse.de>
 
 	PR tree-optimization/67741

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2015-09-29  Richard Biener  <rguenther@suse.de>
+
+	PR tree-optimization/67170
+	* gfortran.dg/pr67170.f90: New testcase.
+
 2015-09-29  Richard Biener  <rguenther@suse.de>
 
 	PR tree-optimization/67741

gcc/testsuite/gfortran.dg/pr67170.f90

@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-O -fdump-tree-fre1" }
+
+module test_module
+  integer, parameter :: r=10
+   integer :: data(r, r), block(r, r, r)
+  contains
+recursive subroutine foo(arg) 
+integer, intent(in) :: arg
+integer :: loop, x(r), y(r)
+
+   where(data(arg, :) /= 0)
+      x = data(arg, :)
+       y = l
+   elsewhere
+      x = 1
+      y = r
+   end where
+
+do loop = x(1), y(1)
+   if(block(arg, 1, loop) <= 0) cycle
+   block(arg, 1:4, loop) =  block(arg, 1:4, i1) + 1
+   call foo(arg + 2)     
+   block(arg, 1:4, loop) = block(arg, 1:4, i1) + 10
+end do
+end subroutine foo
+
+end module test_module
+end program
+
+! { dg-final { scan-tree-dump-times "= \\*arg_\[0-9\]+\\(D\\);" 1 "fre1" } }

gcc/tree-ssa-alias.c

@@ -2442,7 +2442,7 @@ static bool
 maybe_skip_until (gimple *phi, tree target, ao_ref *ref,
 		  tree vuse, unsigned int *cnt, bitmap *visited,
 		  bool abort_on_visited,
-		  void *(*translate)(ao_ref *, tree, void *, bool),
+		  void *(*translate)(ao_ref *, tree, void *, bool *),
 		  void *data)
 {
   basic_block bb = gimple_bb (phi);
@@ -2477,8 +2477,9 @@ maybe_skip_until (gimple *phi, tree target, ao_ref *ref,
 	  ++*cnt;
 	  if (stmt_may_clobber_ref_p_1 (def_stmt, ref))
 	    {
+	      bool disambiguate_only = true;
 	      if (translate
-		  && (*translate) (ref, vuse, data, true) == NULL)
+		  && (*translate) (ref, vuse, data, &disambiguate_only) == NULL)
 		;
 	      else
 		return false;
@@ -2505,7 +2506,7 @@ static tree
 get_continuation_for_phi_1 (gimple *phi, tree arg0, tree arg1,
 			    ao_ref *ref, unsigned int *cnt,
 			    bitmap *visited, bool abort_on_visited,
-			    void *(*translate)(ao_ref *, tree, void *, bool),
+			    void *(*translate)(ao_ref *, tree, void *, bool *),
 			    void *data)
 {
   gimple *def0 = SSA_NAME_DEF_STMT (arg0);
@@ -2547,13 +2548,14 @@ get_continuation_for_phi_1 (gimple *phi, tree arg0, tree arg1,
   else if ((common_vuse = gimple_vuse (def0))
 	   && common_vuse == gimple_vuse (def1))
     {
+      bool disambiguate_only = true;
       *cnt += 2;
       if ((!stmt_may_clobber_ref_p_1 (def0, ref)
 	   || (translate
-	       && (*translate) (ref, arg0, data, true) == NULL))
+	       && (*translate) (ref, arg0, data, &disambiguate_only) == NULL))
 	  && (!stmt_may_clobber_ref_p_1 (def1, ref)
 	      || (translate
-		  && (*translate) (ref, arg1, data, true) == NULL)))
+		  && (*translate) (ref, arg1, data, &disambiguate_only) == NULL)))
 	return common_vuse;
     }
 
@@ -2571,7 +2573,7 @@ tree
 get_continuation_for_phi (gimple *phi, ao_ref *ref,
 			  unsigned int *cnt, bitmap *visited,
 			  bool abort_on_visited,
-			  void *(*translate)(ao_ref *, tree, void *, bool),
+			  void *(*translate)(ao_ref *, tree, void *, bool *),
 			  void *data)
 {
   unsigned nargs = gimple_phi_num_args (phi);
@@ -2648,7 +2650,7 @@ get_continuation_for_phi (gimple *phi, ao_ref *ref,
 void *
 walk_non_aliased_vuses (ao_ref *ref, tree vuse,
 			void *(*walker)(ao_ref *, tree, unsigned int, void *),
-			void *(*translate)(ao_ref *, tree, void *, bool),
+			void *(*translate)(ao_ref *, tree, void *, bool *),
 			tree (*valueize)(tree),
 			void *data)
 {
@@ -2690,7 +2692,8 @@ walk_non_aliased_vuses (ao_ref *ref, tree vuse,
 	    {
 	      if (!translate)
 		break;
-	      res = (*translate) (ref, vuse, data, false);
+	      bool disambiguate_only = false;
+	      res = (*translate) (ref, vuse, data, &disambiguate_only);
 	      /* Failed lookup and translation.  */
 	      if (res == (void *)-1)
 		{
@@ -2701,7 +2704,7 @@ walk_non_aliased_vuses (ao_ref *ref, tree vuse,
 	      else if (res != NULL)
 		break;
 	      /* Translation succeeded, continue walking.  */
-	      translated = true;
+	      translated = translated || !disambiguate_only;
 	    }
 	  vuse = gimple_vuse (def_stmt);
 	}

gcc/tree-ssa-alias.h

@@ -118,12 +118,12 @@ extern bool stmt_kills_ref_p (gimple *, tree);
 extern bool stmt_kills_ref_p (gimple *, ao_ref *);
 extern tree get_continuation_for_phi (gimple *, ao_ref *,
 				      unsigned int *, bitmap *, bool,
-				      void *(*)(ao_ref *, tree, void *, bool),
+				      void *(*)(ao_ref *, tree, void *, bool *),
 				      void *);
 extern void *walk_non_aliased_vuses (ao_ref *, tree,
 				     void *(*)(ao_ref *, tree,
 					       unsigned int, void *),
-				     void *(*)(ao_ref *, tree, void *, bool),
+				     void *(*)(ao_ref *, tree, void *, bool *),
 				     tree (*)(tree),
 				     void *);
 extern unsigned int walk_aliased_vdefs (ao_ref *, tree,

gcc/tree-ssa-sccvn.c

@@ -120,6 +120,7 @@ along with GCC; see the file COPYING3.  If not see
 static tree *last_vuse_ptr;
 static vn_lookup_kind vn_walk_kind;
 static vn_lookup_kind default_vn_walk_kind;
+bitmap const_parms;
 
 /* vn_nary_op hashtable helpers.  */
 
@@ -1656,21 +1657,35 @@ vn_reference_lookup_or_insert_for_pieces (tree vuse,
 /* Callback for walk_non_aliased_vuses.  Tries to perform a lookup
    from the statement defining VUSE and if not successful tries to
    translate *REFP and VR_ through an aggregate copy at the definition
-   of VUSE.  */
+   of VUSE.  If *DISAMBIGUATE_ONLY is true then do not perform translation
+   of *REF and *VR.  If only disambiguation was performed then
+   *DISAMBIGUATE_ONLY is set to true.  */
 
 static void *
 vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *vr_,
-		       bool disambiguate_only)
+		       bool *disambiguate_only)
 {
   vn_reference_t vr = (vn_reference_t)vr_;
   gimple *def_stmt = SSA_NAME_DEF_STMT (vuse);
-  tree base;
+  tree base = ao_ref_base (ref);
   HOST_WIDE_INT offset, maxsize;
   static vec<vn_reference_op_s>
     lhs_ops = vNULL;
   ao_ref lhs_ref;
   bool lhs_ref_ok = false;
 
+  /* If the reference is based on a parameter that was determined as
+     pointing to readonly memory it doesn't change.  */
+  if (TREE_CODE (base) == MEM_REF
+      && TREE_CODE (TREE_OPERAND (base, 0)) == SSA_NAME
+      && SSA_NAME_IS_DEFAULT_DEF (TREE_OPERAND (base, 0))
+      && bitmap_bit_p (const_parms,
+		       SSA_NAME_VERSION (TREE_OPERAND (base, 0))))
+    {
+      *disambiguate_only = true;
+      return NULL;
+    }
+
   /* First try to disambiguate after value-replacing in the definitions LHS.  */
   if (is_gimple_assign (def_stmt))
     {
@@ -1687,7 +1702,10 @@ vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *vr_,
 						      TREE_TYPE (lhs), lhs_ops);
 	  if (lhs_ref_ok
 	      && !refs_may_alias_p_1 (ref, &lhs_ref, true))
-	    return NULL;
+	    {
+	      *disambiguate_only = true;
+	      return NULL;
+	    }
 	}
       else
 	{
@@ -1723,14 +1741,16 @@ vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *vr_,
 	  for (unsigned i = 0; i < gimple_call_num_args (def_stmt); ++i)
 	    gimple_call_set_arg (def_stmt, i, oldargs[i]);
 	  if (!res)
-	    return NULL;
+	    {
+	      *disambiguate_only = true;
+	      return NULL;
+	    }
 	}
     }
 
-  if (disambiguate_only)
+  if (*disambiguate_only)
     return (void *)-1;
 
-  base = ao_ref_base (ref);
   offset = ref->offset;
   maxsize = ref->max_size;
 
@@ -4342,6 +4362,8 @@ free_scc_vn (void)
   XDELETE (valid_info);
   free_vn_table (optimistic_info);
   XDELETE (optimistic_info);
+
+  BITMAP_FREE (const_parms);
 }
 
 /* Set *ID according to RESULT.  */
@@ -4677,6 +4699,29 @@ run_scc_vn (vn_lookup_kind default_vn_walk_kind_)
 
   init_scc_vn ();
 
+  /* Collect pointers we know point to readonly memory.  */
+  const_parms = BITMAP_ALLOC (NULL);
+  tree fnspec = lookup_attribute ("fn spec",
+				  TYPE_ATTRIBUTES (TREE_TYPE (cfun->decl)));
+  if (fnspec)
+    {
+      fnspec = TREE_VALUE (TREE_VALUE (fnspec));
+      i = 1;
+      for (tree arg = DECL_ARGUMENTS (cfun->decl);
+	   arg; arg = DECL_CHAIN (arg), ++i)
+	{
+	  if (i >= (unsigned) TREE_STRING_LENGTH (fnspec))
+	    break;
+	  if (TREE_STRING_POINTER (fnspec)[i]  == 'R'
+	      || TREE_STRING_POINTER (fnspec)[i] == 'r')
+	    {
+	      tree name = ssa_default_def (cfun, arg);
+	      if (name)
+		bitmap_set_bit (const_parms, SSA_NAME_VERSION (name));
+	    }
+	}
+    }
+
   /* Mark all edges as possibly executable.  */
   FOR_ALL_BB_FN (bb, cfun)
     {