From patchwork Mon May 20 07:48:39 2024 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: 90455 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 EE2673858C3A for ; Mon, 20 May 2024 07:54:59 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32b.google.com (mail-wm1-x32b.google.com [IPv6:2a00:1450:4864:20::32b]) by sourceware.org (Postfix) with ESMTPS id 48177385840E for ; Mon, 20 May 2024 07:49:23 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 48177385840E Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 48177385840E Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32b ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1716191368; cv=none; b=R2SXeYJONIwYsNvlw2BDo3WsSL4VF8KDt7uYcsaGXMpXWNnL3+BCdubLTJUPlDQ1WkvxONE+zVj09b0VihISPQ375ihpoGPAFToUWmAfuLmuEKtv3tWlBrRNx2MIhhAFerozbSHPX4kyAy78EFtCW5qy2wpDHGy2WG3Qe/LCpAQ= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1716191368; c=relaxed/simple; bh=5pS96PYB7RYKSQuLNzb6VNg7Qwdp16BUGccGUJ4lY/8=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=GgtxLi7WvKgZs0/SPMj3AREh0W0qwsXHfAgG1k/J1ZasYaCTpqmjAKtNYWuaXYX/lRf2rgZxjdDDhLEiOnAYm6U5HcDHKivgg2jDkDKEG2c4clhx122qTU/LQ/SqZJARBf1jMhxSe1XiUO6lTpdNlL1WHR0a/RCBpnQso99u3Ww= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x32b.google.com with SMTP id 5b1f17b1804b1-4202ca70289so16694065e9.1 for ; Mon, 20 May 2024 00:49:23 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1716191362; x=1716796162; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=IfIQLIoPkaPcgRWnFjkdZER4tjMZ5VyPRzj/xzUEKcg=; b=O416cyzlb4lVBuh8JcPsgXSQUf92VIAsmcWX6pPDJcXOcwVtndRKDQztS+08NANrb4 D9CENiLZvynpjLVri77gVV/ZJXUPu133FiSOGaRRsRnukuvkEAZlsb/heMZT1DkgAKok jRceII74rLCz53Itg22tclG05L9DCEJ2Yv5Jovbf3pZzBBzLnd/SHenpJtkNsDLe+sCf ceFT1EniLMK5uIgwnxr8IuGTSaNDycavjGQWInnNI+hIAu3IrYz4zxUvCqu18zTK8tnO 8lYuVQ0v9EZ6nrNKq3F6Z3Dl0yJ83m/0aFclkG/BySJzum5cZH598HxGZYq16R0OkUJt S/LA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1716191362; x=1716796162; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=IfIQLIoPkaPcgRWnFjkdZER4tjMZ5VyPRzj/xzUEKcg=; b=vOXYo2A/Za+NwzNt5KX+0zY0mfLP3pnQOYFU6gH51Grywa8qdtgyk0k/h4hCRzPJLy Vv+1ibY+NiVoOIaFn57K+lWyqByfdHfKT/dvDxy0DgzPoOkvb4rNxX72ntr/CaDYOh7A SG7G6NfHr7TBiT5hrn0LOYENh1MQr37e/fvmhwDUiFeOKc5Ipq5S6xn/4RwuMnfv494n YOJ98tkvtuG6foqqgP8T0klruJMxZ4vgmbS2qepxC1Ohav4Kb1urjjQJ+ieLqUX5MFJ2 6VDFgYImEQe5rxH+P30s6yadj5YopDfaTehiOVyStK+xhZAZXH/Q8mc2zL/MtFWSiIAL jWkQ== X-Gm-Message-State: AOJu0YwUCVujmSVm6ztG2T2hAN7YOqzbSYR8ZVI/3vbpJi81kMQ+XFnR 5twLc1AMESJFSZBmaPI+iiAIQqgwUFcvVKF9zt4RvJKLJH5bDm98rQTQmAOItY0rGDdQmIrYErY = X-Google-Smtp-Source: AGHT+IE1BRoahXGqFQbYbPq6NMXoPvO2fcGTGE/qaPFt4wuVjgnIUOvHqlBJhTrwMqdPv9KiNJeyKA== X-Received: by 2002:a05:600c:3b86:b0:41b:e84d:67a3 with SMTP id 5b1f17b1804b1-41fea53887cmr223154825e9.0.1716191361723; Mon, 20 May 2024 00:49:21 -0700 (PDT) Received: from poulhies-Precision-5550.lan ([2001:861:3382:1a90:de37:8b1c:1f33:2610]) by smtp.gmail.com with ESMTPSA id 5b1f17b1804b1-41f88111033sm446892175e9.34.2024.05.20.00.49.21 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 20 May 2024 00:49:21 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 13/30] ada: Extend expansion delaying mechanism to conditional expressions Date: Mon, 20 May 2024 09:48:39 +0200 Message-ID: <20240520074858.222435-13-poulhies@adacore.com> X-Mailer: git-send-email 2.43.2 In-Reply-To: <20240520074858.222435-1-poulhies@adacore.com> References: <20240520074858.222435-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, 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 X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org From: Eric Botcazou When an aggregate that needs to be converted into a series of assignments is present in an expression of a parent aggregate, or in the expression of an allocator, an object declaration, or an assignment in very specific cases, its expansion is delayed until its parent itself is expanded. This makes it possible to avoid creating a superfluous temporary for the aggregate. This change extends the delaying mechanism in the case of record aggregates to intermediate conditional expressions, that is to say, to the conditional expressions that are present between the parent and the aggregate, provided that the aggregate be a dependent expression, directly or recursively. This again makes it possible to avoid creating a temporary for the aggregate. gcc/ada/ * exp_aggr.ads (Is_Delayed_Conditional_Expression): New predicate. * exp_aggr.adb (Convert_To_Assignments.Known_Size): Likewise. (Convert_To_Assignments): Climb the parent chain, looking through qualified expressions and dependent expressions of conditional expressions, to find out whether the expansion may be delayed. Call Known_Size for this in the case of an object declaration. If so, set Expansion_Delayed on the aggregate as well as all the intermediate conditional expressions. (Initialize_Component): Reset the Analyzed flag on an initialization expression that is a conditional expression whose expansion has been delayed. (Is_Delayed_Conditional_Expression): New predicate. * exp_ch3.adb (Expand_N_Object_Declaration): Handle initialization expressions that are conditional expressions whose expansion has been delayed. * exp_ch4.adb (Build_Explicit_Assignment): New procedure. (Expand_Allocator_Expression): Handle initialization expressions that are conditional expressions whose expansion has been delayed. (Expand_N_Case_Expression): Deal with expressions whose expansion has been delayed by waiting for the rewriting of their parent as an assignment statement and then optimizing the assignment. (Expand_N_If_Expression): Likewise. (Expand_N_Qualified_Expression): Do not apply a predicate check to an operand that is a delayed aggregate or conditional expression. * gen_il-gen-gen_nodes.adb (N_If_Expression): Add Expansion_Delayed semantic flag. (N_Case_Expression): Likewise. * sinfo.ads (Expansion_Delayed): Document extended usage. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 201 ++++++++++++----- gcc/ada/exp_aggr.ads | 4 + gcc/ada/exp_ch3.adb | 38 ++++ gcc/ada/exp_ch4.adb | 363 ++++++++++++++++++++++++------- gcc/ada/gen_il-gen-gen_nodes.adb | 4 +- gcc/ada/sinfo.ads | 4 + 6 files changed, 479 insertions(+), 135 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6208b49ffd9..a386aa85ae4 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4216,84 +4216,152 @@ package body Exp_Aggr is procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is Loc : constant Source_Ptr := Sloc (N); - Aggr_Code : List_Id; - Full_Typ : Entity_Id; - Instr : Node_Id; - Parent_Kind : Node_Kind; - Parent_Node : Node_Id; - Target_Expr : Node_Id; - Temp : Entity_Id; - Unc_Decl : Boolean := False; + function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean; + -- Decl is an N_Object_Declaration node. Return true if it declares an + -- object with a known size; in this context, that is always the case, + -- except for a declaration without explicit constraints of an object, + -- either whose nominal subtype is class-wide, or whose initialization + -- contains a conditional expression and whose nominal subtype is both + -- discriminated and unconstrained. + + ---------------- + -- Known_Size -- + ---------------- + + function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean + is + begin + if Is_Entity_Name (Object_Definition (Decl)) then + declare + Typ : constant Entity_Id := Entity (Object_Definition (Decl)); + + begin + return not Is_Class_Wide_Type (Typ) + and then not (Cond_Init + and then Has_Discriminants (Typ) + and then not Is_Constrained (Typ)); + end; + + else + return True; + end if; + end Known_Size; + + -- Local variables + + Aggr_Code : List_Id; + Full_Typ : Entity_Id; + In_Cond_Expr : Boolean; + Instr : Node_Id; + Node : Node_Id; + Parent_Node : Node_Id; + Target_Expr : Node_Id; + Temp : Entity_Id; + + -- Start of processing for Convert_To_Assignments begin pragma Assert (Nkind (N) in N_Aggregate | N_Extension_Aggregate); pragma Assert (not Is_Static_Dispatch_Table_Aggregate (N)); pragma Assert (Is_Record_Type (Typ)); - Parent_Node := Parent (N); - Parent_Kind := Nkind (Parent_Node); + In_Cond_Expr := False; + Node := N; + Parent_Node := Parent (Node); - if Parent_Kind = N_Qualified_Expression then - -- Check if we are in an unconstrained declaration because in this - -- case the current delayed expansion mechanism doesn't work when - -- the declared object size depends on the initializing expr. + -- First, climb the parent chain, looking through qualified expressions + -- and dependent expressions of conditional expressions. - Parent_Node := Parent (Parent_Node); - Parent_Kind := Nkind (Parent_Node); + while True loop + case Nkind (Parent_Node) is + when N_Case_Expression_Alternative => + null; - if Parent_Kind = N_Object_Declaration then - Unc_Decl := - not Is_Entity_Name (Object_Definition (Parent_Node)) - or else (Nkind (N) = N_Aggregate - and then - Has_Discriminants - (Entity (Object_Definition (Parent_Node)))) - or else Is_Class_Wide_Type - (Entity (Object_Definition (Parent_Node))); - end if; - end if; + when N_Case_Expression => + exit when Node = Expression (Parent_Node); + In_Cond_Expr := True; + + when N_If_Expression => + exit when Node = First (Expressions (Parent_Node)); + In_Cond_Expr := True; - -- Just set the Delay flag in the cases where the transformation will be - -- done top down from above. + when N_Qualified_Expression => + null; + + when others => + exit; + end case; + + Node := Parent_Node; + Parent_Node := Parent (Node); + end loop; + + -- Set the Expansion_Delayed flag in the cases where the transformation + -- will be done top down from above. if -- Internal aggregates (transformed when expanding the parent), -- excluding container aggregates as these are transformed into - -- subprogram calls later. + -- subprogram calls later. So far aggregates with self-references + -- are not supported if they appear in a conditional expression. - (Parent_Kind = N_Component_Association - and then not Is_Container_Aggregate (Parent (Parent_Node))) + (Nkind (Parent_Node) = N_Component_Association + and then not Is_Container_Aggregate (Parent (Parent_Node)) + and then not (In_Cond_Expr and then Has_Self_Reference (N))) - or else (Parent_Kind in N_Aggregate | N_Extension_Aggregate - and then not Is_Container_Aggregate (Parent_Node)) + or else (Nkind (Parent_Node) in N_Aggregate | N_Extension_Aggregate + and then not Is_Container_Aggregate (Parent_Node) + and then not (In_Cond_Expr and then Has_Self_Reference (N))) -- Allocator (see Convert_Aggr_In_Allocator) - or else Parent_Kind = N_Allocator + or else Nkind (Parent_Node) = N_Allocator - -- Object declaration (see Convert_Aggr_In_Object_Decl) + -- Object declaration (see Convert_Aggr_In_Object_Decl). So far only + -- declarations with a known size are supported. - or else (Parent_Kind = N_Object_Declaration and then not Unc_Decl) + or else (Nkind (Parent_Node) = N_Object_Declaration + and then Known_Size (Parent_Node, In_Cond_Expr)) -- Safe assignment (see Convert_Aggr_In_Assignment). So far only the -- assignments in init procs are taken into account. - or else (Parent_Kind = N_Assignment_Statement + or else (Nkind (Parent_Node) = N_Assignment_Statement and then Inside_Init_Proc) - - -- (Ada 2005) An inherently limited type in a return statement, which - -- will be handled in a build-in-place fashion, and may be rewritten - -- as an extended return and have its own finalization machinery. - -- In the case of a simple return, the aggregate needs to be delayed - -- until the scope for the return statement has been created, so - -- that any finalization chain will be associated with that scope. - -- For extended returns, we delay expansion to avoid the creation - -- of an unwanted transient scope that could result in premature - -- finalization of the return object (which is built in place - -- within the caller's scope). - - or else Is_Build_In_Place_Aggregate_Return (N) then + Node := N; + + -- Mark the aggregate, as well as all the intermediate conditional + -- expressions, as having expansion delayed. This will block the + -- usual (bottom-up) expansion of the marked nodes and replace it + -- with a top-down expansion from the parent node. + + while Node /= Parent_Node loop + if Nkind (Node) in N_Aggregate + | N_Case_Expression + | N_Extension_Aggregate + | N_If_Expression + then + Set_Expansion_Delayed (Node); + end if; + + Node := Parent (Node); + end loop; + + return; + + -- (Ada 2005) An inherently limited type in a return statement, which + -- will be handled in a build-in-place fashion, and may be rewritten + -- as an extended return and have its own finalization machinery. + -- In the case of a simple return, the aggregate needs to be delayed + -- until the scope for the return statement has been created, so + -- that any finalization chain will be associated with that scope. + -- For extended returns, we delay expansion to avoid the creation + -- of an unwanted transient scope that could result in premature + -- finalization of the return object (which is built in place + -- within the caller's scope). + + elsif Is_Build_In_Place_Aggregate_Return (N) then Set_Expansion_Delayed (N); return; end if; @@ -4304,11 +4372,19 @@ package body Exp_Aggr is Establish_Transient_Scope (N, Manage_Sec_Stack => False); end if; + -- Now get back to the immediate parent, modulo qualified expression + + Parent_Node := Parent (N); + + if Nkind (Parent_Node) = N_Qualified_Expression then + Parent_Node := Parent (Parent_Node); + end if; + -- If the context is an assignment and the aggregate is limited, this -- is a subaggregate of an enclosing aggregate being expanded; it must -- be built in place, so use the target of the current assignment. - if Parent_Kind = N_Assignment_Statement + if Nkind (Parent_Node) = N_Assignment_Statement and then Is_Limited_Type (Typ) then Target_Expr := New_Copy_Tree (Name (Parent_Node)); @@ -4321,7 +4397,7 @@ package body Exp_Aggr is -- by-copy semantics of aggregates. This avoids large stack usage and -- generates more efficient code. - elsif Parent_Kind = N_Assignment_Statement + elsif Nkind (Parent_Node) = N_Assignment_Statement and then In_Place_Assign_OK (N, Get_Base_Object (Name (Parent_Node))) then declare @@ -8678,6 +8754,13 @@ package body Exp_Aggr is Name => New_Copy_Tree (Comp), Expression => Relocate_Node (Init_Expr)); + -- If the initialization expression is a conditional expression whose + -- expansion has been delayed, analyze it again and expand it. + + if Is_Delayed_Conditional_Expression (Expression (Init_Stmt)) then + Set_Analyzed (Expression (Init_Stmt), False); + end if; + Append_To (Blk_Stmts, Init_Stmt); -- Arrange for the component to be adjusted if need be (the call will be @@ -8796,6 +8879,18 @@ package body Exp_Aggr is and then Expansion_Delayed (Unqual_N); end Is_Delayed_Aggregate; + --------------------------------------- + -- Is_Delayed_Conditional_Expression -- + --------------------------------------- + + function Is_Delayed_Conditional_Expression (N : Node_Id) return Boolean is + Unqual_N : constant Node_Id := Unqualify (N); + + begin + return Nkind (Unqual_N) in N_Case_Expression | N_If_Expression + and then Expansion_Delayed (Unqual_N); + end Is_Delayed_Conditional_Expression; + -------------------------------- -- Is_CCG_Supported_Aggregate -- -------------------------------- diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index a9eb0518d7a..17fa38b7ca3 100644 --- a/gcc/ada/exp_aggr.ads +++ b/gcc/ada/exp_aggr.ads @@ -54,6 +54,10 @@ package Exp_Aggr is -- Returns True if N is an aggregate of some kind whose Expansion_Delayed -- flag is set (see sinfo for meaning of flag). + function Is_Delayed_Conditional_Expression (N : Node_Id) return Boolean; + -- Returns True if N is a conditional expression whose Expansion_Delayed + -- flag is set (see sinfo for meaning of flag). + function Static_Array_Aggregate (N : Node_Id) return Boolean; -- N is an array aggregate that may have a component association with -- an others clause and a range. If bounds are static and the expressions diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f6314dff285..8ddae1eb1be 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7689,10 +7689,48 @@ package body Exp_Ch3 is Expander_Mode_Restore; end if; + -- For a special return object, the transformation must wait until + -- after the object is turned into an allocator. + if not Special_Ret_Obj then Convert_Aggr_In_Object_Decl (N); end if; + -- If the initialization expression is a conditional expression whose + -- expansion has been delayed, assign it explicitly to the object but + -- only after analyzing it again and expanding it. + + elsif Is_Delayed_Conditional_Expression (Expr_Q) then + -- For a special return object, the transformation must wait until + -- after the object is turned into an allocator, and will be done + -- during the expansion of the allocator. + + if not Special_Ret_Obj then + declare + Assign : constant Node_Id := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Def_Id, Loc), + Expression => Relocate_Node (Expr)); + + begin + Set_Assignment_OK (Name (Assign)); + Set_Analyzed (Expression (Assign), False); + Set_No_Finalize_Actions (Assign); + Insert_Action_After (Init_After, Assign); + + -- Save the assignment statement when declaring a controlled + -- object. This reference is used later by the finalization + -- machinery to mark the object as successfully initialized + + if Needs_Finalization (Typ) then + Set_Last_Aggregate_Assignment (Def_Id, Assign); + end if; + + Set_Expression (N, Empty); + Set_No_Initialization (N); + end; + end if; + -- Ada 2005 (AI-318-02): If the initialization expression is a call -- to a build-in-place function, then access to the declared object -- must be passed to the function. Currently we limit such functions diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 69a042115c9..6ceffdf8302 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -564,10 +564,16 @@ package body Exp_Ch4 is procedure Build_Aggregate_In_Place (Temp : Entity_Id; Typ : Entity_Id); -- If Exp is an aggregate to build in place, build the declaration of - -- Temp with Typ and with expression an uninitialized allocator for - -- Etype (Exp), then perform an in-place aggregate assignment of Exp + -- Temp with Typ and initializing expression an uninitialized allocator + -- for Etype (Exp), then perform an in-place aggregate assignment of Exp -- into the allocated memory. + procedure Build_Explicit_Assignment (Temp : Entity_Id; Typ : Entity_Id); + -- If Exp is a conditional expression whose expansion has been delayed, + -- build the declaration of Temp with Typ and initializing expression an + -- uninitialized allocator for Etype (Exp), then perform an assignment + -- of Exp into the allocated memory. + ------------------------------ -- Build_Aggregate_In_Place -- ------------------------------ @@ -598,13 +604,58 @@ package body Exp_Ch4 is Convert_Aggr_In_Allocator (N, Temp); end Build_Aggregate_In_Place; + ------------------------------- + -- Build_Explicit_Assignment -- + ------------------------------- + + procedure Build_Explicit_Assignment (Temp : Entity_Id; Typ : Entity_Id) + is + Assign : constant Node_Id := + Make_Assignment_Statement (Loc, + Name => + Make_Explicit_Dereference (Loc, + New_Occurrence_Of (Temp, Loc)), + Expression => Relocate_Node (Exp)); + + Temp_Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Temp, + Object_Definition => New_Occurrence_Of (Typ, Loc), + Expression => + Make_Allocator (Loc, + Expression => New_Occurrence_Of (Etype (Exp), Loc))); + + begin + -- Prevent default initialization of the allocator + + Set_No_Initialization (Expression (Temp_Decl)); + + -- Copy the Comes_From_Source flag onto the allocator since logically + -- this allocator is a replacement of the original allocator. This is + -- for proper handling of restriction No_Implicit_Heap_Allocations. + + Preserve_Comes_From_Source (Expression (Temp_Decl), N); + + -- Insert the declaration + + Insert_Action (N, Temp_Decl); + + -- Arrange for the expression to be analyzed again and expanded + + Set_Assignment_OK (Name (Assign)); + Set_Analyzed (Expression (Assign), False); + Set_No_Finalize_Actions (Assign); + Insert_Action (N, Assign); + end Build_Explicit_Assignment; + -- Local variables - Adj_Call : Node_Id; - Aggr_In_Place : Boolean; - Node : Node_Id; - Temp : Entity_Id; - Temp_Decl : Node_Id; + Adj_Call : Node_Id; + Aggr_In_Place : Boolean; + Delayed_Cond_Expr : Boolean; + Node : Node_Id; + Temp : Entity_Id; + Temp_Decl : Node_Id; TagT : Entity_Id := Empty; -- Type used as source for tag assignment @@ -631,13 +682,16 @@ package body Exp_Ch4 is Apply_Constraint_Check (Exp, T, No_Sliding => True); - Aggr_In_Place := Is_Delayed_Aggregate (Exp); + Aggr_In_Place := Is_Delayed_Aggregate (Exp); + Delayed_Cond_Expr := Is_Delayed_Conditional_Expression (Exp); -- If the expression is an aggregate to be built in place, then we need -- to delay applying predicate checks, because this would result in the - -- creation of a temporary, which is illegal for limited types, + -- creation of a temporary, which is illegal for limited types and just + -- inefficient in the other cases. Likewise for a conditional expression + -- whose expansion has been delayed. - if not Aggr_In_Place then + if not Aggr_In_Place and then not Delayed_Cond_Expr then Apply_Predicate_Check (Exp, T); end if; @@ -741,6 +795,7 @@ package body Exp_Ch4 is -- or this is a return/secondary stack allocation. if not Aggr_In_Place + and then not Delayed_Cond_Expr 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) @@ -793,6 +848,9 @@ package body Exp_Ch4 is if Aggr_In_Place then Build_Aggregate_In_Place (Temp, PtrT); + elsif Delayed_Cond_Expr then + Build_Explicit_Assignment (Temp, PtrT); + else Node := Relocate_Node (N); Set_Analyzed (Node); @@ -845,6 +903,9 @@ package body Exp_Ch4 is if Aggr_In_Place then Build_Aggregate_In_Place (Temp, Def_Id); + elsif Delayed_Cond_Expr then + Build_Explicit_Assignment (Temp, Def_Id); + else Node := Relocate_Node (N); Set_Analyzed (Node); @@ -940,6 +1001,7 @@ package body Exp_Ch4 is and then Needs_Finalization (T) and then not Is_Inherently_Limited_Type (T) and then not Aggr_In_Place + and then not Delayed_Cond_Expr and then Nkind (Exp) /= N_Function_Call and then not Special_Return then @@ -975,7 +1037,7 @@ package body Exp_Ch4 is Rewrite (N, New_Occurrence_Of (Temp, Loc)); Analyze_And_Resolve (N, PtrT); - if Aggr_In_Place then + if Aggr_In_Place or else Delayed_Cond_Expr then Apply_Predicate_Check (N, T, Deref => True); end if; @@ -1003,6 +1065,19 @@ package body Exp_Ch4 is Apply_Predicate_Check (N, T, Deref => True); end if; + -- If the initialization expression is a conditional expression whose + -- expansion has been delayed, assign it explicitly to the allocator, + -- but only after analyzing it again and expanding it. + + elsif Delayed_Cond_Expr then + Temp := Make_Temporary (Loc, 'P', N); + Build_Explicit_Assignment (Temp, PtrT); + Build_Allocate_Deallocate_Proc (Declaration_Node (Temp), Mark => N); + Rewrite (N, New_Occurrence_Of (Temp, Loc)); + Analyze_And_Resolve (N, PtrT); + + Apply_Predicate_Check (N, T, Deref => True); + elsif Is_Access_Type (T) and then Can_Never_Be_Null (T) then Install_Null_Excluding_Check (Exp); @@ -4886,6 +4961,32 @@ package body Exp_Ch4 is ------------------------------ procedure Expand_N_Case_Expression (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Par : constant Node_Id := Parent (N); + Typ : constant Entity_Id := Etype (N); + + In_Predicate : constant Boolean := + Ekind (Current_Scope) in E_Function | E_Procedure + and then Is_Predicate_Function (Current_Scope); + -- Flag set when the case expression appears within a predicate + + Optimize_Return_Stmt : constant Boolean := + Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate; + -- 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. + function Is_Copy_Type (Typ : Entity_Id) return Boolean; -- Return True if we can copy objects of this type when expanding a case -- expression. @@ -4909,10 +5010,6 @@ package body Exp_Ch4 is -- Local variables - Loc : constant Source_Ptr := Sloc (N); - Par : constant Node_Id := Parent (N); - Typ : constant Entity_Id := Etype (N); - Acts : List_Id; Alt : Node_Id; Case_Stmt : Node_Id; @@ -4920,16 +5017,39 @@ package body Exp_Ch4 is Target : Entity_Id := Empty; Target_Typ : Entity_Id; - In_Predicate : Boolean := False; - -- Flag set when the case expression appears within a predicate + Optimize_Assignment_Stmt : Boolean; + -- Small optimization: when the case expression appears in the context + -- of a safe assignment statement, expand into - Optimize_Return_Stmt : Boolean := False; - -- Flag set when the case expression can be optimized in the context of - -- a simple return statement. + -- case X is + -- when A => + -- lhs := AX; + -- when B => + -- lhs := BX; + -- ... + -- end case; + + -- This makes the expansion much more efficient in the context of an + -- aggregate converted into assignments. -- Start of processing for Expand_N_Case_Expression begin + -- If the expansion of the expression has been delayed, we wait for the + -- rewriting of its parent as an assignment statement; when that's done, + -- we optimize the assignment (the very purpose of the manipulation). + + if Expansion_Delayed (N) then + if Nkind (Par) /= N_Assignment_Statement then + return; + end if; + + Optimize_Assignment_Stmt := True; + + else + Optimize_Assignment_Stmt := False; + end if; + -- Check for MINIMIZED/ELIMINATED overflow mode if Minimized_Eliminated_Overflow_Check (N) then @@ -4941,15 +5061,11 @@ package body Exp_Ch4 is -- to which it applies has a static predicate aspect, do not expand, -- because it will be converted to the proper predicate form later. - if Ekind (Current_Scope) in E_Function | E_Procedure - and then Is_Predicate_Function (Current_Scope) + if In_Predicate + and then + Has_Static_Predicate_Aspect (Etype (First_Entity (Current_Scope))) then - In_Predicate := True; - - if Has_Static_Predicate_Aspect (Etype (First_Entity (Current_Scope))) - then - return; - end if; + return; end if; -- When the type of the case expression is elementary, expand @@ -5002,24 +5118,6 @@ 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 @@ -5060,7 +5158,10 @@ package body Exp_Ch4 is -- Generate: -- Target : [Ptr_]Typ; - if not Optimize_Return_Stmt then + if Optimize_Assignment_Stmt then + Remove_Side_Effects (Name (Par), Name_Req => True); + + elsif not Optimize_Return_Stmt then Target := Make_Temporary (Loc, 'T'); Decl := @@ -5077,24 +5178,42 @@ package body Exp_Ch4 is Alt := First (Alternatives (N)); while Present (Alt) loop declare - Alt_Expr : Node_Id := Expression (Alt); + Alt_Expr : Node_Id := Relocate_Node (Expression (Alt)); Alt_Loc : constant Source_Ptr := Sloc (Alt_Expr); LHS : Node_Id; Stmts : List_Id; begin - -- Take the unrestricted access of the expression value for non- - -- scalar types. This approach avoids big copies and covers the - -- limited and unconstrained cases. + -- Generate: + -- lhs := AX; + + if Optimize_Assignment_Stmt then + -- We directly copy the parent node to preserve its flags + + Stmts := New_List (New_Copy (Par)); + Set_Sloc (First (Stmts), Alt_Loc); + Set_Name (First (Stmts), New_Copy_Tree (Name (Par))); + Set_Expression (First (Stmts), Alt_Expr); + + -- If the expression is itself a conditional expression whose + -- expansion has been delayed, analyze it again and expand it. + + if Is_Delayed_Conditional_Expression (Alt_Expr) then + Set_Analyzed (Alt_Expr, False); + end if; -- Generate: - -- return AX['Unrestricted_Access]; + -- return AX; - if Optimize_Return_Stmt then + elsif Optimize_Return_Stmt then Stmts := New_List ( Make_Simple_Return_Statement (Alt_Loc, Expression => Alt_Expr)); + -- Take the unrestricted access of the expression value for non- + -- scalar types. This approach avoids big copies and covers the + -- limited and unconstrained cases. + -- Generate: -- Target := AX['Unrestricted_Access]; @@ -5150,9 +5269,9 @@ package body Exp_Ch4 is Next (Alt); end loop; - -- Rewrite the parent return statement as a case statement + -- Rewrite the parent statement as a case statement - if Optimize_Return_Stmt then + if Optimize_Assignment_Stmt or else Optimize_Return_Stmt then Rewrite (Par, Case_Stmt); Analyze (Par); @@ -5332,6 +5451,26 @@ package body Exp_Ch4 is Par : constant Node_Id := Parent (N); Typ : constant Entity_Id := Etype (N); + In_Predicate : constant Boolean := + Ekind (Current_Scope) in E_Function | E_Procedure + and then Is_Predicate_Function (Current_Scope); + -- Flag set when the if expression appears within a predicate + + Optimize_Return_Stmt : constant Boolean := + Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate; + -- 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. + Force_Expand : constant Boolean := Is_Anonymous_Access_Actual (N); -- Determine if we are dealing with a special case of a conditional -- expression used as an actual for an anonymous access type which @@ -5365,18 +5504,44 @@ package body Exp_Ch4 is -- Local variables Actions : List_Id; - Decl : Node_Id; - Expr : Node_Id; - New_If : Node_Id; - New_N : Node_Id; + Decl : Node_Id; + Expr : Node_Id; + New_Else : Node_Id; + New_If : Node_Id; + New_N : Node_Id; + New_Then : Node_Id; + + Optimize_Assignment_Stmt : Boolean; + -- Small optimization: when the if expression appears in the context of + -- a safe assignment statement, expand into + + -- if cond then + -- lhs := then-expr + -- else + -- lhs := else-expr; + -- end if; - Optimize_Return_Stmt : Boolean := False; - -- Flag set when the if expression can be optimized in the context of - -- a simple return statement. + -- This makes the expansion much more efficient in the context of an + -- aggregate converted into assignments. -- Start of processing for Expand_N_If_Expression begin + -- If the expansion of the expression has been delayed, we wait for the + -- rewriting of its parent as an assignment statement; when that's done, + -- we optimize the assignment (the very purpose of the manipulation). + + if Expansion_Delayed (N) then + if Nkind (Par) /= N_Assignment_Statement then + return; + end if; + + Optimize_Assignment_Stmt := True; + + else + Optimize_Assignment_Stmt := False; + end if; + -- Deal with non-standard booleans Adjust_Condition (Cond); @@ -5457,25 +5622,54 @@ 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 Optimize_Assignment_Stmt then + Remove_Side_Effects (Name (Par), Name_Req => True); - -- if cond then - -- return then-expr - -- else - -- return else-expr; - -- end if; + -- 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. - -- 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. + Process_Transients_In_Expression (N, Then_Actions (N)); + Process_Transients_In_Expression (N, Else_Actions (N)); + + -- We directly copy the parent node to preserve its flags + + New_Then := New_Copy (Par); + Set_Sloc (New_Then, Sloc (Thenx)); + Set_Name (New_Then, New_Copy_Tree (Name (Par))); + Set_Expression (New_Then, Relocate_Node (Thenx)); + + -- If the expression is itself a conditional expression whose + -- expansion has been delayed, analyze it again and expand it. - 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 Is_Delayed_Conditional_Expression (Expression (New_Then)) then + Set_Analyzed (Expression (New_Then), False); + end if; + + New_Else := New_Copy (Par); + Set_Sloc (New_Else, Sloc (Elsex)); + Set_Name (New_Else, New_Copy_Tree (Name (Par))); + Set_Expression (New_Else, Relocate_Node (Elsex)); + + if Is_Delayed_Conditional_Expression (Expression (New_Else)) then + Set_Analyzed (Expression (New_Else), False); + end if; - if Optimize_Return_Stmt then + New_If := + Make_Implicit_If_Statement (N, + Condition => Relocate_Node (Cond), + Then_Statements => New_List (New_Then), + Else_Statements => New_List (New_Else)); + + -- 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); + + elsif 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 @@ -6085,9 +6279,9 @@ package body Exp_Ch4 is Prepend_List (Else_Actions (N), Else_Statements (New_If)); end if; - -- Rewrite the parent return statement as an if statement + -- Rewrite the parent statement as an if statement - if Optimize_Return_Stmt then + if Optimize_Assignment_Stmt or else Optimize_Return_Stmt then Rewrite (Par, New_If); Analyze (Par); @@ -10354,9 +10548,16 @@ package body Exp_Ch4 is Apply_Constraint_Check (Operand, Target_Type, No_Sliding => True); - -- Apply possible predicate check + -- Apply possible predicate check but, for a delayed aggregate, the + -- check is effectively delayed until after the aggregate is expanded + -- into a series of assignments. Likewise for a conditional expression + -- whose expansion has been delayed. - Apply_Predicate_Check (Operand, Target_Type); + if not Is_Delayed_Aggregate (Operand) + and then not Is_Delayed_Conditional_Expression (Operand) + then + Apply_Predicate_Check (Operand, Target_Type); + end if; if Do_Range_Check (Operand) then Generate_Range_Check (Operand, Target_Type, CE_Range_Check_Failed); diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index a7021dc49bb..580723666c5 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -464,6 +464,7 @@ begin -- Gen_IL.Gen.Gen_Nodes (Sy (Expressions, List_Id, Default_No_List), Sy (Is_Elsif, Flag), Sm (Do_Overflow_Check, Flag), + Sm (Expansion_Delayed, Flag), Sm (Else_Actions, List_Id), Sm (Then_Actions, List_Id))); @@ -513,7 +514,8 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Case_Expression, N_Subexpr, (Sy (Expression, Node_Id, Default_Empty), Sy (Alternatives, List_Id, Default_No_List), - Sm (Do_Overflow_Check, Flag))); + Sm (Do_Overflow_Check, Flag), + Sm (Expansion_Delayed, Flag))); Cc (N_Delta_Aggregate, N_Subexpr, (Sy (Expression, Node_Id, Default_Empty), diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 7cad6cf1d29..228082eb823 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1322,6 +1322,8 @@ package Sinfo is -- assignment or initialization. When the full context is known, the -- target of the assignment or initialization is used to generate the -- left-hand side of individual assignment to each subcomponent. + -- Also set on conditional expressions whose dependent expressions are + -- nested aggregates, in order to avoid creating a temporary for them. -- Expression_Copy -- Present in N_Pragma_Argument_Association nodes. Contains a copy of the @@ -4657,6 +4659,7 @@ package Sinfo is -- Else_Actions -- Is_Elsif (set if comes from ELSIF) -- Do_Overflow_Check + -- Expansion_Delayed -- plus fields for expression -- Expressions here is a three-element list, whose first element is the @@ -4695,6 +4698,7 @@ package Sinfo is -- Alternatives (the case expression alternatives) -- Etype -- Do_Overflow_Check + -- Expansion_Delayed ---------------------------------------- -- 4.5.7 Case Expression Alternative --