This changes the compiler to build in place almost all objects that need
finalization and are initialized with the result of a function call, thus
saving a pair of Adjust/Finalize calls for the anonymous return object.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* exp_ch3.adb (Expand_N_Object_Declaration): Don't adjust the object
if the expression is a function call.
<Rewrite_As_Renaming>: Return true if the object needs finalization
and is initialized with the result of a function call returned on
the secondary stack.
* exp_ch6.adb (Expand_Ctrl_Function_Call): Add Use_Sec_Stack boolean
parameter. Early return if the parent is an object declaration and
Use_Sec_Stack is false.
(Expand_Call_Helper): Adjust call to Expand_Ctrl_Function_Call.
* exp_ch7.adb (Find_Last_Init): Be prepared for initialization still
present in the object declaration.
* sem_ch3.adb (Analyze_Object_Declaration): Call the predicates
Needs_Secondary_Stack and Needs_Finalization to guard the renaming
optimization.diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6810,28 +6810,25 @@ package body Exp_Ch3 is
-- If the object declaration appears in the form
- -- Obj : Ctrl_Typ := Func (...);
+ -- Obj : Typ := Func (...);
- -- where Ctrl_Typ is controlled but not immutably limited type, then
- -- the expansion of the function call should use a dereference of the
- -- result to reference the value on the secondary stack.
+ -- where Typ both needs finalization and is returned on the secondary
+ -- stack, the object declaration can be rewritten into a dereference
+ -- of the reference to the result built on the secondary stack (see
+ -- Expand_Ctrl_Function_Call for this expansion of the call):
- -- Obj : Ctrl_Typ renames Func (...).all;
+ -- type Axx is access all Typ;
+ -- Rxx : constant Axx := Func (...)'reference;
+ -- Obj : Typ renames Rxx.all;
- -- As a result, the call avoids an extra copy. This an optimization,
- -- but it is required for passing ACATS tests in some cases where it
- -- would otherwise make two copies. The RM allows removing redunant
- -- Adjust/Finalize calls, but does not allow insertion of extra ones.
+ -- This avoids an extra copy and the pair of Adjust/Finalize calls.
- -- This part is disabled for now, because it breaks GNAT Studio
- -- builds
-
- (False -- ???
+ (not Is_Library_Level_Entity (Def_Id)
and then Nkind (Expr_Q) = N_Explicit_Dereference
and then not Comes_From_Source (Expr_Q)
and then Nkind (Original_Node (Expr_Q)) = N_Function_Call
- and then Nkind (Object_Definition (N)) in N_Has_Entity
- and then (Needs_Finalization (Entity (Object_Definition (N)))))
+ and then Needs_Finalization (Typ)
+ and then not Is_Class_Wide_Type (Typ))
-- If the initializing expression is for a variable with attribute
-- OK_To_Rename set, then transform:
@@ -6843,8 +6840,7 @@ package body Exp_Ch3 is
-- Obj : Typ renames Expr;
-- provided that Obj is not aliased. The aliased case has to be
- -- excluded in general because Expr will not be aliased in
- -- general.
+ -- excluded in general because Expr will not be aliased in general.
or else
(not Aliased_Present (N)
@@ -6853,7 +6849,7 @@ package body Exp_Ch3 is
and then OK_To_Rename (Entity (Expr_Q))
and then Is_Entity_Name (Obj_Def));
begin
- -- Return False if there are any aspect specifications, because
+ -- ??? Return False if there are any aspect specifications, because
-- otherwise we duplicate that corresponding implicit attribute
-- definition, and call Insert_Action, which has no place to insert
-- the attribute definition. The attribute definition is stored in
@@ -7423,16 +7419,18 @@ package body Exp_Ch3 is
end if;
end if;
- -- If the type is controlled and not inherently limited, then
- -- the target is adjusted after the copy and attached to the
- -- finalization list. However, no adjustment is done in the case
- -- where the object was initialized by a call to a function whose
- -- result is built in place, since no copy occurred. Similarly, no
- -- adjustment is required if we are going to rewrite the object
- -- declaration into a renaming declaration.
+ -- If the type needs finalization and is not inherently limited,
+ -- then the target is adjusted after the copy and attached to the
+ -- finalization list. However, no adjustment is needed in the case
+ -- where the object has been initialized by a call to a function
+ -- returning on the primary stack (see Expand_Ctrl_Function_Call)
+ -- since no copy occurred, given that the type is by-reference.
+ -- Similarly, no adjustment is needed if we are going to rewrite
+ -- the object declaration into a renaming declaration.
if Needs_Finalization (Typ)
and then not Is_Limited_View (Typ)
+ and then Nkind (Expr_Q) /= N_Function_Call
and then not Rewrite_As_Renaming
then
Adj_Call :=
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -247,10 +247,10 @@ package body Exp_Ch6 is
procedure Expand_Call_Helper (N : Node_Id; Post_Call : out List_Id);
-- Does the main work of Expand_Call. Post_Call is as for Expand_Actuals.
- procedure Expand_Ctrl_Function_Call (N : Node_Id);
+ procedure Expand_Ctrl_Function_Call (N : Node_Id; Use_Sec_Stack : Boolean);
-- N is a function call which returns a controlled object. Transform the
-- call into a temporary which retrieves the returned object from the
- -- secondary stack using 'reference.
+ -- primary or secondary stack (Use_Sec_Stack says which) using 'reference.
procedure Expand_Non_Function_Return (N : Node_Id);
-- Expand a simple return statement found in a procedure body, entry body,
@@ -4916,7 +4916,7 @@ package body Exp_Ch6 is
-- different processing applies. If the call is to a protected function,
-- the expansion above will call Expand_Call recursively. Otherwise the
-- function call is transformed into a reference to the result that has
- -- been built either on the return or the secondary stack.
+ -- been built either on the primary or the secondary stack.
if Needs_Finalization (Etype (Subp)) then
if not Is_Build_In_Place_Function_Call (Call_Node)
@@ -4925,7 +4925,8 @@ package body Exp_Ch6 is
or else
not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
then
- Expand_Ctrl_Function_Call (Call_Node);
+ Expand_Ctrl_Function_Call
+ (Call_Node, Needs_Secondary_Stack (Etype (Subp)));
-- Build-in-place function calls which appear in anonymous contexts
-- need a transient scope to ensure the proper finalization of the
@@ -4956,7 +4957,10 @@ package body Exp_Ch6 is
-- Expand_Ctrl_Function_Call --
-------------------------------
- procedure Expand_Ctrl_Function_Call (N : Node_Id) is
+ procedure Expand_Ctrl_Function_Call (N : Node_Id; Use_Sec_Stack : Boolean)
+ is
+ Par : constant Node_Id := Parent (N);
+
function Is_Element_Reference (N : Node_Id) return Boolean;
-- Determine whether node N denotes a reference to an Ada 2012 container
-- element.
@@ -4981,12 +4985,19 @@ package body Exp_Ch6 is
-- Start of processing for Expand_Ctrl_Function_Call
begin
- -- Optimization, if the returned value (which is on the sec-stack) is
- -- returned again, no need to copy/readjust/finalize, we can just pass
- -- the value thru (see Expand_N_Simple_Return_Statement), and thus no
- -- attachment is needed.
+ -- 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.
+
+ if Nkind (Par) = N_Simple_Return_Statement then
+ return;
+ end if;
+
+ -- Another optimization: if the returned value is used to initialize an
+ -- object, and the secondary stack is not involved in the call, then no
+ -- need to copy/readjust/finalize, we can just initialize it in place.
- if Nkind (Parent (N)) = N_Simple_Return_Statement then
+ if Nkind (Par) = N_Object_Declaration and then not Use_Sec_Stack then
return;
end if;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -3063,6 +3063,13 @@ package body Exp_Ch7 is
return;
+ -- If the initialization is in the declaration, we're done, so
+ -- early return if we have no more statements or they have been
+ -- rewritten, which means that they were in the source code.
+
+ elsif No (Stmt) or else Original_Node (Stmt) /= Stmt then
+ return;
+
-- In all other cases the initialization calls follow the related
-- object. The general structure of object initialization built by
-- routine Default_Initialize_Object is as follows:
@@ -3091,8 +3098,6 @@ package body Exp_Ch7 is
-- Otherwise the initialization calls follow the related object
else
- pragma Assert (Present (Stmt));
-
Stmt_2 := Next_Suitable_Statement (Stmt);
-- Check for an optional call to Deep_Initialize which may
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5046,21 +5046,21 @@ package body Sem_Ch3 is
end if;
-- Another optimization: if the nominal subtype is unconstrained and
- -- the expression is a function call that returns an unconstrained
- -- type, rewrite the declaration as a renaming of the result of the
+ -- the expression is a function call that returns on the secondary
+ -- stack, rewrite the declaration as a renaming of the result of the
-- call. The exceptions below are cases where the copy is expected,
-- either by the back end (Aliased case) or by the semantics, as for
-- initializing controlled types or copying tags for class-wide types.
+ -- ??? To be moved to Expand_N_Object_Declaration.Rewrite_As_Renaming.
if Present (E)
and then Nkind (E) = N_Explicit_Dereference
and then Nkind (Original_Node (E)) = N_Function_Call
and then not Is_Library_Level_Entity (Id)
- and then not Is_Constrained (Underlying_Type (T))
and then not Is_Aliased (Id)
+ and then Needs_Secondary_Stack (T)
and then not Is_Class_Wide_Type (T)
- and then not Is_Controlled (T)
- and then not Has_Controlled_Component (Base_Type (T))
+ and then not Needs_Finalization (T)
and then Expander_Active
then
Rewrite (N,
