public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7868] ada: Fix wrong finalization for call to BIP function in conditional expression
@ 2023-09-27 8:25 Eric Botcazou
0 siblings, 0 replies; only message in thread
From: Eric Botcazou @ 2023-09-27 8:25 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:9c1c079bae6d0206dd3903850581e8d25e42a473
commit r13-7868-g9c1c079bae6d0206dd3903850581e8d25e42a473
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon Apr 3 10:53:30 2023 +0200
ada: Fix wrong finalization for call to BIP function in conditional expression
This happens when the call is a dependent expression of the conditional
expression, and the conditional expression is either the expression of a
simple return statement or the return expression of an expression function.
The reason is that the special processing of "tail calls" for BIP functions,
i.e. calls that are the expression of simple return statements or the return
expression of expression functions, is not applied.
This change makes sure that it is applied by distributing the simple return
statements enclosing conditional expressions into the dependent expressions
of the conditional expressions in almost all cases. As a side effect, this
elides a temporary in the nonlimited by-reference case, as well as a pair of
calls to Adjust/Finalize in the nonlimited controlled case.
gcc/ada/
* exp_ch4.adb (Expand_N_Case_Expression): Distribute simple return
statements enclosing the conditional expression into the dependent
expressions in almost all cases.
(Expand_N_If_Expression): Likewise.
(Process_Transient_In_Expression): Adjust to the above distribution.
* exp_ch6.adb (Expand_Ctrl_Function_Call): Deal with calls in the
dependent expressions of a conditional expression.
* sem_ch6.adb (Analyze_Function_Return): Deal with the rewriting of
a simple return statement during the resolution of its expression.
Diff:
---
gcc/ada/exp_ch4.adb | 171 ++++++++++++++++++++++++++++++++++++----------------
gcc/ada/exp_ch6.adb | 10 ++-
gcc/ada/sem_ch6.adb | 12 +++-
3 files changed, 138 insertions(+), 55 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 924452c4fb5..0490a31a720 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5380,17 +5380,6 @@ package body Exp_Ch4 is
-- when minimizing expressions with actions (e.g. when generating C
-- code) since it allows us to do the optimization below in more cases.
- -- Small optimization: when the case expression appears in the context
- -- of a simple return statement, expand into
-
- -- case X is
- -- when A =>
- -- return AX;
- -- when B =>
- -- return BX;
- -- ...
- -- end case;
-
Case_Stmt :=
Make_Case_Statement (Loc,
Expression => Expression (N),
@@ -5404,17 +5393,29 @@ package body Exp_Ch4 is
Set_From_Conditional_Expression (Case_Stmt);
Acts := New_List;
+ -- Small optimization: when the case expression appears in the context
+ -- of a simple return statement, expand into
+
+ -- case X is
+ -- when A =>
+ -- return AX;
+ -- when B =>
+ -- return BX;
+ -- ...
+ -- end case;
+
+ -- This makes the expansion much easier when expressions are calls to
+ -- a BIP function. But do not perform it when the return statement is
+ -- within a predicate function, as this causes spurious errors.
+
+ Optimize_Return_Stmt :=
+ Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
+
-- Scalar/Copy case
if Is_Copy_Type (Typ) then
Target_Typ := Typ;
- -- Do not perform the optimization when the return statement is
- -- within a predicate function, as this causes spurious errors.
-
- Optimize_Return_Stmt :=
- Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
-
-- Otherwise create an access type to handle the general case using
-- 'Unrestricted_Access.
@@ -5477,16 +5478,6 @@ package body Exp_Ch4 is
-- scalar types. This approach avoids big copies and covers the
-- limited and unconstrained cases.
- -- Generate:
- -- AX'Unrestricted_Access
-
- if not Is_Copy_Type (Typ) then
- Alt_Expr :=
- Make_Attribute_Reference (Alt_Loc,
- Prefix => Relocate_Node (Alt_Expr),
- Attribute_Name => Name_Unrestricted_Access);
- end if;
-
-- Generate:
-- return AX['Unrestricted_Access];
@@ -5499,6 +5490,13 @@ package body Exp_Ch4 is
-- Target := AX['Unrestricted_Access];
else
+ if not Is_Copy_Type (Typ) then
+ Alt_Expr :=
+ Make_Attribute_Reference (Alt_Loc,
+ Prefix => Relocate_Node (Alt_Expr),
+ Attribute_Name => Name_Unrestricted_Access);
+ end if;
+
LHS := New_Occurrence_Of (Target, Loc);
Set_Assignment_OK (LHS);
@@ -5763,6 +5761,7 @@ package body Exp_Ch4 is
Loc : constant Source_Ptr := Sloc (N);
Thenx : constant Node_Id := Next (Cond);
Elsex : constant Node_Id := Next (Thenx);
+ Par : constant Node_Id := Parent (N);
Typ : constant Entity_Id := Etype (N);
Force_Expand : constant Boolean := Is_Anonymous_Access_Actual (N);
@@ -5795,6 +5794,10 @@ package body Exp_Ch4 is
UI_Max (Hi1, Hi2) - UI_Min (Lo1, Lo2) < Too_Large_Length_For_Array;
end OK_For_Single_Subtype;
+ Optimize_Return_Stmt : Boolean := False;
+ -- Flag set when the if expression can be optimized in the context of
+ -- a simple return statement.
+
-- Local variables
Actions : List_Id;
@@ -5886,6 +5889,50 @@ package body Exp_Ch4 is
end;
end if;
+ -- Small optimization: when the if expression appears in the context of
+ -- a simple return statement, expand into
+
+ -- if cond then
+ -- return then-expr
+ -- else
+ -- return else-expr;
+ -- end if;
+
+ -- This makes the expansion much easier when expressions are calls to
+ -- a BIP function. But do not perform it when the return statement is
+ -- within a predicate function, as this causes spurious errors.
+
+ Optimize_Return_Stmt :=
+ Nkind (Par) = N_Simple_Return_Statement
+ and then not (Ekind (Current_Scope) in E_Function | E_Procedure
+ and then Is_Predicate_Function (Current_Scope));
+
+ if Optimize_Return_Stmt then
+ -- When the "then" or "else" expressions involve controlled function
+ -- calls, generated temporaries are chained on the corresponding list
+ -- of actions. These temporaries need to be finalized after the if
+ -- expression is evaluated.
+
+ Process_If_Case_Statements (N, Then_Actions (N));
+ Process_If_Case_Statements (N, Else_Actions (N));
+
+ New_If :=
+ Make_Implicit_If_Statement (N,
+ Condition => Relocate_Node (Cond),
+ Then_Statements => New_List (
+ Make_Simple_Return_Statement (Sloc (Thenx),
+ Expression => Relocate_Node (Thenx))),
+ Else_Statements => New_List (
+ Make_Simple_Return_Statement (Sloc (Elsex),
+ Expression => Relocate_Node (Elsex))));
+
+ -- Preserve the original context for which the if statement is
+ -- being generated. This is needed by the finalization machinery
+ -- to prevent the premature finalization of controlled objects
+ -- found within the if statement.
+
+ Set_From_Conditional_Expression (New_If);
+
-- If the type is limited, and the back end does not handle limited
-- types, then we expand as follows to avoid the possibility of
-- improper copying.
@@ -5905,7 +5952,7 @@ package body Exp_Ch4 is
-- This special case can be skipped if the back end handles limited
-- types properly and ensures that no incorrect copies are made.
- if Is_By_Reference_Type (Typ)
+ elsif Is_By_Reference_Type (Typ)
and then not Back_End_Handles_Limited_Types
then
-- When the "then" or "else" expressions involve controlled function
@@ -6227,9 +6274,10 @@ package body Exp_Ch4 is
-- Note that the test for being in an object declaration avoids doing an
-- unnecessary expansion, and also avoids infinite recursion.
- elsif Is_Array_Type (Typ) and then not Is_Constrained (Typ)
- and then (Nkind (Parent (N)) /= N_Object_Declaration
- or else Expression (Parent (N)) /= N)
+ elsif Is_Array_Type (Typ)
+ and then not Is_Constrained (Typ)
+ and then not (Nkind (Par) = N_Object_Declaration
+ and then Expression (Par) = N)
then
declare
Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N);
@@ -6392,14 +6440,14 @@ package body Exp_Ch4 is
-- in order to make sure that no branch is shared between the decisions.
elsif Opt.Suppress_Control_Flow_Optimizations
- and then Nkind (Original_Node (Parent (N))) in N_Case_Expression
- | N_Case_Statement
- | N_If_Expression
- | N_If_Statement
- | N_Goto_When_Statement
- | N_Loop_Statement
- | N_Return_When_Statement
- | N_Short_Circuit
+ and then Nkind (Original_Node (Par)) in N_Case_Expression
+ | N_Case_Statement
+ | N_If_Expression
+ | N_If_Statement
+ | N_Goto_When_Statement
+ | N_Loop_Statement
+ | N_Return_When_Statement
+ | N_Short_Circuit
then
declare
Cnn : constant Entity_Id := Make_Temporary (Loc, 'C');
@@ -6440,20 +6488,35 @@ package body Exp_Ch4 is
-- change it to the SLOC of the expression which, after expansion, will
-- correspond to what is being evaluated.
- if Present (Parent (N)) and then Nkind (Parent (N)) = N_If_Statement then
- Set_Sloc (New_If, Sloc (Parent (N)));
- Set_Sloc (Parent (N), Loc);
+ if Present (Par) and then Nkind (Par) = N_If_Statement then
+ Set_Sloc (New_If, Sloc (Par));
+ Set_Sloc (Par, Loc);
end if;
-- Move Then_Actions and Else_Actions, if any, to the new if statement
- Insert_List_Before (First (Then_Statements (New_If)), Then_Actions (N));
- Insert_List_Before (First (Else_Statements (New_If)), Else_Actions (N));
+ if Present (Then_Actions (N)) then
+ Prepend_List (Then_Actions (N), Then_Statements (New_If));
+ end if;
- Insert_Action (N, Decl);
- Insert_Action (N, New_If);
- Rewrite (N, New_N);
- Analyze_And_Resolve (N, Typ);
+ if Present (Else_Actions (N)) then
+ Prepend_List (Else_Actions (N), Else_Statements (New_If));
+ end if;
+
+ -- Rewrite the parent return statement as an if statement
+
+ if Optimize_Return_Stmt then
+ Rewrite (Par, New_If);
+ Analyze (Par);
+
+ -- Otherwise rewrite the if expression itself
+
+ else
+ Insert_Action (N, Decl);
+ Insert_Action (N, New_If);
+ Rewrite (N, New_N);
+ Analyze_And_Resolve (N, Typ);
+ end if;
end Expand_N_If_Expression;
-----------------
@@ -15139,12 +15202,18 @@ package body Exp_Ch4 is
-- <finalize Trans_Id>
-- in Result end;
- -- As a result, the finalization of any transient objects can safely
- -- take place after the result capture.
+ -- As a result, the finalization of any transient objects can take place
+ -- just after the result is captured, except for the case of conditional
+ -- expressions in a simple return statement because the return statement
+ -- will be distributed into the conditional expressions (see the special
+ -- handling of simple return statements a few lines below).
-- ??? could this be extended to elementary types?
- if Is_Boolean_Type (Etype (Expr)) then
+ if Is_Boolean_Type (Etype (Expr))
+ and then (Nkind (Expr) = N_Expression_With_Actions
+ or else Nkind (Parent (Expr)) /= N_Simple_Return_Statement)
+ then
Fin_Context := Last (Stmts);
-- Otherwise the immediate context may not be safe enough to carry
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 7abf25e3859..4ee6027e7cc 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5126,8 +5126,16 @@ package body Exp_Ch6 is
-- Optimization: if the returned value is returned again, then no need
-- to copy/readjust/finalize, we can just pass the value through (see
-- Expand_N_Simple_Return_Statement), and thus no attachment is needed.
+ -- Note that simple return statements are distributed into conditional
+ -- expressions but we may be invoked before this distribution is done.
- if Nkind (Par) = N_Simple_Return_Statement then
+ if Nkind (Par) = N_Simple_Return_Statement
+ or else (Nkind (Par) = N_If_Expression
+ and then Nkind (Parent (Par)) = N_Simple_Return_Statement)
+ or else (Nkind (Par) = N_Case_Expression_Alternative
+ and then
+ Nkind (Parent (Parent (Par))) = N_Simple_Return_Statement)
+ then
return;
end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d4701aed0f7..c5683935d81 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -847,6 +847,14 @@ package body Sem_Ch6 is
end if;
Resolve (Expr, R_Type);
+
+ -- The expansion of the expression may have rewritten the return
+ -- statement itself, e.g. when it is a conditional expression.
+
+ if Nkind (N) /= N_Simple_Return_Statement then
+ return;
+ end if;
+
Check_Limited_Return (N, Expr, R_Type);
Check_Return_Construct_Accessibility (N, Stm_Entity);
@@ -942,9 +950,7 @@ package body Sem_Ch6 is
-- Defend against previous errors
- if Nkind (Expr) = N_Empty
- or else No (Etype (Expr))
- then
+ if Nkind (Expr) = N_Empty or else No (Etype (Expr)) then
return;
end if;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-09-27 8:25 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-09-27 8:25 [gcc r13-7868] ada: Fix wrong finalization for call to BIP function in conditional expression Eric Botcazou
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).