From: Eric Botcazou <ebotca...@adacore.com>
This implements elision of the copy operation for aggregate returns, i.e.
simple return statements whose expression is an aggregate, in the case of
nonlimited by-reference types (the copy operation is already elided for
limited types), which comprise controlled and tagged types. This is the
copy operation in the called function, that is to say the copy from the
anonymous object built for the aggregate to the anonymous return object.
The implementation simply extends that of limited types, which rewrites
the simple return statement as an extended return statement internally
and then leverages the built-in-place implementation of return objects
for these statements.
gcc/ada/ChangeLog:
* exp_aggr.adb (Is_Build_In_Place_Aggregate_Return): Also return
True for functions returning on the secondary stack or returning
a by-reference type if the back end exposes its return slot.
(Expand_Array_Aggregate): Call Is_Build_In_Place_Aggregate_Return
to spot aggregates to be built in place.
* exp_ch3.adb (Make_Allocator_For_Return): Add missing condition
in assertion pragma deduced from Expand_Subtype_From_Expr.
* exp_ch6.adb (Expand_Simple_Function_Return): Rewrite the statement
as an extended return statement if the expression is an aggregate
whose expansion is delayed. Properly relocate the expression in
this case.
* sem_ch6.adb: Add clauses for Exp_Aggr.
(Analyze_Function_Return): Do not apply the predicate check to an
aggregate whose expansion is delayed. Extended the processing of
case expressions to all conditional expressions.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 32 +++++++++++++++++---------------
gcc/ada/exp_ch3.adb | 8 +++++---
gcc/ada/exp_ch6.adb | 33 ++++++++++++++++++---------------
gcc/ada/sem_ch6.adb | 11 ++++++++---
4 files changed, 48 insertions(+), 36 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cadbe7881f0..f4844b74842 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -167,8 +167,8 @@ package body Exp_Aggr is
function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean;
-- True if N is an aggregate (possibly qualified or a dependent expression
- -- of a conditional expression, and possibly recursively so) that is being
- -- returned from a build-in-place function. Such qualified and conditional
+ -- of a conditional expression, and possibly recursively so) that needs to
+ -- be built-in-place in the return object. Such qualified and conditional
-- expressions are transparent for this purpose because an enclosing return
-- is propagated resp. distributed into these expressions by the expander.
@@ -6190,6 +6190,7 @@ package body Exp_Aggr is
(Defining_Identifier (Parent_Node))))
or else (Parent_Kind = N_Assignment_Statement
and then Inside_Init_Proc)
+ or else Is_Build_In_Place_Aggregate_Return (N)
then
Set_Expansion_Delayed (N, not Static_Array_Aggregate (N));
return;
@@ -6296,15 +6297,6 @@ package body Exp_Aggr is
Set_Expansion_Delayed (N);
return;
- -- Limited arrays in return statements are expanded when
- -- enclosing construct is expanded.
-
- elsif Maybe_In_Place_OK
- and then Parent_Kind = N_Simple_Return_Statement
- then
- Set_Expansion_Delayed (N);
- return;
-
-- In the remaining cases the aggregate appears in the RHS of an
-- assignment, which may be part of the expansion of an object
-- declaration. If the aggregate is an actual in a call, itself
@@ -8896,9 +8888,11 @@ package body Exp_Aggr is
----------------------------------------
function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean is
- P : Node_Id := Parent (N);
+ F : Entity_Id;
+ P : Node_Id;
begin
+ P := Parent (N);
while Nkind (P) in N_Case_Expression
| N_Case_Expression_Alternative
| N_If_Expression
@@ -8917,9 +8911,17 @@ package body Exp_Aggr is
return False;
end if;
- return
- Is_Build_In_Place_Function
- (Return_Applies_To (Return_Statement_Entity (P)));
+ F := Return_Applies_To (Return_Statement_Entity (P));
+
+ -- For a build-in-place function, all the returns are done in place
+ -- by definition. We also return aggregates in place in other cases
+ -- as an optimization, and they correspond to the cases where the
+ -- return object is built in place (see Is_Special_Return_Object).
+
+ return Is_Build_In_Place_Function (F)
+ or else Needs_Secondary_Stack (Etype (F))
+ or else (Back_End_Return_Slot
+ and then Is_By_Reference_Type (Etype (F)));
end Is_Build_In_Place_Aggregate_Return;
--------------------------
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 139fce8b288..3dd4d9cd07e 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7351,8 +7351,9 @@ package body Exp_Ch3 is
-- However, there are exceptions in the latter case for interfaces
-- (see Analyze_Object_Declaration), as well as class-wide types and
- -- types with unknown discriminants if they are additionally limited
- -- (see Expand_Subtype_From_Expr), so we must cope with them.
+ -- types with unknown discriminants if they have no underlying record
+ -- view or are inherently limited (see Expand_Subtype_From_Expr), so
+ -- we must cope with them.
elsif Is_Interface (Typ) then
pragma Assert (Is_Class_Wide_Type (Typ));
@@ -7384,7 +7385,8 @@ package body Exp_Ch3 is
else pragma Assert (Is_Definite_Subtype (Typ)
or else (Has_Unknown_Discriminants (Typ)
- and then Is_Inherently_Limited_Type (Typ)));
+ and then (No (Underlying_Record_View (Typ))
+ or else Is_Inherently_Limited_Type (Typ))));
Alloc_Typ := Typ;
end if;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 38432449229..e84937f6d84 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6621,11 +6621,16 @@ package body Exp_Ch6 is
end if;
end if;
- -- For the case of a simple return that does not come from an
- -- extended return, in the case of build-in-place, we rewrite
- -- "return <expression>;" to be:
-
- -- return _anon_ : <return_subtype> := <expression>
+ -- For the case of a simple return that does not come from an extended
+ -- return, and if the function returns in place or the expression is an
+ -- aggregate whose expansion has been delayed to be returned in place
+ -- (see Is_Build_In_Place_Aggregate_Return), we rewrite:
+ --
+ -- return <expression>;
+ --
+ -- into
+ --
+ -- return _anonymous_ : <return_subtype> := <expression>
-- The expansion produced by Expand_N_Extended_Return_Statement will
-- contain simple return statements (for example, a block containing
@@ -6644,7 +6649,8 @@ package body Exp_Ch6 is
or else Has_BIP_Formals (Scope_Id));
if not Comes_From_Extended_Return_Statement (N)
- and then Is_Build_In_Place_Function (Scope_Id)
+ and then (Is_Build_In_Place_Function (Scope_Id)
+ or else Is_Delayed_Aggregate (Exp))
-- The functionality of interface thunks is simple and it is always
-- handled by means of simple return statements. This leaves their
@@ -6653,23 +6659,20 @@ package body Exp_Ch6 is
and then not Is_Thunk (Scope_Id)
then
declare
- Return_Object_Entity : constant Entity_Id :=
- Make_Temporary (Loc, 'R', Exp);
-
Obj_Decl : constant Node_Id :=
Make_Object_Declaration (Loc,
- Defining_Identifier => Return_Object_Entity,
+ Defining_Identifier => Make_Temporary (Loc, 'R'),
Object_Definition => Subtype_Ind,
- Expression => Exp);
+ Expression => Relocate_Node (Exp));
- Ext : constant Node_Id :=
- Make_Extended_Return_Statement (Loc,
- Return_Object_Declarations => New_List (Obj_Decl));
+ Stmt : constant Node_Id :=
+ Make_Extended_Return_Statement (Loc,
+ Return_Object_Declarations => New_List (Obj_Decl));
-- Do not perform this high-level optimization if the result type
-- is an interface because the "this" pointer must be displaced.
begin
- Rewrite (N, Ext);
+ Rewrite (N, Stmt);
Analyze (N);
return;
end;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 944f5ca365a..16f296523f4 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -35,6 +35,7 @@ with Einfo.Utils; use Einfo.Utils;
with Elists; use Elists;
with Errout; use Errout;
with Expander; use Expander;
+with Exp_Aggr; use Exp_Aggr;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch9; use Exp_Ch9;
@@ -989,13 +990,17 @@ package body Sem_Ch6 is
-- The return value is converted to the return type of the function,
-- which implies a predicate check if the return type is predicated.
-- We do not apply the check for an extended return statement because
- -- Analyze_Object_Declaration has already done it on Obj_Decl above.
- -- We do not apply the check to a case expression because it will
- -- be expanded into a series of return statements, each of which
+ -- Analyze_Object_Declaration has already done it on Obj_Decl above,
+ -- or to a delayed aggregate because the return will be turned into
+ -- an extended return by Expand_Simple_Function_Return in this case.
+ -- We do not apply the check to a conditional expression because it
+ -- will be expanded into a series of return statements, each of which
-- will receive a predicate check.
if Nkind (N) /= N_Extended_Return_Statement
+ and then not Is_Delayed_Aggregate (Expr)
and then Nkind (Expr) /= N_Case_Expression
+ and then Nkind (Expr) /= N_If_Expression
then
Apply_Predicate_Check (Expr, R_Type);
end if;
--
2.43.0
