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

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

	* 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

gcc/ChangeLog

+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

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gnat.dg/loop_optimization2.adb

+-- { 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;

gcc/testsuite/gnat.dg/loop_optimization2.ads

+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;

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);
     }