[PATCH] Fix FIXME in call handling of the alias-oracle

[Richard Guenther]

This supplements the alias-oracle call handling with proper handling
for indirect references.  Somehow this escaped me before.

Bootstrapped and tested on x86_64-unknown-linux-gnu, applied to trunk.

This exposes TBAA issues in the Fortran frontend, notably
gfortran.dg/proc_ptr_result_1.f90 will now segfault.  Reduced
testcase:

program proc_ptr_14
implicit none
procedure(integer),pointer :: p,p2
p => k(p2)
if (p(-10)/=p2(-10)) call abort()
contains
  function k(arg)
    procedure(),pointer :: k,arg
    k => iabs
    arg => k
  end function
end

when inlining k into main we have

  integer(kind=4) (*<T3cb>) (void) p2;
  void (*<T63>) (void) * arg;
...
  arg_8 = (void (*<T63>) (void) *) &p2;
  ppr@_9 = (void (*<T63>) (void)) _gfortran_specific__abs_i4;
  *arg_8 = ppr@_9;
  p_10 = (integer(kind=4) (*<T3cb>) (void)) _gfortran_specific__abs_i4;
  D.1585_11 = p_10 (&C.1552);
  p2.0_12 = p2;

where we now disambiguate *arg_8 with the call p_10 (&C.1552) and so
DSE deletes the store to *arg_8 because there is no use.  TBAA
says that integer(kind=4) (*<T3cb>) (void) and void (*<T63>) (void)
do not conflict.

It's already broken with a different simpler testcase not calling p_10
(just do if (p2(-10)/=10) call abort()), so I will not hold back
this patch.

Richard.

2009-06-25  Richard Guenther  <rguenther@suse.de>

	* tree-ssa-alias.c (ref_maybe_used_by_call_p_1): Disambiguate
	indirect references against the callused/escaped solutions.
	(call_may_clobber_ref_p_1): Likewise.

Index: trunk/gcc/tree-ssa-alias.c
===================================================================
--- trunk.orig/gcc/tree-ssa-alias.c	2009-06-25 12:48:30.000000000 +0200
+++ trunk/gcc/tree-ssa-alias.c	2009-06-25 12:48:06.000000000 +0200
@@ -865,12 +865,8 @@ ref_maybe_used_by_call_p_1 (gimple call,
       && (flags & (ECF_CONST|ECF_NOVOPS)))
     goto process_args;
 
-  /* If the reference is not based on a decl give up.
-     ???  Handle indirect references by intersecting the call-used
-     	  solution with that of the pointer.  */
   base = get_base_address (ref);
-  if (!base
-      || !DECL_P (base))
+  if (!base)
     return true;
 
   /* If the reference is based on a decl that is not aliased the call
@@ -952,12 +948,45 @@ ref_maybe_used_by_call_p_1 (gimple call,
      it may be used.  */
   if (flags & (ECF_PURE|ECF_CONST|ECF_LOOPING_CONST_OR_PURE|ECF_NOVOPS))
     {
-      if (is_call_used (base))
+      if (DECL_P (base))
+	{
+	  if (is_call_used (base))
+	    return true;
+	}
+      else if (INDIRECT_REF_P (base)
+	       && TREE_CODE (TREE_OPERAND (base, 0)) == SSA_NAME)
+	{
+	  struct ptr_info_def *pi = SSA_NAME_PTR_INFO (TREE_OPERAND (base, 0));
+	  if (!pi)
+	    return true;
+
+	  if (pt_solution_includes_global (&pi->pt)
+	      || pt_solutions_intersect (&cfun->gimple_df->callused, &pi->pt)
+	      || pt_solutions_intersect (&cfun->gimple_df->escaped, &pi->pt))
+	    return true;
+	}
+      else
 	return true;
     }
   else
     {
-      if (is_call_clobbered (base))
+      if (DECL_P (base))
+	{
+	  if (is_call_clobbered (base))
+	    return true;
+	}
+      else if (INDIRECT_REF_P (base)
+	       && TREE_CODE (TREE_OPERAND (base, 0)) == SSA_NAME)
+	{
+	  struct ptr_info_def *pi = SSA_NAME_PTR_INFO (TREE_OPERAND (base, 0));
+	  if (!pi)
+	    return true;
+
+	  if (pt_solution_includes_global (&pi->pt)
+	      || pt_solutions_intersect (&cfun->gimple_df->escaped, &pi->pt))
+	    return true;
+	}
+      else
 	return true;
     }
 
@@ -1155,6 +1184,16 @@ call_may_clobber_ref_p_1 (gimple call, a
 
   if (DECL_P (base))
     return is_call_clobbered (base);
+  else if (INDIRECT_REF_P (base)
+	   && TREE_CODE (TREE_OPERAND (base, 0)) == SSA_NAME)
+    {
+      struct ptr_info_def *pi = SSA_NAME_PTR_INFO (TREE_OPERAND (base, 0));
+      if (!pi)
+	return true;
+
+      return (pt_solution_includes_global (&pi->pt)
+	      || pt_solutions_intersect (&cfun->gimple_df->escaped, &pi->pt));
+    }
 
   return true;
 }