From: Eric Botcazou Date: Sun, 18 May 2008 22:36:30 +0000 (+0000) Subject: tree-ssa-dom.c (tree_ssa_dominator_optimize): If some blocks need EH cleanup at the... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=45a7844faf66271c1b2491d2931aa761c80c2f90;p=gcc.git 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 --- diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 17a2632b75c..5cf0155c5e7 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,9 @@ +2008-05-18 Eric Botcazou + + * 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 * tree-cfg.c (verify_gimple_expr): Allow conversions from diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4f115c3ef19..5580d8cc97b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-05-18 Eric Botcazou + + * gnat.dg/loop_optimization2.ad[sb]: New test. + 2008-05-18 Jakub Jelinek 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 index 00000000000..f78cd989ab7 --- /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 index 00000000000..39d83236b8d --- /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 909bfeba682..c4145b30ec2 100644 --- 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); }