[patch] Fix over-optimization of calls to pure function

[Eric Botcazou]

Hi,

this fixes an over-optimization of the GIMPLE optimizer, whereby two otherwise 
identical calls to a pure function present in different EH regions are CSEd, 
which changes the semantics of the program because the second EH handler is 
not invoked:

  begin
    I := F(0);
  exception
    when E => N := N + 1;
  end;

  begin
    I := F(0);
  exception
    when E => N := N +1;
  end;

Two passes (DOM and FRE) can optimize this construct and a test modelled on 
stmt_can_throw_internal is used to coax them into not doing so.

Tested on x86_64-suse-linux, OK for the mainline?


2014-05-19  Eric Botcazou  <ebotca...@adacore.com>

        * tree-ssa-dom.c (hashable_expr_equal_p) <EXPR_CALL>: Also compare the
        EH region of calls to pure functions that can throw an exception.
        * tree-ssa-sccvn.c (vn_reference_eq): Remove redundant test.
        (copy_reference_ops_from_call): Also copy the EH region of the call if
        it can throw an exception.


2014-05-19  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/opt35.adb: New test.
        * gnat.dg/opt35_pkg.ad[sb]: New helper.
        

-- 
Eric Botcazou
Index: tree-ssa-dom.c
===================================================================
--- tree-ssa-dom.c	(revision 210601)
+++ tree-ssa-dom.c	(working copy)
@@ -522,6 +522,14 @@ hashable_expr_equal_p (const struct hash
                                  expr1->ops.call.args[i], 0))
             return false;
 
+	if (stmt_could_throw_p (expr0->ops.call.fn_from))
+	  {
+	    int lp0 = lookup_stmt_eh_lp (expr0->ops.call.fn_from);
+	    int lp1 = lookup_stmt_eh_lp (expr1->ops.call.fn_from);
+	    if ((lp0 > 0 || lp1 > 0) && lp0 != lp1)
+	      return false;
+	  }
+
         return true;
       }
 
Index: tree-ssa-sccvn.c
===================================================================
--- tree-ssa-sccvn.c	(revision 210601)
+++ tree-ssa-sccvn.c	(working copy)
@@ -644,9 +644,6 @@ vn_reference_eq (const_vn_reference_t co
 {
   unsigned i, j;
 
-  if (vr1->hashcode != vr2->hashcode)
-    return false;
-
   /* Early out if this is not a hash collision.  */
   if (vr1->hashcode != vr2->hashcode)
     return false;
@@ -1106,6 +1103,7 @@ copy_reference_ops_from_call (gimple cal
   vn_reference_op_s temp;
   unsigned i;
   tree lhs = gimple_call_lhs (call);
+  int lr;
 
   /* If 2 calls have a different non-ssa lhs, vdef value numbers should be
      different.  By adding the lhs here in the vector, we ensure that the
@@ -1120,12 +1118,14 @@ copy_reference_ops_from_call (gimple cal
       result->safe_push (temp);
     }
 
-  /* Copy the type, opcode, function being called and static chain.  */
+  /* Copy the type, opcode, function, static chain and EH region, if any.  */
   memset (&temp, 0, sizeof (temp));
   temp.type = gimple_call_return_type (call);
   temp.opcode = CALL_EXPR;
   temp.op0 = gimple_call_fn (call);
   temp.op1 = gimple_call_chain (call);
+  if (stmt_could_throw_p (call) && (lr = lookup_stmt_eh_lp (call)) > 0)
+    temp.op2 = build_int_cst (integer_type_node, lr);
   temp.off = -1;
   result->safe_push (temp);
 
package body Opt35_Pkg is

  function F (I : Integer) return Integer is
  begin
    if I = 0 then
       raise E;
    end if;
    return -I;
  end;

end Opt35_Pkg;
-- { dg-do run }
-- { dg-options "-O" }

with Opt35_Pkg; use Opt35_Pkg;

procedure Opt35 is
  I : Integer := -1;
  N : Natural := 0;
begin
  begin
    I := F(0);
  exception
    when E => N := N + 1;
  end;

  begin
    I := F(0);
  exception
    when E => N := N +1;
  end;

  if N /= 2 or I = 0 then
    raise Program_Error;
  end if;
end;
package Opt35_Pkg is

  pragma Pure;

  E : Exception;

  function F (I : Integer) return Integer;

end Opt35_Pkg;