From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id 956793851145 for ; Mon, 12 Sep 2022 08:19:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 956793851145 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wr1-x42f.google.com with SMTP id o25so14061715wrf.9 for ; Mon, 12 Sep 2022 01:19:41 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; h=content-disposition:mime-version:message-id:subject:cc:to:from:date :from:to:cc:subject:date; bh=CPS5edPwsswVX5AyvuqCwLS806k24FnYwg3vcThAvYE=; b=QDvGXA5Yxs4ZaCoQJRiA7K0WGAzETKUPcMv5azh+/KI+E/iiVkBRLZGy17D2M9CkT6 bGKZfiyt5C71zfms82e44AQeU5YellLjLE+oWqnByeqkU8ush9QqEeUOaXM3x2Jx/gzP 28ywo/CEHx6WTBCR0i2W9FkL9UuZcV8w9anZI2WCqUDiQhJS9ATg7mxI0EYLJ4G+LYQ8 euPXv94ojQL0+686ubqs2Cl9sBP3cPBaia8PShnCz3LdBUzLnbicmDhqraxPlNkPkTqH iRQlKKWSKxL9K9PpI88BuIFApXtOWK0wb5T3EvDhhOOQU8EgKXVb4TOSvea0KI86fJEd 6rcA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-disposition:mime-version:message-id:subject:cc:to:from:date :x-gm-message-state:from:to:cc:subject:date; bh=CPS5edPwsswVX5AyvuqCwLS806k24FnYwg3vcThAvYE=; b=f2PUcaqlh34fFbjnvnhX7/QkGlyNxHBTmZZmdBFZc8zaQr7FxRGgWa5tjb0GlkJm4O 02bHVB1eWrb28RB094QEZ5vDrOjaiuMuP9VPwvDo9HExtdsyOzJ02LeQY4K7yvJdNZ15 OiBpf47U4qUchxODcc8WdcdsY+L3heLkOnWL3Tlb+OWa4nBzsxoUaYm+B+iqUUPU53jc Vh5plA/i9XnHHgKX6nQax0UgA/AidsWrLzAWzK3nd+hVS0pN9glHKo6HHHsQaPWQtbN/ D3It5uFQBUTqoeUfJYiwPqpTIiwSo/40yva/D7YifjsKkBllwUAuYPeiSIKMzdtoy4Nn A0ew== X-Gm-Message-State: ACgBeo2hCjHWytD+CEBqBfDamLRFdS0l6tt08s9cJobvQUu9+z4bSa7X 1APtJbjX5CZ0S7FQdPjhjaSJZydrSrDUDw== X-Google-Smtp-Source: AA6agR6oi/Yklrz8NyLd4qHl/HSxVvf1cELriY3OycjiRz0d78b8ROJ5+63gpKTaoYlxvudcLtJrXg== X-Received: by 2002:a5d:6543:0:b0:22a:3877:7bc9 with SMTP id z3-20020a5d6543000000b0022a38777bc9mr8858329wrv.142.1662970780442; Mon, 12 Sep 2022 01:19:40 -0700 (PDT) Received: from poulhies-Precision-5550 (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id b14-20020a5d634e000000b00228da396f9dsm6503427wrw.84.2022.09.12.01.19.39 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 12 Sep 2022 01:19:39 -0700 (PDT) Date: Mon, 12 Sep 2022 10:19:39 +0200 From: Marc =?iso-8859-1?Q?Poulhi=E8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Temporary tweak new expansion of contracts Message-ID: <20220912081939.GA1513086@poulhies-Precision-5550> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="tKW2IUtsqtDRztdT" Content-Disposition: inline X-Spam-Status: No, score=-12.8 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 List-Id: --tKW2IUtsqtDRztdT Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In the case of a function, the new expansion of contracts makes use of an extended return statement to store the result of the function in the return object while the post-conditions are evaluated. Unfortunately GNAT does not elide the copy of the return object for extended return statements for the time being, so this scheme incurs an extra copy of the return value on the primary or secondary stack, as well as an additional pair of calls to Adjust/Finalize when the return type needs finalization. This temporarily changes the expansion to use a block statement containing a renaming, which does not incur the extra copy provided that it is manually adjusted to be recognized by the existing "tail call" optimization present in the Expand_Simple_Function_Return routine. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * contracts.adb (uild_Subprogram_Contract_Wrapper): Remove useless local variable. In the case of a function, replace the extended return statement by a block statement declaring a renaming of the call to the local subprogram after removing side effects manually. (Expand_Subprogram_Contract): Adjust description accordingly. * exp_ch6.adb (Expand_Ctrl_Function_Call): Rewrite obsolete comment and do not apply the transformation twice. * sem_attr.adb (Analyze_Attribute_Old_Result): Now expect a block statement instead of an extended return statement. --tKW2IUtsqtDRztdT Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -1577,7 +1577,6 @@ package body Contracts is Decls : List_Id; Result : Entity_Id) is - Actuals : constant List_Id := Empty_List; Body_Decl : constant Entity_Id := Unit_Declaration_Node (Body_Id); Loc : constant Source_Ptr := Sloc (Body_Decl); Spec_Id : constant Entity_Id := Corresponding_Spec (Body_Decl); @@ -1606,11 +1605,11 @@ package body Contracts is Ret_Type := Etype (Subp_Id); -- Generate the contracts wrapper by moving the original declarations - -- and statements within a local subprogram and calling it within - -- an extended return to preserve the result for the purpose of - -- evaluating postconditions, contracts, type invariants, etc. + -- and statements within a local subprogram, calling it and possibly + -- preserving the result for the purpose of evaluating postconditions, + -- contracts, type invariants, etc. - -- Generate: + -- In the case of a function, generate: -- -- function Original_Func (X : in out Integer) return Typ is -- @@ -1623,13 +1622,25 @@ package body Contracts is -- end; -- -- begin - -- return - -- Result_Obj : constant Typ := _Wrapped_Statements - -- do + -- declare + -- type Axx is access all Typ; + -- Rxx : constant Axx := _Wrapped_Statements'reference; + -- Result_Obj : Typ renames Rxx.all; + -- + -- begin -- - -- end return; + -- return Rxx.all; + -- end; -- end; -- + -- This sequence is recognized by Expand_Simple_Function_Return as a + -- tail call, in other words equivalent to "return _Wrapped_Statements;" + -- and thus the copy to the anonymous return object is elided, including + -- a pair of calls to Adjust/Finalize for types requiring finalization. + + -- Note that an extended return statement does not yield the same result + -- because the copy of the return object is not elided by GNAT for now. + -- Or, in the case of a procedure: -- -- procedure Original_Proc (X : in out Integer) is @@ -1680,8 +1691,7 @@ package body Contracts is Set_Declarations (Body_Decl, Decls); Set_Handled_Statement_Sequence (Body_Decl, Make_Handled_Sequence_Of_Statements (Loc, - End_Label => Make_Identifier (Loc, Chars (Wrapper_Id)), - Statements => New_List)); + End_Label => Make_Identifier (Loc, Chars (Wrapper_Id)))); -- Move certain flags which are relevant to the body @@ -1697,7 +1707,7 @@ package body Contracts is Set_Has_Pragma_Inline_Always (Wrapper_Id, Has_Pragma_Inline_Always (Subp_Id)); - -- Generate call to the wrapper + -- Prepend a call to the wrapper when the subprogram is a procedure if No (Ret_Type) or else Ret_Type = Standard_Void_Type then Prepend_To (Stmts, @@ -1706,25 +1716,64 @@ package body Contracts is Set_Statements (Handled_Statement_Sequence (Body_Decl), Stmts); - -- Generate the post-execution statements and the extended return - -- when the subprogram being wrapped is a function. + -- Declare a renaming of the result of the call to the wrapper and + -- append a return of the result of the call when the subprogram is + -- a function, after manually removing the side effects. Note that + -- we cannot call Remove_Side_Effects here because nothing has been + -- analyzed yet and we cannot return the renaming itself because + -- Expand_Simple_Function_Return expects an explicit dereference. else - Set_Statements (Handled_Statement_Sequence (Body_Decl), New_List ( - Make_Extended_Return_Statement (Loc, - Return_Object_Declarations => New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => Result, - Object_Definition => - New_Occurrence_Of (Ret_Type, Loc), - Expression => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (Wrapper_Id, Loc), - Parameter_Associations => Actuals))), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stmts)))); + declare + A_Id : constant Node_Id := Make_Temporary (Loc, 'A'); + R_Id : constant Node_Id := Make_Temporary (Loc, 'R'); + + begin + Set_Statements (Handled_Statement_Sequence (Body_Decl), New_List ( + Make_Block_Statement (Loc, + + Declarations => New_List ( + Make_Full_Type_Declaration (Loc, + Defining_Identifier => A_Id, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + All_Present => True, + Null_Exclusion_Present => True, + Subtype_Indication => + New_Occurrence_Of (Ret_Type, Loc))), + + Make_Object_Declaration (Loc, + Defining_Identifier => R_Id, + Object_Definition => New_Occurrence_Of (A_Id, Loc), + Constant_Present => True, + Expression => + Make_Reference (Loc, + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Wrapper_Id, Loc)))), + + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Result, + Subtype_Mark => New_Occurrence_Of (Ret_Type, Loc), + Name => + Make_Explicit_Dereference (Loc, + New_Occurrence_Of (R_Id, Loc)))), + + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Stmts)))); + + Append_To (Stmts, + Make_Simple_Return_Statement (Loc, + Expression => + Make_Explicit_Dereference (Loc, + New_Occurrence_Of (R_Id, Loc)))); + + -- It is required for Is_Related_To_Func_Return to return True + -- that the temporary Rxx be related to the expression of the + -- simple return statement built just above. + + Set_Related_Expression (R_Id, Expression (Last (Stmts))); + end; end if; end Build_Subprogram_Contract_Wrapper; @@ -3387,16 +3436,16 @@ package body Contracts is -- -- - -- function _wrapped_statements (...) return ... is + -- function _Wrapped_Statements (...) return ... is -- -- begin -- - -- end _wrapped_statements; + -- end _Wrapped_Statements; -- begin - -- return - -- Result : ... := _wrapped_statements - -- do + -- declare + -- Result : ... renames _Wrapped_Statements; + -- begin -- -- -- @@ -3405,7 +3454,7 @@ package body Contracts is -- --