Hi,
this is a regression present on the mainline and 4.7 branch for platforms using
SJLJ exceptions, e.g. the ARM. The scenario is as follows: the main procedure
calls My_Iterators.Current which has a pragma Inline on it. The procedure
also has exceptions handlers so there is an abnormal edge from the BB
containing the call to My_Iterators.Current (which is therefore the last
statement in the BB) to the setjmp dispatcher.
The local-pure-const pass computes that My_Iterators.Current is pure and may
not terminate (DECL_PURE_P && DECL_LOOPING_CONST_OR_PURE_P) because it is pure
and contains a call to gnat_check, which is no-return, and
state_from_flags (&call_state, &call_looping, flags,
((flags & (ECF_NORETURN | ECF_NOTHROW))
== (ECF_NORETURN | ECF_NOTHROW))
|| (!flag_exceptions && (flags & ECF_NORETURN)));
considers that, with !flag_exceptions, a no-return function call can really
never return, including by exceptional means.
The early SRA pass then inserts a statement in the procedure right after the
call to My_Iterators.Current, so at the end of the BB, because stmt_ends_bb_p
has returned false on the call, in turn because the statement is ECF_PURE and
is_ctrl_altering_stmt has
/* A non-pure/const call alters flow control if the current
function has nonlocal labels. */
if (!(flags & (ECF_CONST | ECF_PURE | ECF_LEAF))
&& cfun->has_nonlocal_label)
return true;
i.e. doesn't return true if ECF_PURE. As a consequence, the abnormal edge from
the BB to the setjmp receiver is deleted.
When My_Iterators.Current gets inlined into P, the call to gnat_check is copied
into it and, since stmt_can_make_abnormal_goto returns true on it, a new
abnormal edge to the setjmp dispatcher is created. The compiler aborts in
update_ssa_across_abnormal_edges because it cannot find the original abnormal
edge that it needs to use in order to complete the new one.
The cause is the discrepancy between local-pure-const, is_ctrl_altering_stmt
and stmt_can_make_abnormal_goto (the latter two themselves disagreeing) as to
when a call can return exceptionally/make an abnormal goto. It's clear that
(!flag_exceptions && (flags & ECF_NORETURN))
overlooks the __builtin_setjmp/__builtin_longjmp constructs so is optimistic at
best. But we cannot really do better in local-pure-const, short of removing
the condition entirely.
The interesting thing is that stmt_can_make_abnormal_goto, unlike the related
is_ctrl_altering_stmt, doesn't consider that a mere ECF_PURE can change the
property of a call wrt control flow:
bool
stmt_can_make_abnormal_goto (gimple t)
{
if (computed_goto_p (t))
return true;
if (is_gimple_call (t))
return (gimple_has_side_effects (t) && cfun->has_nonlocal_label
&& !(gimple_call_flags (t) & ECF_LEAF));
return false;
}
because it tests gimple_has_side_effects, which is still true if the call may
not return:
if (is_gimple_call (s))
{
int flags = gimple_call_flags (s);
/* An infinite loop is considered a side effect. */
if (!(flags & (ECF_CONST | ECF_PURE))
|| (flags & ECF_LOOPING_CONST_OR_PURE))
return true;
return false;
}
So, in the end, a reasonable fix might be to unify the condition used by
is_ctrl_altering_stmt and stmt_can_make_abnormal_goto, by using the most
conservative one (the latter), which happens to also cover the optimistic
semantics used by local-pure-const.
Tested on x86_64-suse-linux, OK for mainline and 4.7 branch?
2012-03-28 Eric Botcazou <ebotca...@adacore.com>
* tree-cfg.c (call_can_make_abnormal_goto): New predicate.
(stmt_can_make_abnormal_goto): Use it.
(is_ctrl_altering_stmt): Likewise.
2012-03-28 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/controlled6.adb: New test.
* gnat.dg/controlled6_pkg.ads: New helper.
* gnat.dg/controlled6_pkg-iterators.ad[sb]: Likewise.
--
Eric Botcazou
Index: tree-cfg.c
===================================================================
--- tree-cfg.c (revision 185857)
+++ tree-cfg.c (working copy)
@@ -2273,6 +2273,43 @@ gimple_cfg2vcg (FILE *file)
Miscellaneous helpers
---------------------------------------------------------------------------*/
+/* Return true if T, a GIMPLE_CALL, can make an abnormal transfer of control
+ flow. Transfers of control flow associated with EH are excluded. */
+
+static bool
+call_can_make_abnormal_goto (gimple t)
+{
+ /* If the function has no non-local labels, then a call cannot make an
+ abnormal transfer of control. */
+ if (!cfun->has_nonlocal_label)
+ return false;
+
+ /* Likewise if the call has no side effects. */
+ if (!gimple_has_side_effects (t))
+ return false;
+
+ /* Likewise if the called function is leaf. */
+ if (gimple_call_flags (t) & ECF_LEAF)
+ return false;
+
+ return true;
+}
+
+
+/* Return true if T can make an abnormal transfer of control flow.
+ Transfers of control flow associated with EH are excluded. */
+
+bool
+stmt_can_make_abnormal_goto (gimple t)
+{
+ if (computed_goto_p (t))
+ return true;
+ if (is_gimple_call (t))
+ return call_can_make_abnormal_goto (t);
+ return false;
+}
+
+
/* Return true if T represents a stmt that always transfers control. */
bool
@@ -2306,10 +2343,8 @@ is_ctrl_altering_stmt (gimple t)
{
int flags = gimple_call_flags (t);
- /* A non-pure/const call alters flow control if the current
- function has nonlocal labels. */
- if (!(flags & (ECF_CONST | ECF_PURE | ECF_LEAF))
- && cfun->has_nonlocal_label)
+ /* A call alters control flow if it can make an abnormal goto. */
+ if (call_can_make_abnormal_goto (t))
return true;
/* A call also alters control flow if it does not return. */
@@ -2367,21 +2402,6 @@ simple_goto_p (gimple t)
}
-/* Return true if T can make an abnormal transfer of control flow.
- Transfers of control flow associated with EH are excluded. */
-
-bool
-stmt_can_make_abnormal_goto (gimple t)
-{
- if (computed_goto_p (t))
- return true;
- if (is_gimple_call (t))
- return (gimple_has_side_effects (t) && cfun->has_nonlocal_label
- && !(gimple_call_flags (t) & ECF_LEAF));
- return false;
-}
-
-
/* Return true if STMT should start a new basic block. PREV_STMT is
the statement preceding STMT. It is used when STMT is a label or a
case label. Labels should only start a new basic block if their
-- { dg-do compile }
-- { dg-options "-O -gnatn" }
with Ada.Text_IO; use Ada.Text_IO;
with Controlled6_Pkg;
with Controlled6_Pkg.Iterators;
procedure Controlled6 is
type String_Access is access String;
package My_Q is new Controlled6_Pkg (String_Access);
package My_Iterators is new My_Q.Iterators (0);
use My_Iterators;
Iterator : Iterator_Type := Find;
begin
loop
exit when Is_Null (Iterator);
Put (Current (Iterator).all & ' ');
Find_Next (Iterator);
end loop;
end;
package body Controlled6_Pkg.Iterators is
function Find return Iterator_Type is
Iterator : Iterator_Type;
begin
return Iterator;
end Find;
function Current (Iterator : in Iterator_Type) return T is begin
return Iterator.Current.Item;
end Current;
procedure Find_Next (Iterator : in out Iterator_Type) is begin
Iterator.Current := null;
end Find_Next;
function Is_Null (Iterator : in Iterator_Type) return Boolean is begin
return Iterator.Current = null;
end Is_Null;
end Controlled6_Pkg.Iterators;
with Ada.Finalization;
generic
type T is private;
package Controlled6_Pkg is
type Node_Type is record
Item : T;
end record;
type Node_Access_Type is access Node_Type;
end Controlled6_Pkg;
with Ada.Finalization;
generic
I : Integer;
package Controlled6_Pkg.Iterators is
type Iterator_Type is new Ada.Finalization.Controlled with record
Current : Node_Access_Type;
end record;
function Find return Iterator_Type;
function Current (Iterator : in Iterator_Type) return T;
pragma Inline (Current);
procedure Find_Next (Iterator : in out Iterator_Type);
function Is_Null (Iterator : in Iterator_Type) return Boolean;
end Controlled6_Pkg.Iterators;
