From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTP id EFB9839888A3 for ; Wed, 5 May 2021 08:20:07 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org EFB9839888A3 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 60743561E8; Wed, 5 May 2021 04:20:05 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id klMFJO6BmIFh; Wed, 5 May 2021 04:20:05 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 3F59311733E; Wed, 5 May 2021 04:20:05 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 3EA13103; Wed, 5 May 2021 04:20:05 -0400 (EDT) Date: Wed, 5 May 2021 04:20:05 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Small cleanup in the Expand_Image_Attribute procedure Message-ID: <20210505082005.GA31287@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="2fHTh5uZTiUOsy+g" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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-List-Received-Date: Wed, 05 May 2021 08:20:14 -0000 --2fHTh5uZTiUOsy+g Content-Type: text/plain; charset=us-ascii Content-Disposition: inline This moves the inline expansion for user-defined enumeration types back into the normal flow of control, moves the declarations of local objects to where they are needed and removes an explicit check for private types in the enumeration case, which is now superfluous. No functional changes. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_imgv.adb (Is_User_Defined_Enumeration_Type): Delete. (Expand_Image_Attribute): Move inline expansion into normal flow of control, move down declarations and remove superfluous processing. --2fHTh5uZTiUOsy+g Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -761,10 +761,6 @@ package body Exp_Imgv is -- Expand attribute 'Image in user-defined enumeration types, avoiding -- string copy. - function Is_User_Defined_Enumeration_Type - (Typ : Entity_Id) return Boolean; - -- Return True if Typ is a user-defined enumeration type - ----------------------------------- -- Expand_Standard_Boolean_Image -- ----------------------------------- @@ -837,7 +833,7 @@ package body Exp_Imgv is Name => Make_If_Expression (Loc, Expressions => New_List ( - Relocate_Node (Expr), + Duplicate_Subexpr (Expr), New_Occurrence_Of (T_Id, Loc), New_Occurrence_Of (F_Id, Loc))))); @@ -1005,20 +1001,6 @@ package body Exp_Imgv is Analyze_And_Resolve (N, Standard_String); end Expand_User_Defined_Enumeration_Image; - -------------------------------------- - -- Is_User_Defined_Enumeration_Type -- - -------------------------------------- - - function Is_User_Defined_Enumeration_Type - (Typ : Entity_Id) return Boolean is - begin - return Ekind (Typ) = E_Enumeration_Type - and then Typ /= Standard_Boolean - and then Typ /= Standard_Character - and then Typ /= Standard_Wide_Character - and then Typ /= Standard_Wide_Wide_Character; - end Is_User_Defined_Enumeration_Type; - -- Local variables Enum_Case : Boolean; @@ -1060,46 +1042,6 @@ package body Exp_Imgv is Rtyp := Underlying_Type (Base_Type (Ptyp)); end if; - -- Use inline expansion for user-defined enumeration types for which - -- the literal string entity has been built, and if -gnatd_x is not - -- passed to the compiler. Otherwise the attribute will be expanded - -- into a call to a routine in the runtime. - - if Is_User_Defined_Enumeration_Type (Rtyp) - and then Present (Lit_Strings (Rtyp)) - and then not Debug_Flag_Underscore_X - then - Expand_User_Defined_Enumeration_Image (Rtyp); - return; - end if; - - -- Build declarations of Snn and Pnn to be inserted - - Ins_List := New_List ( - - -- Snn : String (1 .. typ'Width); - - Make_Object_Declaration (Loc, - Defining_Identifier => Snn, - Object_Definition => - Make_Subtype_Indication (Loc, - Subtype_Mark => New_Occurrence_Of (Standard_String, Loc), - Constraint => - Make_Index_Or_Discriminant_Constraint (Loc, - Constraints => New_List ( - Make_Range (Loc, - Low_Bound => Make_Integer_Literal (Loc, 1), - High_Bound => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Rtyp, Loc), - Attribute_Name => Name_Width)))))), - - -- Pnn : Natural; - - Make_Object_Declaration (Loc, - Defining_Identifier => Pnn, - Object_Definition => New_Occurrence_Of (Standard_Natural, Loc))); - -- Set Imid (RE_Id of procedure to call), and Tent, target for the -- type conversion of the first argument for all possibilities. @@ -1266,9 +1208,14 @@ package body Exp_Imgv is Analyze_And_Resolve (N, Standard_String); return; - else - -- Here for enumeration type case + -- Use inline expansion if the -gnatd_x switch is not passed to the + -- compiler. Otherwise expand into a call to the runtime. + + elsif not Debug_Flag_Underscore_X then + Expand_User_Defined_Enumeration_Image (Rtyp); + return; + else Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp))); if Ttyp = Standard_Integer_8 then @@ -1295,25 +1242,11 @@ package body Exp_Imgv is -- Build first argument for call if Enum_Case then - declare - T : Entity_Id; - begin - -- In Ada 2020 we need the underlying type here, because 'Image is - -- allowed on private types. We have already checked the version - -- when resolving the attribute. - - if Is_Private_Type (Ptyp) then - T := Rtyp; - else - T := Ptyp; - end if; - - Arg_List := New_List ( - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Pos, - Prefix => New_Occurrence_Of (T, Loc), - Expressions => New_List (Expr))); - end; + Arg_List := New_List ( + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Pos, + Prefix => New_Occurrence_Of (Ptyp, Loc), + Expressions => New_List (Expr))); -- AI12-0020: Ada 2020 allows 'Image for all types, including private -- types. If the full type is not a fixed-point type, then it is enough @@ -1325,6 +1258,7 @@ package body Exp_Imgv is else declare Conv : Node_Id; + begin if Is_Private_Type (Etype (Expr)) then if Is_Fixed_Point_Type (Rtyp) then @@ -1340,6 +1274,33 @@ package body Exp_Imgv is end; end if; + -- Build declarations of Snn and Pnn to be inserted + + Ins_List := New_List ( + + -- Snn : String (1 .. typ'Width); + + Make_Object_Declaration (Loc, + Defining_Identifier => Snn, + Object_Definition => + Make_Subtype_Indication (Loc, + Subtype_Mark => New_Occurrence_Of (Standard_String, Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Rtyp, Loc), + Attribute_Name => Name_Width)))))), + + -- Pnn : Natural; + + Make_Object_Declaration (Loc, + Defining_Identifier => Pnn, + Object_Definition => New_Occurrence_Of (Standard_Natural, Loc))); + -- Append Snn, Pnn arguments Append_To (Arg_List, New_Occurrence_Of (Snn, Loc)); --2fHTh5uZTiUOsy+g--