diff mbox series

[Ada] Use inline expansion of Image for enumeration types by default

Message ID 20210505082005.GA31227@adacore.com
State New
Headers show
Series [Ada] Use inline expansion of Image for enumeration types by default | expand

Commit Message

Pierre-Marie de Rodat May 5, 2021, 8:20 a.m. UTC
This reduces the number of bootstrap dependencies for the compiler.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* debug.adb (d_x): Document new usage.
	* exp_imgv.adb (Expand_User_Defined_Enumeration_Image): Add Typ
	parameter and use it throughout the processing.
	(Expand_Image_Attribute): Retrieve the underlying type of the
	prefix and use the inline expansion for user-defined enumeration
	types with a literal string by default.
diff mbox series

Patch

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -162,7 +162,7 @@  package body Debug is
    --  d_u
    --  d_v
    --  d_w
-   --  d_x
+   --  d_x  Disable inline expansion of Image attribute for enumeration types
    --  d_y
    --  d_z  Enable Put_Image on tagged types
 
@@ -990,6 +990,9 @@  package body Debug is
    --       a call to routine Ada.Synchronous_Task_Control.Suspend_Until_True
    --       or Ada.Synchronous_Barriers.Wait_For_Release.
 
+   --  d_x  The compiler does not expand in line the Image attribute for user-
+   --       defined enumeration types.
+
    --  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
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -754,7 +754,7 @@  package body Exp_Imgv is
       Expr  : constant Node_Id    := Relocate_Node (First (Exprs));
       Pref  : constant Node_Id    := Prefix (N);
 
-      procedure Expand_User_Defined_Enumeration_Image;
+      procedure Expand_User_Defined_Enumeration_Image (Typ : Entity_Id);
       --  Expand attribute 'Image in user-defined enumeration types, avoiding
       --  string copy.
 
@@ -766,14 +766,12 @@  package body Exp_Imgv is
       -- Expand_User_Defined_Enumeration_Image --
       -------------------------------------------
 
-      procedure Expand_User_Defined_Enumeration_Image is
+      procedure Expand_User_Defined_Enumeration_Image (Typ : Entity_Id) is
          Ins_List : constant List_Id   := New_List;
          P1_Id    : constant Entity_Id := Make_Temporary (Loc, 'P');
          P2_Id    : constant Entity_Id := Make_Temporary (Loc, 'P');
          P3_Id    : constant Entity_Id := Make_Temporary (Loc, 'P');
          P4_Id    : constant Entity_Id := Make_Temporary (Loc, 'P');
-         Ptyp     : constant Entity_Id := Entity (Pref);
-         Rtyp     : constant Entity_Id := Root_Type (Ptyp);
          S1_Id    : constant Entity_Id := Make_Temporary (Loc, 'S');
 
       begin
@@ -785,7 +783,7 @@  package body Exp_Imgv is
          end if;
 
          --  Generate:
-         --    P1 : constant Natural := Pos;
+         --    P1 : constant Natural := Typ'Pos (Typ?(Expr));
 
          Append_To (Ins_List,
            Make_Object_Declaration (Loc,
@@ -797,8 +795,8 @@  package body Exp_Imgv is
                Convert_To (Standard_Natural,
                  Make_Attribute_Reference (Loc,
                    Attribute_Name => Name_Pos,
-                   Prefix         => New_Occurrence_Of (Ptyp, Loc),
-                   Expressions    => New_List (Expr)))));
+                   Prefix         => New_Occurrence_Of (Typ, Loc),
+                   Expressions    => New_List (OK_Convert_To (Typ, Expr))))));
 
          --  Compute the index of the string start, generating:
          --    P2 : constant Natural := call_put_enumN (P1);
@@ -813,7 +811,7 @@  package body Exp_Imgv is
                Convert_To (Standard_Natural,
                  Make_Indexed_Component (Loc,
                    Prefix      =>
-                     New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
+                     New_Occurrence_Of (Lit_Indexes (Typ), Loc),
                    Expressions =>
                      New_List (New_Occurrence_Of (P1_Id, Loc))))));
 
@@ -837,7 +835,7 @@  package body Exp_Imgv is
                   Convert_To (Standard_Natural,
                     Make_Indexed_Component (Loc,
                       Prefix      =>
-                        New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
+                        New_Occurrence_Of (Lit_Indexes (Typ), Loc),
                       Expressions =>
                         New_List (Add_Node)))));
          end;
@@ -860,7 +858,7 @@  package body Exp_Imgv is
                 Name                =>
                   Make_Slice (Loc,
                     Prefix         =>
-                      New_Occurrence_Of (Lit_Strings (Rtyp), Loc),
+                      New_Occurrence_Of (Lit_Strings (Typ), Loc),
                     Discrete_Range =>
                       Make_Range (Loc,
                         Low_Bound  => New_Occurrence_Of (P2_Id, Loc),
@@ -944,7 +942,7 @@  package body Exp_Imgv is
          return;
       end if;
 
-      Ptyp := Entity (Pref);
+      Ptyp := Underlying_Type (Entity (Pref));
 
       --  Ada 2020 allows 'Image on private types, so fetch the underlying
       --  type to obtain the structure of the type. We use the base type,
@@ -958,16 +956,16 @@  package body Exp_Imgv is
          Rtyp := Underlying_Type (Base_Type (Ptyp));
       end if;
 
-      --  Enable speed-optimized expansion of user-defined enumeration types
-      --  if we are compiling with optimizations enabled and enumeration type
-      --  literals are generated. Otherwise the call will be expanded into a
-      --  call to the runtime library.
+      --  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 Optimization_Level > 0
-        and then not Global_Discard_Names
-        and then Is_User_Defined_Enumeration_Type (Rtyp)
+      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;
+         Expand_User_Defined_Enumeration_Image (Rtyp);
          return;
       end if;