From: Eric Botcazou Date: Tue, 12 Jan 2021 12:25:24 +0000 (+0100) Subject: [Ada] Use inline expansion of Image for standard boolean by default X-Git-Tag: basepoints/gcc-13~7824 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0bfcf0b33d3198cbd6072191815104f9431fc330;p=thirdparty%2Fgcc.git [Ada] Use inline expansion of Image for standard boolean by default gcc/ada/ * debug.adb (d_x): Document extended usage. * exp_imgv.adb (Expand_Standard_Boolean_Image): New procedure. (Expand_Image_Attribute): Call it to expand in line the attribute for standard boolean by default. --- diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 3c8f0547d265..d3fcf8a95001 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -991,7 +991,7 @@ package body Debug is -- or Ada.Synchronous_Barriers.Wait_For_Release. -- d_x The compiler does not expand in line the Image attribute for user- - -- defined enumeration types. + -- defined enumeration types and the standard boolean type. -- d_z Enable the default Put_Image on tagged types that are not -- predefined. diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 90abbd4e6b1b..b35562c6d52e 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -754,6 +754,9 @@ package body Exp_Imgv is Expr : constant Node_Id := Relocate_Node (First (Exprs)); Pref : constant Node_Id := Prefix (N); + procedure Expand_Standard_Boolean_Image; + -- Expand attribute 'Image in Standard.Boolean, avoiding string copy + procedure Expand_User_Defined_Enumeration_Image (Typ : Entity_Id); -- Expand attribute 'Image in user-defined enumeration types, avoiding -- string copy. @@ -762,6 +765,107 @@ package body Exp_Imgv is (Typ : Entity_Id) return Boolean; -- Return True if Typ is a user-defined enumeration type + ----------------------------------- + -- Expand_Standard_Boolean_Image -- + ----------------------------------- + + procedure Expand_Standard_Boolean_Image is + Ins_List : constant List_Id := New_List; + S1_Id : constant Entity_Id := Make_Temporary (Loc, 'S'); + T_Id : constant Entity_Id := Make_Temporary (Loc, 'T'); + F_Id : constant Entity_Id := Make_Temporary (Loc, 'F'); + V_Id : constant Entity_Id := Make_Temporary (Loc, 'V'); + + begin + -- We use a single 5-character string subtype throughout so that the + -- subtype of the string if-expression is constrained and, therefore, + -- does not force the creation of a temporary during analysis. + + -- Generate: + -- subtype S1 is String (1 .. 5); + + Append_To (Ins_List, + Make_Subtype_Declaration (Loc, + Defining_Identifier => S1_Id, + Subtype_Indication => + 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_Integer_Literal (Loc, 5))))))); + + -- Generate: + -- T : constant String (1 .. 5) := "TRUE "; + + Start_String; + Store_String_Chars ("TRUE "); + + Append_To (Ins_List, + Make_Object_Declaration (Loc, + Defining_Identifier => T_Id, + Object_Definition => + New_Occurrence_Of (S1_Id, Loc), + Constant_Present => True, + Expression => Make_String_Literal (Loc, End_String))); + + -- Generate: + -- F : constant String (1 .. 5) := "FALSE"; + + Start_String; + Store_String_Chars ("FALSE"); + + Append_To (Ins_List, + Make_Object_Declaration (Loc, + Defining_Identifier => F_Id, + Object_Definition => + New_Occurrence_Of (S1_Id, Loc), + Constant_Present => True, + Expression => Make_String_Literal (Loc, End_String))); + + -- Generate: + -- V : String (1 .. 5) renames (if Expr then T else F); + + Append_To (Ins_List, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => V_Id, + Subtype_Mark => + New_Occurrence_Of (S1_Id, Loc), + Name => + Make_If_Expression (Loc, + Expressions => New_List ( + Relocate_Node (Expr), + New_Occurrence_Of (T_Id, Loc), + New_Occurrence_Of (F_Id, Loc))))); + + -- Insert all the above declarations before N. We suppress checks + -- because everything is in range at this stage. + + Insert_Actions (N, Ins_List, Suppress => All_Checks); + + -- Final step is to rewrite the expression as a slice: + -- V (1 .. (if Expr then 4 else 5)) and analyze, again with no + -- checks, since we are sure that everything is OK. + + Rewrite (N, + Make_Slice (Loc, + Prefix => New_Occurrence_Of (V_Id, Loc), + Discrete_Range => + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => + Make_If_Expression (Loc, + Expressions => New_List ( + Duplicate_Subexpr (Expr), + Make_Integer_Literal (Loc, 4), + Make_Integer_Literal (Loc, 5)))))); + + Analyze_And_Resolve (N, Standard_String, Suppress => All_Checks); + end Expand_Standard_Boolean_Image; + ------------------------------------------- -- Expand_User_Defined_Enumeration_Image -- ------------------------------------------- @@ -866,7 +970,7 @@ package body Exp_Imgv is end; -- Generate: - -- subtype S1 is string (1 .. P3 - P2); + -- subtype S1 is String (1 .. P3 - P2); declare HB : constant Node_Id := New_Op_Node (N_Op_Subtract, Loc); @@ -1010,8 +1114,17 @@ package body Exp_Imgv is return; elsif Rtyp = Standard_Boolean then - Imid := RE_Image_Boolean; - Tent := Rtyp; + -- Use inline expansion if the -gnatd_x switch is not passed to the + -- compiler. Otherwise expand into a call to the runtime. + + if not Debug_Flag_Underscore_X then + Expand_Standard_Boolean_Image; + return; + + else + Imid := RE_Image_Boolean; + Tent := Rtyp; + end if; -- For standard character, we have to select the version which handles -- soft hyphen correctly, based on the version of Ada in use (this is