From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x42b.google.com (mail-wr1-x42b.google.com [IPv6:2a00:1450:4864:20::42b]) by sourceware.org (Postfix) with ESMTPS id 1A95C385842A for ; Mon, 16 Jan 2023 14:48:57 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1A95C385842A 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-x42b.google.com with SMTP id h16so27698251wrz.12 for ; Mon, 16 Jan 2023 06:48:57 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=SV77Z19IPGidYfhKipLj8FBt808f56ixF1CZRUrbAYc=; b=NM4lDOd4m3I37mogojD14ptV7djp/V7RKCrPlkiSD2vTp1C0FM2ek1PclRz2x1vLoD cRqVwYN732C2+e/xjTzJmeyer8FdMO+z4iyyUQCuVIX94xnZpAPk6Xuf4Q2kQe62z/Ur FNWFgo26oXl3jCbZ7zNAJDE6Yq5t3FuzGPC943eOfrPCCIHwF6kzIwAz/AIvfyPr0Tpt aSWwQWbz51HysrtQuYmlnyyW0PvHqmrXF4yo8Aoe3yLoA796qV/ANYfEE5izpetxMOfk vci9qfW8+V2W9HF4J/WoQKnhrVFAYHSbOUxSXGst6s8nWjOFZofx6G52B4GNNnjs5FZS 79cQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; 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=SV77Z19IPGidYfhKipLj8FBt808f56ixF1CZRUrbAYc=; b=L6T015xR32d3hWrafW3TzuHwzmSjKnkt/RPqJ4MgAbUvNkHjDq+WQTuuV7TR4+BWOk 1gbZJnJZIhcYI0leu7bPDg8eDMFQjx2sXz6a7W2OcV1EijueFZ9KGuFRHymJTQEVtLRh 2l09wNrSJuHICXl5mk6+ZqT9EZ+kNJYeRV6ovX3SfozgOc5cAntCWZojS4s/pBmX5reY Q5Z6DiVn7mtkAU7zgf+V1MPtdqjxgLX172W9Q3eW0af6tQDt2mHls5/exjMhx98PaKPC VYooXWp9K3QcUXPTw/QFdt0VW3mGt4BSOBghn5g+vGAZgflSyFGG2v3Lg/PpjPmFZiLw e86w== X-Gm-Message-State: AFqh2kpExDJ8H5K6ENSkMn9cWAeeesTljxjRFMQamR/G6U7GFj4XoLjJ R2wRExmZcRUgKoscn1XBiw8AgmMJ1Ab71Rjr X-Google-Smtp-Source: AMrXdXtem4AA8ezvXzMpF2S/yC8aMxelUrcyYSlKa+E9JGsPFwMvHr8iU1l2xawQA5maKya2g5rUjA== X-Received: by 2002:a5d:6846:0:b0:2be:7a:c15d with SMTP id o6-20020a5d6846000000b002be007ac15dmr4033203wrw.57.1673880535713; Mon, 16 Jan 2023 06:48:55 -0800 (PST) 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 q18-20020adfdfd2000000b002bdc129c8f6sm15000780wrn.43.2023.01.16.06.48.54 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 16 Jan 2023 06:48:55 -0800 (PST) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Further optimize interface objects initialized with function calls Date: Mon, 16 Jan 2023 15:48:53 +0100 Message-Id: <20230116144853.3171463-1-poulhies@adacore.com> X-Mailer: git-send-email 2.34.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.4 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 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: From: Eric Botcazou This further optimizes the usual case of (class-wide) interface objects that are initialized with calls to functions whose result type is the type of the objects (this is not necessary as any result type implementing the interface would do) by avoiding a back-and-forth displacement of the objects' address. This exposed a latent issue whereby the displacement was missing in the case of a simple return statement whose expression is a call to a function whose result type is a specific tagged type that needs finalization. And, in order to avoid pessimizing the expanded code, this in turn required avoiding to create temporaries for allocators by calling Remove_Side_Effects up front, in the common cases when they are not necessary. gcc/ada/ * exp_ch3.adb (Expand_N_Object_Declaration): Do not generate a back- and-forth displacement of the object's address when using a renaming for an interface object with an expression of the same type. * exp_ch4.adb (Expand_Allocator_Expression): Do not remove the side effects of the expression up front for the simple allocators. Do not call the Adjust primitive if the expression is a function call. * exp_ch6.adb (Expand_Ctrl_Function_Call): Do not expand the call unnecessarily for a special return object. (Expand_Simple_Function_Return): Restore the displacement of the return object's address in the case where the expression is the call to a function whose result type is a type that needs finalization. * exp_util.adb (Expand_Subtype_From_Expr): Do not remove the side effects of the expression before calling Make_Subtype_From_Expr. (Make_CW_Equivalent_Type): If the expression has the tag of its type and this type has a uniform size, use 'Object_Size of this type in lieu of 'Size of the expression to compute the expression's size. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch3.adb | 7 +++++++ gcc/ada/exp_ch4.adb | 18 +++++++++++------- gcc/ada/exp_ch6.adb | 22 ++++++++++------------ gcc/ada/exp_util.adb | 36 +++++++++++++++++++++++------------- 4 files changed, 51 insertions(+), 32 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 84594ed106b..bbb53fc6e49 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7589,6 +7589,13 @@ package body Exp_Ch3 is Typ => Base_Typ); end if; + -- Renaming an expression of the object's type is immediate + + elsif Rewrite_As_Renaming + and then Base_Type (Etype (Expr_Q)) = Base_Type (Typ) + then + null; + elsif Tagged_Type_Expansion then declare Iface : constant Entity_Id := Root_Type (Typ); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d3a4f574866..31823eaeca7 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -698,11 +698,14 @@ package body Exp_Ch4 is -- recursion and inappropriate call to Initialize. -- We don't want to remove side effects when the expression must be - -- built in place. In the case of a build-in-place function call, - -- that could lead to a duplication of the call, which was already - -- substituted for the allocator. + -- built in place and we don't need it when there is no storage pool + -- or this is a return/secondary stack allocation. - if not Aggr_In_Place then + if not Aggr_In_Place + and then Present (Storage_Pool (N)) + and then not Is_RTE (Storage_Pool (N), RE_RS_Pool) + and then not Is_RTE (Storage_Pool (N), RE_SS_Pool) + then Remove_Side_Effects (Exp); end if; @@ -747,7 +750,7 @@ package body Exp_Ch4 is -- Processing for allocators returning non-interface types - if not Is_Interface (Directly_Designated_Type (PtrT)) then + if not Is_Interface (DesigT) then if Aggr_In_Place then Temp_Decl := Make_Object_Declaration (Loc, @@ -960,8 +963,9 @@ package body Exp_Ch4 is if Needs_Finalization (DesigT) and then Needs_Finalization (T) - and then not Aggr_In_Place and then not Is_Limited_View (T) + and then not Aggr_In_Place + and then Nkind (Exp) /= N_Function_Call and then not For_Special_Return_Object (N) then -- An unchecked conversion is needed in the classwide case because @@ -993,7 +997,7 @@ package body Exp_Ch4 is -- component containing the secondary dispatch table of the interface -- type. - if Is_Interface (Directly_Designated_Type (PtrT)) then + if Is_Interface (DesigT) then Displace_Allocator_Pointer (N); end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 503fdc1ee6b..7abf25e3859 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5133,14 +5133,11 @@ package body Exp_Ch6 is -- Another optimization: if the returned value is used to initialize an -- object, then no need to copy/readjust/finalize, we can initialize it - -- in place. However, if the call returns on the secondary stack or this - -- is a special return object, then we need the expansion because we'll - -- be renaming the temporary as the (permanent) object. + -- in place. However, if the call returns on the secondary stack, then + -- we need the expansion because we'll be renaming the temporary as the + -- (permanent) object. - if Nkind (Par) = N_Object_Declaration - and then not Use_Sec_Stack - and then not Is_Special_Return_Object (Defining_Entity (Par)) - then + if Nkind (Par) = N_Object_Declaration and then not Use_Sec_Stack then return; end if; @@ -6745,7 +6742,7 @@ package body Exp_Ch6 is null; -- Optimize the case where the result is a function call that also - -- returns on the secondary stack. In this case the result is already + -- returns on the secondary stack; in this case the result is already -- on the secondary stack and no further processing is required. elsif Exp_Is_Function_Call @@ -6781,13 +6778,14 @@ package body Exp_Ch6 is -- gigi is not able to properly allocate class-wide types. -- But optimize the case where the result is a function call that - -- also needs finalization. In this case the result can directly be + -- also needs finalization; in this case the result can directly be -- allocated on the secondary stack and no further processing is - -- required. + -- required, unless the returned object is an interface. elsif CW_Or_Needs_Finalization (Utyp) - and then not (Exp_Is_Function_Call - and then Needs_Finalization (Exp_Typ)) + and then (Is_Interface (R_Type) + or else not (Exp_Is_Function_Call + and then Needs_Finalization (Exp_Typ))) then declare Acc_Typ : constant Entity_Id := Make_Temporary (Loc, 'A'); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index cac0d84e453..f86b93819ac 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -5820,7 +5820,6 @@ package body Exp_Util is -- discriminants. else - Remove_Side_Effects (Exp); Rewrite (Subtype_Indic, Make_Subtype_From_Expr (Exp, Underlying_Record_View (Unc_Type))); end if; @@ -5885,7 +5884,6 @@ package body Exp_Util is end if; else - Remove_Side_Effects (Exp); Rewrite (Subtype_Indic, Make_Subtype_From_Expr (Exp, Unc_Type, Related_Id)); end if; @@ -9496,12 +9494,13 @@ package body Exp_Util is Root_Utyp : constant Entity_Id := Underlying_Type (Root_Typ); List_Def : constant List_Id := Empty_List; Comp_List : constant List_Id := New_List; + Equiv_Type : Entity_Id; Range_Type : Entity_Id; Str_Type : Entity_Id; Constr_Root : Entity_Id; + Size_Attr : Node_Id; Size_Expr : Node_Id; - Size_Pref : Node_Id; function Has_Tag_Of_Type (Exp : Node_Id) return Boolean; -- Return True if expression Exp of a tagged type is known to statically @@ -9597,9 +9596,26 @@ package body Exp_Util is -- the _Size primitive operation. if Has_Tag_Of_Type (E) then - Size_Pref := Duplicate_Subexpr_No_Checks (E); + if not Has_Discriminants (Etype (E)) + or else Is_Constrained (Etype (E)) + then + Size_Attr := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Etype (E), Loc), + Attribute_Name => Name_Object_Size); + + else + Size_Attr := + Make_Attribute_Reference (Loc, + Prefix => Duplicate_Subexpr_No_Checks (E), + Attribute_Name => Name_Size); + end if; + else - Size_Pref := OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)); + Size_Attr := + Make_Attribute_Reference (Loc, + Prefix => OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)), + Attribute_Name => Name_Size); end if; if not Is_Interface (Root_Typ) then @@ -9610,10 +9626,7 @@ package body Exp_Util is Size_Expr := Make_Op_Subtract (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => Size_Pref, - Attribute_Name => Name_Size), + Left_Opnd => Size_Attr, Right_Opnd => Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Constr_Root, Loc), @@ -9625,10 +9638,7 @@ package body Exp_Util is Size_Expr := Make_Op_Subtract (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => Size_Pref, - Attribute_Name => Name_Size), + Left_Opnd => Size_Attr, Right_Opnd => Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (RTE (RE_Tag), Loc), -- 2.34.1