]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Elide the copy in aggregate returns for nonlimited types
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 21 Oct 2024 08:55:28 +0000 (10:55 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Tue, 12 Nov 2024 13:00:46 +0000 (14:00 +0100)
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.

gcc/ada/exp_aggr.adb
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch6.adb
gcc/ada/sem_ch6.adb

index cadbe7881f01cbf8d6d94d53c964b793963d9d6a..f4844b748423e1e192010d727f136d37f0e82d88 100644 (file)
@@ -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;
 
    --------------------------
index 139fce8b288c26050bc99d32220bb7a0d87436e3..3dd4d9cd07e15382ed8facd889e87aece8ea1b6d 100644 (file)
@@ -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;
index 3843244922924234878679a4edd3203b18a0a485..e84937f6d840f6b17c998517291374f6a2a16679 100644 (file)
@@ -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;
index 944f5ca365adb91983c3088a67f16c0bf108c379..16f296523f4cc42edd856a8244e030057860d4eb 100644 (file)
@@ -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;