From patchwork Mon Jul 4 07:50:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 55680 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 BAB17396D804 for ; Mon, 4 Jul 2022 07:55:07 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BAB17396D804 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1656921307; bh=zFrCG+M3O1Em2bFaMm+iBhZIOi2/213NvuB/la2+AYQ=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=vfwiDZCJm3q3jj21pnHjLocTBwqPvnf9JcjLPUx3jMxRm6obwUv/anZw1nW7gd03b jM7bvyeh68oBbOIZm/Il8myHB5E4m+U470BpGdu58xSeLpzgAqL5Bl4owsu0+2BfEw EJLtPUIQ8yVRxnEwdx0XK/V1qV4squuLfFt18vZs= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-ed1-x535.google.com (mail-ed1-x535.google.com [IPv6:2a00:1450:4864:20::535]) by sourceware.org (Postfix) with ESMTPS id DBFF6385116C for ; Mon, 4 Jul 2022 07:50:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org DBFF6385116C Received: by mail-ed1-x535.google.com with SMTP id fd6so10608826edb.5 for ; Mon, 04 Jul 2022 00:50:27 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=zFrCG+M3O1Em2bFaMm+iBhZIOi2/213NvuB/la2+AYQ=; b=RJFrkt5iDcelxyC4bxcEolc5WkD4m93/diXGaJg87Riy4koQgNfG97peIYoE1iMzZh KwQiZAccDJ6tz+uaQTw8YnE/8zGcuNGruXr44PSD9/d8mP2rDK4kEtMRuguE3KmsEmJU 1uTOtn3Ua2TJSGERqdVBYWRJCQWaxH54nuLRimyGBZOzRO5X97N6+3kva1yUFxiqb/kz 0fRClYqw7WmWoCTIs0V4M5oB7pgWmW+M3kJzK3/shaOALPMdWSmujBzbr/8beQaJVlGr BN93es674X9bD5xIE0Zs1MmpyLCX+oFB6nKnCbN3e0/ly0H+EeXa/dYF9l7/2if3wv5H 2FLg== X-Gm-Message-State: AJIora/XR36kkke4PPtNqsQ52Zb0+zz0qZdrzT0HkxcJMRu06ZhB9Fhd IfyHB8pjsj0zKPwjLuixSBd4X2CR9eDP5w== X-Google-Smtp-Source: AGRyM1v9Az5dbzNOgwXGG98SeYuXX1/DOg6IlwiqE7Siu35U8zFyYK6UJNjVhMUo9THF4nFRkFrcoA== X-Received: by 2002:a05:6402:354d:b0:435:93f9:fc0b with SMTP id f13-20020a056402354d00b0043593f9fc0bmr36245038edd.288.1656921027500; Mon, 04 Jul 2022 00:50:27 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id b9-20020aa7dc09000000b00437938c731fsm14188427edu.97.2022.07.04.00.50.26 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 04 Jul 2022 00:50:27 -0700 (PDT) Date: Mon, 4 Jul 2022 07:50:26 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Small housekeeping work in Expand_N_Object_Declaration Message-ID: <20220704075026.GA99349@adacore.com> MIME-Version: 1.0 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, KAM_ASCII_DIVIDERS, 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 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: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Eric Botcazou Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" The local function Rewrite_As_Renaming can be called twice in certain circumstances, which is both not quite safe and unnecessary, so this replaces it with a local variable whose value is computed only once. No functional changes. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_ch3.adb (Expand_N_Object_Declaration) : New local function. : Change to a local variable whose value is computed once and generate a call to Finalize after this is done. Simplify the code creating the renaming at the end. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6173,7 +6173,7 @@ package body Exp_Ch3 is Obj_Def : constant Node_Id := Object_Definition (N); Typ : constant Entity_Id := Etype (Def_Id); Base_Typ : constant Entity_Id := Base_Type (Typ); - Expr_Q : Node_Id; + Next_N : constant Node_Id := Next (N); function Build_Equivalent_Aggregate return Boolean; -- If the object has a constrained discriminated type and no initial @@ -6193,9 +6193,8 @@ package body Exp_Ch3 is -- Generate all default initialization actions for object Def_Id. Any -- new code is inserted after node After. - function Rewrite_As_Renaming return Boolean; - -- Indicate whether to rewrite a declaration with initialization into an - -- object renaming declaration (see below). + function OK_To_Rename_Ref (N : Node_Id) return Boolean; + -- Return True if N denotes an entity with OK_To_Rename set -------------------------------- -- Build_Equivalent_Aggregate -- @@ -6801,91 +6800,21 @@ package body Exp_Ch3 is end if; end Default_Initialize_Object; - ------------------------- - -- Rewrite_As_Renaming -- - ------------------------- - - function Rewrite_As_Renaming return Boolean is - - function OK_To_Rename_Entity_Name (N : Node_Id) return Boolean; - -- Return True if N denotes an entity with OK_To_Rename set - - ------------------------------ - -- OK_To_Rename_Entity_Name -- - ------------------------------ - - function OK_To_Rename_Entity_Name (N : Node_Id) return Boolean is - begin - return Is_Entity_Name (N) - and then Ekind (Entity (N)) = E_Variable - and then OK_To_Rename (Entity (N)); - end OK_To_Rename_Entity_Name; - - Result : constant Boolean := - - -- If the object declaration appears in the form - - -- Obj : Typ := Func (...); - - -- where Typ both needs finalization and is returned on the secondary - -- stack, the object declaration can be rewritten into a dereference - -- of the reference to the result built on the secondary stack (see - -- Expand_Ctrl_Function_Call for this expansion of the call): - - -- type Axx is access all Typ; - -- Rxx : constant Axx := Func (...)'reference; - -- Obj : Typ renames Rxx.all; - - -- This avoids an extra copy and the pair of Adjust/Finalize calls. - - (not Is_Library_Level_Entity (Def_Id) - and then Nkind (Expr_Q) = N_Explicit_Dereference - and then not Comes_From_Source (Expr_Q) - and then Nkind (Original_Node (Expr_Q)) = N_Function_Call - and then Needs_Finalization (Typ) - and then not Is_Class_Wide_Type (Typ)) - - -- If the initializing expression is for a variable with attribute - -- OK_To_Rename set, then transform: - - -- Obj : Typ := Expr; - - -- into - - -- Obj : Typ renames Expr; - - -- provided that Obj is not aliased. The aliased case has to be - -- excluded in general because Expr will not be aliased in general. + ---------------------- + -- OK_To_Rename_Ref -- + ---------------------- - or else - (not Aliased_Present (N) - and then (OK_To_Rename_Entity_Name (Expr_Q) - or else - (Nkind (Expr_Q) = N_Slice - and then - OK_To_Rename_Entity_Name (Prefix (Expr_Q))))); + function OK_To_Rename_Ref (N : Node_Id) return Boolean is begin - return Result - - -- The declaration cannot be rewritten if it has got constraints, - -- in other words the nominal subtype must be unconstrained. - - and then Is_Entity_Name (Original_Node (Obj_Def)) - - -- ??? Return False if there are any aspect specifications, because - -- otherwise we duplicate that corresponding implicit attribute - -- definition, and call Insert_Action, which has no place to insert - -- the attribute definition. The attribute definition is stored in - -- Aspect_Rep_Item, which is not a list. - - and then No (Aspect_Specifications (N)); - end Rewrite_As_Renaming; + return Is_Entity_Name (N) + and then Ekind (Entity (N)) = E_Variable + and then OK_To_Rename (Entity (N)); + end OK_To_Rename_Ref; -- Local variables - Next_N : constant Node_Id := Next (N); - Adj_Call : Node_Id; + Expr_Q : Node_Id; Id_Ref : Node_Id; Tag_Assign : Node_Id; @@ -6895,6 +6824,9 @@ package body Exp_Ch3 is -- which case the init proc call must be inserted only after the bodies -- of the shared variable procedures have been seen. + Rewrite_As_Renaming : Boolean := False; + -- Whether to turn the declaration into a renaming at the end + -- Start of processing for Expand_N_Object_Declaration begin @@ -7442,33 +7374,6 @@ package body Exp_Ch3 is end if; end if; - -- If the type needs finalization and is not inherently limited, - -- then the target is adjusted after the copy and attached to the - -- finalization list. However, no adjustment is needed in the case - -- where the object has been initialized by a call to a function - -- returning on the primary stack (see Expand_Ctrl_Function_Call) - -- since no copy occurred, given that the type is by-reference. - -- Similarly, no adjustment is needed if we are going to rewrite - -- the object declaration into a renaming declaration. - - if Needs_Finalization (Typ) - and then not Is_Limited_View (Typ) - and then Nkind (Expr_Q) /= N_Function_Call - and then not Rewrite_As_Renaming - then - Adj_Call := - Make_Adjust_Call ( - Obj_Ref => New_Occurrence_Of (Def_Id, Loc), - Typ => Base_Typ); - - -- Guard against a missing [Deep_]Adjust when the base type - -- was not properly frozen. - - if Present (Adj_Call) then - Insert_Action_After (Init_After, Adj_Call); - end if; - end if; - -- For tagged types, when an init value is given, the tag has to -- be re-initialized separately in order to avoid the propagation -- of a wrong tag coming from a view conversion unless the type @@ -7587,6 +7492,91 @@ package body Exp_Ch3 is Set_Is_Known_Valid (Def_Id); end if; end if; + + -- Now determine whether we will use a renaming + + Rewrite_As_Renaming := + + -- If the object declaration appears in the form + + -- Obj : Typ := Func (...); + + -- where Typ needs finalization and is returned on the secondary + -- stack, the declaration can be rewritten into a dereference of + -- the reference to the result built on the secondary stack (see + -- Expand_Ctrl_Function_Call for this expansion of the call): + + -- type Axx is access all Typ; + -- Rxx : constant Axx := Func (...)'reference; + -- Obj : Typ renames Rxx.all; + + -- This avoids an extra copy and a pair of Adjust/Finalize calls + + ((not Is_Library_Level_Entity (Def_Id) + and then Nkind (Expr_Q) = N_Explicit_Dereference + and then not Comes_From_Source (Expr_Q) + and then Nkind (Original_Node (Expr_Q)) = N_Function_Call + and then Needs_Finalization (Typ) + and then not Is_Class_Wide_Type (Typ)) + + -- If the initializing expression is for a variable with flag + -- OK_To_Rename set, then transform: + + -- Obj : Typ := Expr; + + -- into + + -- Obj : Typ renames Expr; + + -- provided that Obj is not aliased. The aliased case has to + -- be excluded because Expr will not be aliased in general. + + or else (not Aliased_Present (N) + and then (OK_To_Rename_Ref (Expr_Q) + or else + (Nkind (Expr_Q) = N_Slice + and then + OK_To_Rename_Ref (Prefix (Expr_Q)))))) + + -- The declaration cannot be rewritten if it has got constraints + -- in other words the nominal subtype must be unconstrained. + + and then Is_Entity_Name (Original_Node (Obj_Def)) + + -- ??? Likewise if there are any aspect specifications, because + -- otherwise we duplicate that corresponding implicit attribute + -- definition and call Insert_Action, which has no place for the + -- attribute definition. The attribute definition is stored in + -- Aspect_Rep_Item, which is not a list. + + and then No (Aspect_Specifications (N)); + + -- If the type needs finalization and is not inherently limited, + -- then the target is adjusted after the copy and attached to the + -- finalization list. However, no adjustment is needed in the case + -- where the object has been initialized by a call to a function + -- returning on the primary stack (see Expand_Ctrl_Function_Call) + -- since no copy occurred, given that the type is by-reference. + -- Similarly, no adjustment is needed if we are going to rewrite + -- the object declaration into a renaming declaration. + + if Needs_Finalization (Typ) + and then not Is_Limited_View (Typ) + and then Nkind (Expr_Q) /= N_Function_Call + and then not Rewrite_As_Renaming + then + Adj_Call := + Make_Adjust_Call ( + Obj_Ref => New_Occurrence_Of (Def_Id, Loc), + Typ => Base_Typ); + + -- Guard against a missing [Deep_]Adjust when the base type + -- was not properly frozen. + + if Present (Adj_Call) then + Insert_Action_After (Init_After, Adj_Call); + end if; + end if; end if; -- Cases where the back end cannot handle the initialization @@ -7714,40 +7704,32 @@ package body Exp_Ch3 is -- declaration, then this transformation generates what would be -- illegal code if written by hand, but that's OK. - if Present (Expr) then - if Rewrite_As_Renaming then - Rewrite (N, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Defining_Identifier (N), - Subtype_Mark => Obj_Def, - Name => Expr_Q)); + if Rewrite_As_Renaming then + Rewrite (N, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Defining_Identifier (N), + Subtype_Mark => Obj_Def, + Name => Expr_Q)); - -- We do not analyze this renaming declaration, because all its - -- components have already been analyzed, and if we were to go - -- ahead and analyze it, we would in effect be trying to generate - -- another declaration of X, which won't do. + -- We do not analyze this renaming declaration, because all its + -- components have already been analyzed, and if we were to go + -- ahead and analyze it, we would in effect be trying to generate + -- another declaration of X, which won't do. - Set_Renamed_Object (Defining_Identifier (N), Expr_Q); - Set_Analyzed (N); + Set_Renamed_Object (Defining_Identifier (N), Expr_Q); + Set_Analyzed (N); - -- We do need to deal with debug issues for this renaming + -- We do need to deal with debug issues for this renaming - -- First, if entity comes from source, then mark it as needing - -- debug information, even though it is defined by a generated - -- renaming that does not come from source. + -- First, if entity comes from source, then mark it as needing + -- debug information, even though it is defined by a generated + -- renaming that does not come from source. - Set_Debug_Info_Defining_Id (N); + Set_Debug_Info_Defining_Id (N); - -- Now call the routine to generate debug info for the renaming + -- Now call the routine to generate debug info for the renaming - declare - Decl : constant Node_Id := Debug_Renaming_Declaration (N); - begin - if Present (Decl) then - Insert_Action (N, Decl); - end if; - end; - end if; + Insert_Action (N, Debug_Renaming_Declaration (N)); end if; -- Exception on library entity not available