From patchwork Mon May 29 08:29:25 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 100156 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:994d:0:b0:3d9:f83d:47d9 with SMTP id k13csp1364760vqr; Mon, 29 May 2023 01:41:11 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ4T3MMsMtyGcyC5TvOsiroGMJ2U9bB+HJuNNR7ljNj8zNRXGhExJbULOZxG8IShnCfqvnpQ X-Received: by 2002:a17:907:7b87:b0:966:5c04:2c61 with SMTP id ne7-20020a1709077b8700b009665c042c61mr11127082ejc.8.1685349671011; Mon, 29 May 2023 01:41:11 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1685349670; cv=none; d=google.com; s=arc-20160816; b=u0/pKjngyVDRjddaajkYhcq3uQMfOkGE9RpblotRxwFKfWc3m4iXDXoqGoJzY3CChV 4nIBwYywl11F9zyfUqfj045WMVzIfXuEb76DsSnuyy7mq4y0kXCNqIRi3BjmyoqSdFHW +ZHRPEJD/A7Rn4lT1Y1mLRZaHztwzMME9icqU50FqhQVPpohHAFD8M6sw+5G/f8HayJM CppXY2VP7tCvSUupMMx1mj96TBNIpTBri3GBmSAN6dRcWtraimMEGP94Qjz6SWi5uz7s hb7uT7a0r5d++xBfkkOe+aisDFNyTOia+frzOJy6vsMnCMbhlweFHm9yRANyWQ7qbZNU Jejg== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence :content-transfer-encoding:mime-version:message-id:date:subject:cc :to:dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=fwrmPPCzozH3b5PdeEzquiHXNah8hbCVHhFt8VbYwNw=; b=vNn8wwDsZFNdDsLrxh1y8Lb/Ym9b8D/WRXjb7IRF2BaQ23Q2EMd0K8BAn2sukFzYpD 7+UuKKomrCgHoFVFgpNTPrAVxXSpUOwAyh74vLPGXlpOfE7JAMr1CbwPPTCwAPmt/ToA YsG/ubDfyZ7i1qHfzroz9A3q4M6BCXtIawmj+XTaeJ/NYR2XXCNFnswTSeYC0Pdjay4Q //2+gPdvlF5gaQ0D5l6qkwsSbwDrdjMNF91LHFmaDu8Moc+6aI9XO/95Q+eDcGx/mO1R i3CcAJPzJ2HRiT3zccw9lZhyZEgJvMy51QoZsdHCmAl+PhlkicLltcqImZIwd3xwXipA +Mmw== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=facF4ki4; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id js12-20020a17090797cc00b00969ee50a2bbsi32129ejc.158.2023.05.29.01.41.10 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 29 May 2023 01:41:10 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=facF4ki4; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 237CD3894C16 for ; Mon, 29 May 2023 08:35:41 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 237CD3894C16 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1685349341; bh=fwrmPPCzozH3b5PdeEzquiHXNah8hbCVHhFt8VbYwNw=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=facF4ki4i6Y2/liTWIUWLAiCtoTEQNZweajYRzjZ4rleq4le2/Hp2RHrhyxJkJq5D qNyQRVZW0IFtwKz0+TtZtfUvQ9nQFnCcY2GVeqdn2OgwqShlsvBnLt0ZtjGFv5K857 G2nQCivDy0WHUableg6TOSdeo2OfmV0sYVXNfOQY= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42e.google.com (mail-wr1-x42e.google.com [IPv6:2a00:1450:4864:20::42e]) by sourceware.org (Postfix) with ESMTPS id 1A068384DA73 for ; Mon, 29 May 2023 08:29:28 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1A068384DA73 Received: by mail-wr1-x42e.google.com with SMTP id ffacd0b85a97d-30ae95c4e75so919209f8f.2 for ; Mon, 29 May 2023 01:29:28 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1685348967; x=1687940967; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=fwrmPPCzozH3b5PdeEzquiHXNah8hbCVHhFt8VbYwNw=; b=gBrtuYFfBTUGVZDo5452UET+Yuxo8jONaemDOJWytnG2NlUu6TA4FhNlMkJ5o3D953 EfOQBc2Tz/1s8lr6/VBFjVjDNGYzXo8YYPcdgJlFXpJ+zGZSFkAhHV67N9YMeKBNaef6 ms2iy3RIoDwQcrdwcg4vPLT+NpuYPD1kkVposhcBZtl9H3+acx6zt3Qq0hr7IbplqWPO e0Ytbj17eWIC2C8rd+4VN3Llvp124aG8J08zlM0RH6A0bH8a8v3CD08L/Wq7lvjbSbno NIdeBjxrKOFYwLVy52ySPCMwKqBkPYjhcrHPDWhXOZjSfTY4VCUEtQu9eZH94y3ZSjJQ 4gOg== X-Gm-Message-State: AC+VfDwPn3JPezD6zWjZ8LNd5jlb52zbjNozeVVxQYQ+Keug/NJn97aG uhAFA0sfw0F8U7MbO1aI/eozFXz/DIxxuqFLJLy3Jg== X-Received: by 2002:adf:ef8b:0:b0:30a:e92c:25fa with SMTP id d11-20020adfef8b000000b0030ae92c25famr2691579wro.60.1685348966894; Mon, 29 May 2023 01:29:26 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id b14-20020adff90e000000b00307972e46fasm12757812wrr.107.2023.05.29.01.29.26 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 29 May 2023 01:29:26 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix wrong finalization for call to BIP function in conditional expression Date: Mon, 29 May 2023 10:29:25 +0200 Message-Id: <20230529082925.2410202-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-10.7 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPAM_BODY, 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: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1767217216961974463?= X-GMAIL-MSGID: =?utf-8?q?1767217216961974463?= From: Eric Botcazou This happens when the call is a dependent expression of the conditional expression, and the conditional expression is either the expression of a simple return statement or the return expression of an expression function. The reason is that the special processing of "tail calls" for BIP functions, i.e. calls that are the expression of simple return statements or the return expression of expression functions, is not applied. This change makes sure that it is applied by distributing the simple return statements enclosing conditional expressions into the dependent expressions of the conditional expressions in almost all cases. As a side effect, this elides a temporary in the nonlimited by-reference case, as well as a pair of calls to Adjust/Finalize in the nonlimited controlled case. gcc/ada/ * exp_ch4.adb (Expand_N_Case_Expression): Distribute simple return statements enclosing the conditional expression into the dependent expressions in almost all cases. (Expand_N_If_Expression): Likewise. (Process_Transient_In_Expression): Adjust to the above distribution. * exp_ch6.adb (Expand_Ctrl_Function_Call): Deal with calls in the dependent expressions of a conditional expression. * sem_ch6.adb (Analyze_Function_Return): Deal with the rewriting of a simple return statement during the resolution of its expression. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch4.adb | 171 +++++++++++++++++++++++++++++++------------- gcc/ada/exp_ch6.adb | 10 ++- gcc/ada/sem_ch6.adb | 12 +++- 3 files changed, 138 insertions(+), 55 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 7be240bce0e..3f864f2675c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5401,17 +5401,6 @@ package body Exp_Ch4 is -- when minimizing expressions with actions (e.g. when generating C -- code) since it allows us to do the optimization below in more cases. - -- Small optimization: when the case expression appears in the context - -- of a simple return statement, expand into - - -- case X is - -- when A => - -- return AX; - -- when B => - -- return BX; - -- ... - -- end case; - Case_Stmt := Make_Case_Statement (Loc, Expression => Expression (N), @@ -5425,17 +5414,29 @@ package body Exp_Ch4 is Set_From_Conditional_Expression (Case_Stmt); Acts := New_List; + -- Small optimization: when the case expression appears in the context + -- of a simple return statement, expand into + + -- case X is + -- when A => + -- return AX; + -- when B => + -- return BX; + -- ... + -- end case; + + -- This makes the expansion much easier when expressions are calls to + -- a BIP function. But do not perform it when the return statement is + -- within a predicate function, as this causes spurious errors. + + Optimize_Return_Stmt := + Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate; + -- Scalar/Copy case if Is_Copy_Type (Typ) then Target_Typ := Typ; - -- Do not perform the optimization when the return statement is - -- within a predicate function, as this causes spurious errors. - - Optimize_Return_Stmt := - Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate; - -- Otherwise create an access type to handle the general case using -- 'Unrestricted_Access. @@ -5498,16 +5499,6 @@ package body Exp_Ch4 is -- scalar types. This approach avoids big copies and covers the -- limited and unconstrained cases. - -- Generate: - -- AX'Unrestricted_Access - - if not Is_Copy_Type (Typ) then - Alt_Expr := - Make_Attribute_Reference (Alt_Loc, - Prefix => Relocate_Node (Alt_Expr), - Attribute_Name => Name_Unrestricted_Access); - end if; - -- Generate: -- return AX['Unrestricted_Access]; @@ -5520,6 +5511,13 @@ package body Exp_Ch4 is -- Target := AX['Unrestricted_Access]; else + if not Is_Copy_Type (Typ) then + Alt_Expr := + Make_Attribute_Reference (Alt_Loc, + Prefix => Relocate_Node (Alt_Expr), + Attribute_Name => Name_Unrestricted_Access); + end if; + LHS := New_Occurrence_Of (Target, Loc); Set_Assignment_OK (LHS); @@ -5789,6 +5787,7 @@ package body Exp_Ch4 is Loc : constant Source_Ptr := Sloc (N); Thenx : constant Node_Id := Next (Cond); Elsex : constant Node_Id := Next (Thenx); + Par : constant Node_Id := Parent (N); Typ : constant Entity_Id := Etype (N); Force_Expand : constant Boolean := Is_Anonymous_Access_Actual (N); @@ -5821,6 +5820,10 @@ package body Exp_Ch4 is UI_Max (Hi1, Hi2) - UI_Min (Lo1, Lo2) < Too_Large_Length_For_Array; end OK_For_Single_Subtype; + Optimize_Return_Stmt : Boolean := False; + -- Flag set when the if expression can be optimized in the context of + -- a simple return statement. + -- Local variables Actions : List_Id; @@ -5912,6 +5915,50 @@ package body Exp_Ch4 is end; end if; + -- Small optimization: when the if expression appears in the context of + -- a simple return statement, expand into + + -- if cond then + -- return then-expr + -- else + -- return else-expr; + -- end if; + + -- This makes the expansion much easier when expressions are calls to + -- a BIP function. But do not perform it when the return statement is + -- within a predicate function, as this causes spurious errors. + + Optimize_Return_Stmt := + Nkind (Par) = N_Simple_Return_Statement + and then not (Ekind (Current_Scope) in E_Function | E_Procedure + and then Is_Predicate_Function (Current_Scope)); + + if Optimize_Return_Stmt then + -- When the "then" or "else" expressions involve controlled function + -- calls, generated temporaries are chained on the corresponding list + -- of actions. These temporaries need to be finalized after the if + -- expression is evaluated. + + Process_If_Case_Statements (N, Then_Actions (N)); + Process_If_Case_Statements (N, Else_Actions (N)); + + New_If := + Make_Implicit_If_Statement (N, + Condition => Relocate_Node (Cond), + Then_Statements => New_List ( + Make_Simple_Return_Statement (Sloc (Thenx), + Expression => Relocate_Node (Thenx))), + Else_Statements => New_List ( + Make_Simple_Return_Statement (Sloc (Elsex), + Expression => Relocate_Node (Elsex)))); + + -- Preserve the original context for which the if statement is + -- being generated. This is needed by the finalization machinery + -- to prevent the premature finalization of controlled objects + -- found within the if statement. + + Set_From_Conditional_Expression (New_If); + -- If the type is limited, and the back end does not handle limited -- types, then we expand as follows to avoid the possibility of -- improper copying. @@ -5931,7 +5978,7 @@ package body Exp_Ch4 is -- This special case can be skipped if the back end handles limited -- types properly and ensures that no incorrect copies are made. - if Is_By_Reference_Type (Typ) + elsif Is_By_Reference_Type (Typ) and then not Back_End_Handles_Limited_Types then -- When the "then" or "else" expressions involve controlled function @@ -6253,9 +6300,10 @@ package body Exp_Ch4 is -- Note that the test for being in an object declaration avoids doing an -- unnecessary expansion, and also avoids infinite recursion. - elsif Is_Array_Type (Typ) and then not Is_Constrained (Typ) - and then (Nkind (Parent (N)) /= N_Object_Declaration - or else Expression (Parent (N)) /= N) + elsif Is_Array_Type (Typ) + and then not Is_Constrained (Typ) + and then not (Nkind (Par) = N_Object_Declaration + and then Expression (Par) = N) then declare Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N); @@ -6418,14 +6466,14 @@ package body Exp_Ch4 is -- in order to make sure that no branch is shared between the decisions. elsif Opt.Suppress_Control_Flow_Optimizations - and then Nkind (Original_Node (Parent (N))) in N_Case_Expression - | N_Case_Statement - | N_If_Expression - | N_If_Statement - | N_Goto_When_Statement - | N_Loop_Statement - | N_Return_When_Statement - | N_Short_Circuit + and then Nkind (Original_Node (Par)) in N_Case_Expression + | N_Case_Statement + | N_If_Expression + | N_If_Statement + | N_Goto_When_Statement + | N_Loop_Statement + | N_Return_When_Statement + | N_Short_Circuit then declare Cnn : constant Entity_Id := Make_Temporary (Loc, 'C'); @@ -6466,20 +6514,35 @@ package body Exp_Ch4 is -- change it to the SLOC of the expression which, after expansion, will -- correspond to what is being evaluated. - if Present (Parent (N)) and then Nkind (Parent (N)) = N_If_Statement then - Set_Sloc (New_If, Sloc (Parent (N))); - Set_Sloc (Parent (N), Loc); + if Present (Par) and then Nkind (Par) = N_If_Statement then + Set_Sloc (New_If, Sloc (Par)); + Set_Sloc (Par, Loc); end if; -- Move Then_Actions and Else_Actions, if any, to the new if statement - Insert_List_Before (First (Then_Statements (New_If)), Then_Actions (N)); - Insert_List_Before (First (Else_Statements (New_If)), Else_Actions (N)); + if Present (Then_Actions (N)) then + Prepend_List (Then_Actions (N), Then_Statements (New_If)); + end if; - Insert_Action (N, Decl); - Insert_Action (N, New_If); - Rewrite (N, New_N); - Analyze_And_Resolve (N, Typ); + if Present (Else_Actions (N)) then + Prepend_List (Else_Actions (N), Else_Statements (New_If)); + end if; + + -- Rewrite the parent return statement as an if statement + + if Optimize_Return_Stmt then + Rewrite (Par, New_If); + Analyze (Par); + + -- Otherwise rewrite the if expression itself + + else + Insert_Action (N, Decl); + Insert_Action (N, New_If); + Rewrite (N, New_N); + Analyze_And_Resolve (N, Typ); + end if; end Expand_N_If_Expression; ----------------- @@ -15089,12 +15152,18 @@ package body Exp_Ch4 is -- -- in Result end; - -- As a result, the finalization of any transient objects can safely - -- take place after the result capture. + -- As a result, the finalization of any transient objects can take place + -- just after the result is captured, except for the case of conditional + -- expressions in a simple return statement because the return statement + -- will be distributed into the conditional expressions (see the special + -- handling of simple return statements a few lines below). -- ??? could this be extended to elementary types? - if Is_Boolean_Type (Etype (Expr)) then + if Is_Boolean_Type (Etype (Expr)) + and then (Nkind (Expr) = N_Expression_With_Actions + or else Nkind (Parent (Expr)) /= N_Simple_Return_Statement) + then Fin_Context := Last (Stmts); -- Otherwise the immediate context may not be safe enough to carry diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 50d66e34ff7..bd4f4a1412d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5188,8 +5188,16 @@ package body Exp_Ch6 is -- 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. + -- Note that simple return statements are distributed into conditional + -- expressions but we may be invoked before this distribution is done. - if Nkind (Par) = N_Simple_Return_Statement then + if Nkind (Par) = N_Simple_Return_Statement + or else (Nkind (Par) = N_If_Expression + and then Nkind (Parent (Par)) = N_Simple_Return_Statement) + or else (Nkind (Par) = N_Case_Expression_Alternative + and then + Nkind (Parent (Parent (Par))) = N_Simple_Return_Statement) + then return; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c58a5488cd2..495e8b1c538 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -857,6 +857,14 @@ package body Sem_Ch6 is end if; Resolve (Expr, R_Type); + + -- The expansion of the expression may have rewritten the return + -- statement itself, e.g. when it is a conditional expression. + + if Nkind (N) /= N_Simple_Return_Statement then + return; + end if; + Check_Limited_Return (N, Expr, R_Type); Check_Return_Construct_Accessibility (N, Stm_Entity); @@ -952,9 +960,7 @@ package body Sem_Ch6 is -- Defend against previous errors - if Nkind (Expr) = N_Empty - or else No (Etype (Expr)) - then + if Nkind (Expr) = N_Empty or else No (Etype (Expr)) then return; end if;