From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 5271E385BAC0; Mon, 4 Jul 2022 07:50:53 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 5271E385BAC0 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-1434] [Ada] Call-initialize all controlled objects in place X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: eb6e8a7acd1b8ecf36489e01cafad61add528f23 X-Git-Newrev: c901877facf9635149ed69cabd88c871f60931fe Message-Id: <20220704075053.5271E385BAC0@sourceware.org> Date: Mon, 4 Jul 2022 07:50:53 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 04 Jul 2022 07:50:53 -0000 https://gcc.gnu.org/g:c901877facf9635149ed69cabd88c871f60931fe commit r13-1434-gc901877facf9635149ed69cabd88c871f60931fe Author: Eric Botcazou Date: Thu May 26 11:06:01 2022 +0200 [Ada] Call-initialize all controlled objects in place 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. gcc/ada/ * exp_ch3.adb (Expand_N_Object_Declaration): Don't adjust the object if the expression is a function call. : 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: --- gcc/ada/exp_ch3.adb | 48 +++++++++++++++++++++++------------------------- gcc/ada/exp_ch6.adb | 31 +++++++++++++++++++++---------- gcc/ada/exp_ch7.adb | 9 +++++++-- gcc/ada/sem_ch3.adb | 10 +++++----- 4 files changed, 56 insertions(+), 42 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index d02a863045b..12173ae166e 100644 --- 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 index 88157b946ea..77e20bcfecb 100644 --- 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 index 5f1c357a125..2be891e1bb7 100644 --- 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 index 2dbba159980..3bbb788ac0c 100644 --- 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,