tree-ssa-dom.c (tree_ssa_dominator_optimize): If some blocks need EH cleanup at the...

	* tree-ssa-dom.c (tree_ssa_dominator_optimize): If some blocks need
	EH cleanup at the end of the pass, search for those that have been
	turned into forwarder blocks and do the cleanup on their successor.

From-SVN: r135514

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 17a2632b75cf30ab86688cb18b131ca992bc0f9c..5cf0155c5e7924525d2270722353368f863e8e05 100644 (file)
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,9 @@
+2008-05-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * tree-ssa-dom.c (tree_ssa_dominator_optimize): If some blocks need
+       EH cleanup at the end of the pass, search for those that have been
+       turned into forwarder blocks and do the cleanup on their successor.
+
 2008-05-18  Richard Guenther  <rguenther@suse.de>
 
        * tree-cfg.c (verify_gimple_expr): Allow conversions from

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4f115c3ef19227d25a7b54f847109d4809edbfa6..5580d8cc97b4eced6c71609f0b918dcdb4929093 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2008-05-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/loop_optimization2.ad[sb]: New test.
+
 2008-05-18  Jakub Jelinek  <jakub@redhat.com>
 
        PR target/36090

diff --git a/gcc/testsuite/gnat.dg/loop_optimization2.adb b/gcc/testsuite/gnat.dg/loop_optimization2.adb
new file mode 100644 (file)
index 0000000..f78cd98
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/loop_optimization2.adb
@@ -0,0 +1,41 @@
+-- { dg-do compile }
+-- { dg-options "-gnata -O2 -fno-inline" }
+
+with Ada.Unchecked_Conversion;
+
+package body Loop_Optimization2 is
+
+   function To_Addr_Ptr is
+      new Ada.Unchecked_Conversion (System.Address, Addr_Ptr);
+
+   function To_Address is
+     new Ada.Unchecked_Conversion (Tag, System.Address);
+
+   function To_Type_Specific_Data_Ptr is
+     new Ada.Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
+
+   function Interface_Ancestor_Tags (T : Tag) return Tag_Array is
+      TSD_Ptr : constant Addr_Ptr := To_Addr_Ptr (To_Address (T));
+      TSD : constant Type_Specific_Data_Ptr :=
+                      To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+      Iface_Table : constant Interface_Data_Ptr := TSD.Interfaces_Table;
+   begin
+      if Iface_Table = null then
+         declare
+            Table : Tag_Array (1 .. 0);
+         begin
+            return Table;
+         end;
+      else
+         declare
+            Table : Tag_Array (1 .. Iface_Table.Nb_Ifaces);
+         begin
+            for J in 1 .. Iface_Table.Nb_Ifaces loop
+               Table (J) := Iface_Table.Ifaces_Table (J).Iface_Tag;
+            end loop;
+            return Table;
+         end;
+      end if;
+   end Interface_Ancestor_Tags;
+
+end Loop_Optimization2;

diff --git a/gcc/testsuite/gnat.dg/loop_optimization2.ads b/gcc/testsuite/gnat.dg/loop_optimization2.ads
new file mode 100644 (file)
index 0000000..39d8323
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/loop_optimization2.ads
@@ -0,0 +1,41 @@
+with System;
+
+package Loop_Optimization2 is
+
+   type Prim_Ptr is access procedure;
+   type Address_Array is array (Positive range <>) of Prim_Ptr;
+
+   subtype Dispatch_Table is Address_Array (1 .. 1);
+
+   type Tag is access all Dispatch_Table;
+
+   type Tag_Array is array (Positive range <>) of Tag;
+
+   function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
+
+   type Interface_Data_Element is record
+      Iface_Tag : Tag;
+   end record;
+
+   type Interfaces_Array is array (Natural range <>) of Interface_Data_Element;
+
+   type Interface_Data (Nb_Ifaces : Positive) is record
+      Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces);
+   end record;
+
+   type Interface_Data_Ptr is access all Interface_Data;
+
+   type Type_Specific_Data (Idepth : Natural) is record
+      Interfaces_Table : Interface_Data_Ptr;
+   end record;
+
+   type Type_Specific_Data_Ptr is access all Type_Specific_Data;
+   pragma No_Strict_Aliasing (Type_Specific_Data_Ptr);
+
+   subtype Predef_Prims_Table is Address_Array (1 .. 16);
+   type Predef_Prims_Table_Ptr is access Predef_Prims_Table;
+
+   type Addr_Ptr is access System.Address;
+   pragma No_Strict_Aliasing (Addr_Ptr);
+
+end Loop_Optimization2;

diff --git a/gcc/tree-ssa-dom.c b/gcc/tree-ssa-dom.c
index 909bfeba6829690fea20f056b8a6d433b31f6649..c4145b30ec26618977687965dcf7e925b641de54 100644 (file)
--- a/gcc/tree-ssa-dom.c
+++ b/gcc/tree-ssa-dom.c
@@ -319,6 +319,23 @@ tree_ssa_dominator_optimize (void)
      such edges from the CFG as needed.  */
   if (!bitmap_empty_p (need_eh_cleanup))
     {
+      unsigned i;
+      bitmap_iterator bi;
+
+      /* Jump threading may have created forwarder blocks from blocks
+        needing EH cleanup; the new successor of these blocks, which
+        has inherited from the original block, needs the cleanup.  */
+      EXECUTE_IF_SET_IN_BITMAP (need_eh_cleanup, 0, i, bi)
+       {
+         basic_block bb = BASIC_BLOCK (i);
+         if (single_succ_p (bb) == 1
+             && (single_succ_edge (bb)->flags & EDGE_EH) == 0)
+           {
+             bitmap_clear_bit (need_eh_cleanup, i);
+             bitmap_set_bit (need_eh_cleanup, single_succ (bb)->index);
+           }
+       }
+
       tree_purge_all_dead_eh_edges (need_eh_cleanup);
       bitmap_zero (need_eh_cleanup);
     }