From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x433.google.com (mail-wr1-x433.google.com [IPv6:2a00:1450:4864:20::433]) by sourceware.org (Postfix) with ESMTPS id C27833858C39 for ; Mon, 20 May 2024 07:49:20 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org C27833858C39 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 C27833858C39 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::433 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1716191364; cv=none; b=JOQs+07QrXGWg5un5ILwDJNrotS8VZIf9ZwZCLN4ECLewX4Cv8UwCXmLPtwfZnYIEf5FsL/UjuchpxnSTM88P4FsYmwD1vgqrmFaYSHT/su04e2TbpYWxnIVS7Cq7NVURr7R/B9p5FhavUDgUTIxHASTLlrgphNrewV1IM0ufwA= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1716191364; c=relaxed/simple; bh=9mroLkVpk4JdvJKbs8THGiVxxp2667g1AqDkYysTlJU=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=tAwKfK4BSzD8JcZJUtvIEMvHhk1v0q+BorPu3T9papF8/LH1I8SdoBT7Td0LKCUz5FEV6FGbmDZ0F5anEupsMF88CXENr6pwXrHRHD8xzPW9Y21n/ZMaxgjrqw6AmmrcN0gG6Fet4Rql39qL2/2Ec3LRlBY/5VIDqMebtY/kMGU= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x433.google.com with SMTP id ffacd0b85a97d-34db6a29a1eso1814381f8f.1 for ; Mon, 20 May 2024 00:49:20 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1716191359; x=1716796159; 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=uQyJNpck8bDquZCm96m4SCltHBX4GRDfbcl202FGW38=; b=iL3T4ai37eoOCRI+YiVu+0a9gv/JA1uJvHgYYfyP9WFMKncgvWpVdQdL11E72XrmDc RQazTalzHK6tzqC+SatByFv762c87OzPCxQ28viVYt4XzCqkhazcSk+UEfQcB5Y5e9c+ jQyplT1uL1qgj2cggHJHQlxoK7Mtl7Swb+mQG4vz9achqfOguH3p+fAQPWsAZfBIWqfn u9D+QveMo8WO8VAjH2WgJ+LYuSWdyPsbky/Rt0LBPi9y0fJ7rTl+/cqGEPfmFki+Zi09 IcJYh/w+KY7AHGz/zxb8VD+naowumh8UycbyRbAokYltbOihjzQfTsVh7Cfk+nb8EaX1 CKCw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1716191359; x=1716796159; 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=uQyJNpck8bDquZCm96m4SCltHBX4GRDfbcl202FGW38=; b=vr99EHkT2XylhFVS/1j1oqml2LdBAGOvWoHch/o1wuN4k4+AOxut2YpYWSN7Li1oaU +XLTa0Q6Kx6X07rd+kfz0A84KUdTHAwWKcK7BULt49wokyGRKRNZTvajN7trLVo89PEH DKAO/VYIaR5d6U2dPcEeeHQFwEOupUoIlNyGl6/TN1AfULo1Zb6IQ3RB4RgcxRVfT5k+ AV+oqbpQ6HyrLreRxe1DBH7eoe8S/to60NWRWzNZrvYerzN1ybe+eGX5pQ5rpof73XNn 4kmU7DawYOA6AiA0WghIVRcUiasDCamr/NmW5PqSZm876z1USE4fzCa5nGJlpeygeUA6 lZFg== X-Gm-Message-State: AOJu0YzaTJNhwRsPNx8cJkBF5k0rxbD/GZc1JY5fkTAFLBLJjBmZJHlr bJtRNy/oZTC4Hz7I4oHWpqxT9qQP2CL1Wz1ssoR0OjHOXxmXU9dJ0WKuGABmxZXoAwJCLrrBsTM = X-Google-Smtp-Source: AGHT+IF9GBjDFYTUWrrsYY0AMeDUiJa1NCb31dknoytMUNVmgT5KxPnaVwDMALos5fPAx6gkyZ32LQ== X-Received: by 2002:a5d:550b:0:b0:34c:67d6:8dec with SMTP id ffacd0b85a97d-3504a62fec5mr22206037f8f.6.1716191359352; Mon, 20 May 2024 00:49:19 -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.18 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 20 May 2024 00:49:18 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 10/30] ada: Another small cleanup about allocators and aggregates Date: Mon, 20 May 2024 09:48:36 +0200 Message-ID: <20240520074858.222435-10-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 Content-Transfer-Encoding: 8bit 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 List-Id: From: Eric Botcazou This eliminates a few more oddities present in the expander for allocators and aggregates nested in allocators and other constructs: - Convert_Aggr_In_Allocator takes both the N_Allocator and the aggregate as parameters, while the sibling procedures Convert_Aggr_In_Assignment and Convert_Aggr_In_Object_Decl only take the former. This changes the first to be consistent with the two others and propagates the change to Convert_Array_Aggr_In_Allocator. - Convert_Aggr_In_Object_Decl contains an awkward code structure with a useless inner block statement. - In_Place_Assign_OK and Convert_To_Assignments have some declarations of local variables not in the right place. No functional changes (presumably). gcc/ada/ * exp_aggr.ads (Convert_Aggr_In_Allocator): Remove Aggr parameter and adjust description. (Convert_Aggr_In_Object_Decl): Adjust description. * exp_aggr.adb (Convert_Aggr_In_Allocator): Remove Aggr parameter and add local variable of the same name instead. Adjust call to Convert_Array_Aggr_In_Allocator. (Convert_Aggr_In_Object_Decl): Add comment for early return and remove useless inner block statement. (Convert_Array_Aggr_In_Allocator): Remove Aggr parameter and add local variable of the same name instead. (In_Place_Assign_OK): Move down declarations of local variables. (Convert_To_Assignments): Put all declarations of local variables in the same place. Fix typo in comment. Replace T with Full_Typ. * exp_ch4.adb (Expand_Allocator_Expression): Call Unqualify instead of Expression on the qualified expression of the allocator for the sake of consistency. Adjust call to Convert_Aggr_In_Allocator. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 188 +++++++++++++++++++++---------------------- gcc/ada/exp_aggr.ads | 18 ++--- gcc/ada/exp_ch4.adb | 4 +- 3 files changed, 104 insertions(+), 106 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 2476675604c..8a3d1685cb3 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -282,10 +282,7 @@ package body Exp_Aggr is -- Indexes is the current list of expressions used to index the object we -- are writing into. - procedure Convert_Array_Aggr_In_Allocator - (N : Node_Id; - Aggr : Node_Id; - Target : Node_Id); + procedure Convert_Array_Aggr_In_Allocator (N : Node_Id; Target : Node_Id); -- If the aggregate appears within an allocator and can be expanded in -- place, this routine generates the individual assignments to components -- of the designated object. This is an optimization over the general @@ -3543,11 +3540,8 @@ package body Exp_Aggr is -- Convert_Aggr_In_Allocator -- ------------------------------- - procedure Convert_Aggr_In_Allocator - (N : Node_Id; - Aggr : Node_Id; - Temp : Entity_Id) - is + procedure Convert_Aggr_In_Allocator (N : Node_Id; Temp : Entity_Id) is + Aggr : constant Node_Id := Unqualify (Expression (N)); Loc : constant Source_Ptr := Sloc (Aggr); Typ : constant Entity_Id := Etype (Aggr); @@ -3557,7 +3551,7 @@ package body Exp_Aggr is begin if Is_Array_Type (Typ) then - Convert_Array_Aggr_In_Allocator (N, Aggr, Occ); + Convert_Array_Aggr_In_Allocator (N, Occ); elsif Has_Default_Init_Comps (Aggr) then declare @@ -3605,12 +3599,9 @@ package body Exp_Aggr is Aggr : constant Node_Id := Unqualify (Expression (N)); Loc : constant Source_Ptr := Sloc (Aggr); Typ : constant Entity_Id := Etype (Aggr); - Occ : constant Node_Id := New_Occurrence_Of (Obj, Loc); - - Has_Transient_Scope : Boolean := False; function Discriminants_Ok return Boolean; - -- If the object type is constrained, the discriminants in the + -- If the object's subtype is constrained, the discriminants in the -- aggregate must be checked against the discriminants of the subtype. -- This cannot be done using Apply_Discriminant_Checks because after -- expansion there is no aggregate left to check. @@ -3677,10 +3668,19 @@ package body Exp_Aggr is return True; end Discriminants_Ok; + -- Local variables + + Has_Transient_Scope : Boolean; + Occ : Node_Id; + Param : Node_Id; + Stmt : Node_Id; + Stmts : List_Id; + -- Start of processing for Convert_Aggr_In_Object_Decl begin - Set_Assignment_OK (Occ); + -- First generate discriminant checks if need be, and bail out if one + -- of them fails statically. if Has_Discriminants (Typ) and then Typ /= Etype (Obj) @@ -3706,61 +3706,59 @@ package body Exp_Aggr is then Establish_Transient_Scope (Aggr, Manage_Sec_Stack => False); Has_Transient_Scope := True; + else + Has_Transient_Scope := False; end if; - declare - Stmts : constant List_Id := Late_Expansion (Aggr, Typ, Occ); - Stmt : Node_Id; - Param : Node_Id; + Occ := New_Occurrence_Of (Obj, Loc); + Set_Assignment_OK (Occ); + Stmts := Late_Expansion (Aggr, Typ, Occ); - begin - -- If Obj is already frozen or if N is wrapped in a transient scope, - -- Stmts do not need to be saved in Initialization_Statements since - -- there is no freezing issue. + -- If Obj is already frozen or if N is wrapped in a transient scope, + -- Stmts do not need to be saved in Initialization_Statements since + -- there is no freezing issue. - if Is_Frozen (Obj) or else Has_Transient_Scope then - Insert_Actions_After (N, Stmts); - else - Stmt := Make_Compound_Statement (Sloc (N), Actions => Stmts); - Insert_Action_After (N, Stmt); + if Is_Frozen (Obj) or else Has_Transient_Scope then + Insert_Actions_After (N, Stmts); - -- Insert_Action_After may freeze Obj in which case we should - -- remove the compound statement just created and simply insert - -- Stmts after N. + else + Stmt := Make_Compound_Statement (Sloc (N), Actions => Stmts); + Insert_Action_After (N, Stmt); - if Is_Frozen (Obj) then - Remove (Stmt); - Insert_Actions_After (N, Stmts); - else - Set_Initialization_Statements (Obj, Stmt); - end if; - end if; + -- Insert_Action_After may freeze Obj in which case we should + -- remove the compound statement just created and simply insert + -- Stmts after N. - -- If Typ has controlled components and a call to a Slice_Assign - -- procedure is part of the initialization statements, then we - -- need to initialize the array component since Slice_Assign will - -- need to adjust it. + if Is_Frozen (Obj) then + Remove (Stmt); + Insert_Actions_After (N, Stmts); - if Has_Controlled_Component (Typ) then - Stmt := First (Stmts); + else + Set_Initialization_Statements (Obj, Stmt); + end if; + end if; - while Present (Stmt) loop - if Nkind (Stmt) = N_Procedure_Call_Statement - and then Is_TSS (Entity (Name (Stmt)), TSS_Slice_Assign) - then - Param := First (Parameter_Associations (Stmt)); - Insert_Actions - (Stmt, - Build_Initialization_Call (N, - New_Copy_Tree (Param), Etype (Param))); - end if; + -- If Typ has controlled components and a call to a Slice_Assign + -- procedure is part of the initialization statements, then we + -- need to initialize the array component since Slice_Assign will + -- need to adjust it. - Next (Stmt); - end loop; - end if; - end; + if Has_Controlled_Component (Typ) then + Stmt := First (Stmts); - Set_No_Initialization (N); + while Present (Stmt) loop + if Nkind (Stmt) = N_Procedure_Call_Statement + and then Is_TSS (Entity (Name (Stmt)), TSS_Slice_Assign) + then + Param := First (Parameter_Associations (Stmt)); + Insert_Actions (Stmt, + Build_Initialization_Call (N, + New_Copy_Tree (Param), Etype (Param))); + end if; + + Next (Stmt); + end loop; + end if; -- After expansion the expression can be removed from the declaration -- except if the object is class-wide, in which case the aggregate @@ -3770,6 +3768,8 @@ package body Exp_Aggr is Set_Expression (N, Empty); end if; + Set_No_Initialization (N); + Initialize_Discriminants (N, Typ); end Convert_Aggr_In_Object_Decl; @@ -3777,13 +3777,11 @@ package body Exp_Aggr is -- Convert_Array_Aggr_In_Allocator -- ------------------------------------- - procedure Convert_Array_Aggr_In_Allocator - (N : Node_Id; - Aggr : Node_Id; - Target : Node_Id) - is - Typ : constant Entity_Id := Etype (Aggr); - Ctyp : constant Entity_Id := Component_Type (Typ); + procedure Convert_Array_Aggr_In_Allocator (N : Node_Id; Target : Node_Id) is + Aggr : constant Node_Id := Unqualify (Expression (N)); + Typ : constant Entity_Id := Etype (Aggr); + Ctyp : constant Entity_Id := Component_Type (Typ); + Aggr_Code : List_Id; New_Aggr : Node_Id; @@ -3846,13 +3844,6 @@ package body Exp_Aggr is is Is_Array : constant Boolean := Is_Array_Type (Etype (N)); - Aggr_In : Node_Id; - Aggr_Bounds : Range_Nodes; - Obj_In : Node_Id; - Obj_Bounds : Range_Nodes; - Parent_Kind : Node_Kind; - Parent_Node : Node_Id; - function Safe_Aggregate (Aggr : Node_Id) return Boolean; -- Check recursively that each component of a (sub)aggregate does not -- depend on the variable being assigned to. @@ -4106,6 +4097,15 @@ package body Exp_Aggr is end if; end Safe_Component; + -- Local variables + + Aggr_In : Node_Id; + Aggr_Bounds : Range_Nodes; + Obj_In : Node_Id; + Obj_Bounds : Range_Nodes; + Parent_Kind : Node_Kind; + Parent_Node : Node_Id; + -- Start of processing for In_Place_Assign_OK begin @@ -4214,16 +4214,16 @@ package body Exp_Aggr is ---------------------------- procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is - Loc : constant Source_Ptr := Sloc (N); - T : Entity_Id; - Temp : Entity_Id; + Loc : constant Source_Ptr := Sloc (N); Aggr_Code : List_Id; + Full_Typ : Entity_Id; Instr : Node_Id; - Target_Expr : Node_Id; Parent_Kind : Node_Kind; - Unc_Decl : Boolean := False; Parent_Node : Node_Id; + Target_Expr : Node_Id; + Temp : Entity_Id; + Unc_Decl : Boolean := False; begin pragma Assert (Nkind (N) in N_Aggregate | N_Extension_Aggregate); @@ -4275,7 +4275,7 @@ package body Exp_Aggr is or else (Parent_Kind = N_Object_Declaration and then not Unc_Decl) - -- Safe assignment (see Convert_Aggr_Assignments). So far only the + -- 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 @@ -4304,14 +4304,12 @@ package body Exp_Aggr is Establish_Transient_Scope (N, Manage_Sec_Stack => False); end if; - -- If the aggregate is nonlimited, create a temporary, since aggregates - -- have "by copy" semantics. If it is limited and context is an - -- assignment, this is a subaggregate for an enclosing aggregate being - -- expanded. It must be built in place, so use target of the current - -- assignment. + -- 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 Is_Limited_Type (Typ) - and then Parent_Kind = N_Assignment_Statement + if Parent_Kind = N_Assignment_Statement + and then Is_Limited_Type (Typ) then Target_Expr := New_Copy_Tree (Name (Parent_Node)); Insert_Actions (Parent_Node, @@ -4320,7 +4318,7 @@ package body Exp_Aggr is -- Do not declare a temporary to initialize an aggregate assigned to -- a target when in-place assignment is possible, i.e. preserving the - -- by-copy semantic of aggregates. This avoids large stack usage and + -- by-copy semantics of aggregates. This avoids large stack usage and -- generates more efficient code. elsif Parent_Kind = N_Assignment_Statement @@ -4345,6 +4343,8 @@ package body Exp_Aggr is end if; end; + -- Otherwise, create a temporary since aggregates have by-copy semantics + else Temp := Make_Temporary (Loc, 'A', N); @@ -4354,35 +4354,35 @@ package body Exp_Aggr is if Has_Unknown_Discriminants (Typ) and then Present (Underlying_Record_View (Typ)) then - T := Underlying_Record_View (Typ); + Full_Typ := Underlying_Record_View (Typ); else - T := Typ; + Full_Typ := Typ; end if; Instr := Make_Object_Declaration (Loc, Defining_Identifier => Temp, - Object_Definition => New_Occurrence_Of (T, Loc)); + Object_Definition => New_Occurrence_Of (Full_Typ, Loc)); Set_No_Initialization (Instr); Insert_Action (N, Instr); - Initialize_Discriminants (Instr, T); + Initialize_Discriminants (Instr, Full_Typ); Target_Expr := New_Occurrence_Of (Temp, Loc); - Aggr_Code := Build_Record_Aggr_Code (N, T, Target_Expr); + Aggr_Code := Build_Record_Aggr_Code (N, Full_Typ, Target_Expr); -- Save the last assignment statement associated with the aggregate -- when building a controlled object. This reference is utilized by -- the finalization machinery when marking an object as successfully -- initialized. - if Needs_Finalization (T) then + if Needs_Finalization (Full_Typ) then Set_Last_Aggregate_Assignment (Temp, Last (Aggr_Code)); end if; Insert_Actions (N, Aggr_Code); Rewrite (N, New_Occurrence_Of (Temp, Loc)); - Analyze_And_Resolve (N, T); + Analyze_And_Resolve (N, Full_Typ); end if; end Convert_To_Assignments; diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index 30765efe944..a9eb0518d7a 100644 --- a/gcc/ada/exp_aggr.ads +++ b/gcc/ada/exp_aggr.ads @@ -31,14 +31,12 @@ package Exp_Aggr is procedure Expand_N_Delta_Aggregate (N : Node_Id); procedure Expand_N_Extension_Aggregate (N : Node_Id); - procedure Convert_Aggr_In_Allocator - (N : Node_Id; - Aggr : Node_Id; - Temp : Entity_Id); - -- N is an N_Allocator whose (ultimate) expression is the aggregate Aggr. + procedure Convert_Aggr_In_Allocator (N : Node_Id; Temp : Entity_Id); + -- N is an N_Allocator whose (ultimate) expression must be an N_Aggregate + -- or N_Extension_Aggregate with Expansion_Delayed. -- This procedure performs an in-place aggregate assignment into an object - -- allocated with the subtype of Aggr and designated by Temp, so that N - -- can be rewritten as a mere occurrence of Temp. + -- allocated with the subtype of the aggregate and designated by Temp, so + -- that N can be rewritten as a mere occurrence of Temp. procedure Convert_Aggr_In_Assignment (N : Node_Id); -- If the right-hand side of an assignment is an aggregate, expand the @@ -48,9 +46,9 @@ package Exp_Aggr is -- backend. procedure Convert_Aggr_In_Object_Decl (N : Node_Id); - -- N is an N_Object_Declaration with an expression which must be an - -- N_Aggregate or N_Extension_Aggregate with Expansion_Delayed. - -- This procedure performs in-place aggregate assignment. + -- N is an N_Object_Declaration whose expression must be an N_Aggregate or + -- N_Extension_Aggregate with Expansion_Delayed. + -- This procedure performs an in-place aggregate assignment. function Is_Delayed_Aggregate (N : Node_Id) return Boolean; -- Returns True if N is an aggregate of some kind whose Expansion_Delayed diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 29249eb4c18..69a042115c9 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -555,7 +555,7 @@ package body Exp_Ch4 is procedure Expand_Allocator_Expression (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Exp : constant Node_Id := Expression (Expression (N)); + Exp : constant Node_Id := Unqualify (Expression (N)); Indic : constant Node_Id := Subtype_Mark (Expression (N)); T : constant Entity_Id := Entity (Indic); PtrT : constant Entity_Id := Etype (N); @@ -595,7 +595,7 @@ package body Exp_Ch4 is -- Insert the declaration and generate the in-place assignment Insert_Action (N, Temp_Decl); - Convert_Aggr_In_Allocator (N, Exp, Temp); + Convert_Aggr_In_Allocator (N, Temp); end Build_Aggregate_In_Place; -- Local variables -- 2.43.2