From patchwork Mon Jul 4 07:50:15 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 55686 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E7F6038A90AC for ; Mon, 4 Jul 2022 07:57:30 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E7F6038A90AC DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1656921450; bh=ZnDsCaieNxfIZ7gnukNAjAL2S+db/sfsqjUwj5hPZIs=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=lyUQhSv/Z+KhjPRuH5+LNWLPt0NN5Z1UvAUgS1i3Hq/805kT6h6VNvUh/81Ie+pP0 3yuR4SLOXNQgSRVyZutjZ8/Ats+SSxjPX8xorcUPweA216yN+4cy5ZmtRTlqOuR3+B zgwnHxSbT+sBh/d76XH8wL7T0WOLy+TUvuDL6pMc= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-ed1-x535.google.com (mail-ed1-x535.google.com [IPv6:2a00:1450:4864:20::535]) by sourceware.org (Postfix) with ESMTPS id 8FBE83853572 for ; Mon, 4 Jul 2022 07:50:17 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 8FBE83853572 Received: by mail-ed1-x535.google.com with SMTP id fd6so10608199edb.5 for ; Mon, 04 Jul 2022 00:50:17 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=ZnDsCaieNxfIZ7gnukNAjAL2S+db/sfsqjUwj5hPZIs=; b=xHaR1RZ6hmJW1A2Ikg022g238QU9qi3txm4jKqeEp2Ynz893LynVdNPd5f7AslA5m2 tBOZBEvkjMaxUzmUZPwtHFqBVtOBoCFUIHg2Dh0SVn6Qy1d+sXsQMUS0mQa1+Bv4RhSv BIZPXnUvfKDqpqbQhCWvWg9cYO/u76orXg9oUUiE7M4FEeniq8LzQunpIg2DWhbVq8A9 aN1hnxgteBrtyREIIrEcRNMaJLnF9Svsz2ZHyEKOi3ixUaXdtZyb1HbWFYnytzQ5iWkb cMBj5/U3r5j381vunwH9/qrA1Qe40/IaO9QKtZLkiSyysD6wcgd2iniGaD16z52h+oe0 2ECw== X-Gm-Message-State: AJIora9fCdeWoFpK2xz7fTiLeYjeLQ35FOaji8FXEhxcf7SYlOHsm+qa +7pXgr+l5/srpw301Xjsa53TF421jEu13Q== X-Google-Smtp-Source: AGRyM1vTdpOshKZMhbgRJJs/G/Al0eBVSMBc8ezPfDNgymEFxFv4NgY/5h7hpmvpzkVyX5Wlb6KVcA== X-Received: by 2002:a05:6402:1741:b0:433:4e4d:bfb4 with SMTP id v1-20020a056402174100b004334e4dbfb4mr36331654edx.7.1656921016452; Mon, 04 Jul 2022 00:50:16 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id m18-20020a056402051200b0043a61f6c389sm1096841edv.4.2022.07.04.00.50.15 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 04 Jul 2022 00:50:15 -0700 (PDT) Date: Mon, 4 Jul 2022 07:50:15 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Call-initialize all controlled objects in place Message-ID: <20220704075015.GA99156@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-13.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Eric Botcazou Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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. : 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,