[Ada] Replace calls to RTE with Is_RTE where possible

Message ID 20210503092945.GA77611@adacore.com
State New
Headers show
Series
  • [Ada] Replace calls to RTE with Is_RTE where possible
Related show

Commit Message

Pierre-Marie de Rodat May 3, 2021, 9:29 a.m.
Replace expression of the form "X = RTE (...)" with "Is_RTE (X, ...)",
which avoids loading of the unit where the ... entity is defined. In
particular, a sequence of RTE_Available and RTE load the target unit
where Is_RTE doesn't.

This patch is primarily a code cleanup, but it also avoids unnecessary
loading of Ada.Tags in few cases.

The only context where replacing RTE with Is_RTE isn't really needed is
pragma Assert (X = RTE (...)), because we expect the equality to hold,
but this patch replaces such calls to RTE as well, for consistency.

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

gcc/ada/

	* checks.adb, exp_aggr.adb, exp_attr.adb, exp_ch6.adb,
	exp_disp.adb, exp_imgv.adb, exp_util.adb, sem_attr.adb,
	sem_ch13.adb, sem_ch8.adb, sem_eval.adb, sem_scil.adb,
	sem_util.adb: Replace calls to RTE with Is_RTE.

Patch

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -552,9 +552,7 @@  package body Checks is
 
       if Tagged_Type_Expansion
         and then Present (Etype (P))
-        and then RTU_Loaded (Ada_Tags)
-        and then RTE_Available (RE_Offset_To_Top_Ptr)
-        and then Etype (P) = RTE (RE_Offset_To_Top_Ptr)
+        and then Is_RTE (Etype (P), RE_Offset_To_Top_Ptr)
       then
          return;
       end if;


diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -8678,30 +8678,25 @@  package body Exp_Aggr is
    begin
       return Building_Static_Dispatch_Tables
         and then Tagged_Type_Expansion
-        and then RTU_Loaded (Ada_Tags)
 
          --  Avoid circularity when rebuilding the compiler
 
-        and then Cunit_Entity (Get_Source_Unit (N)) /= RTU_Entity (Ada_Tags)
-        and then (Typ = RTE (RE_Dispatch_Table_Wrapper)
+        and then not Is_RTU (Cunit_Entity (Get_Source_Unit (N)), Ada_Tags)
+        and then (Is_RTE (Typ, RE_Dispatch_Table_Wrapper)
                     or else
-                  Typ = RTE (RE_Address_Array)
+                  Is_RTE (Typ, RE_Address_Array)
                     or else
-                  Typ = RTE (RE_Type_Specific_Data)
+                  Is_RTE (Typ, RE_Type_Specific_Data)
                     or else
-                  Typ = RTE (RE_Tag_Table)
+                  Is_RTE (Typ, RE_Tag_Table)
                     or else
-                  (RTE_Available (RE_Object_Specific_Data)
-                     and then Typ = RTE (RE_Object_Specific_Data))
+                  Is_RTE (Typ, RE_Object_Specific_Data)
                     or else
-                  (RTE_Available (RE_Interface_Data)
-                     and then Typ = RTE (RE_Interface_Data))
+                  Is_RTE (Typ, RE_Interface_Data)
                     or else
-                  (RTE_Available (RE_Interfaces_Array)
-                     and then Typ = RTE (RE_Interfaces_Array))
+                  Is_RTE (Typ, RE_Interfaces_Array)
                     or else
-                  (RTE_Available (RE_Interface_Data_Element)
-                     and then Typ = RTE (RE_Interface_Data_Element)));
+                  Is_RTE (Typ, RE_Interface_Data_Element));
    end Is_Static_Dispatch_Table_Aggregate;
 
    -----------------------------


diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2150,7 +2150,7 @@  package body Exp_Attr is
                --  the node with the type imposed by the context.
 
                if Nkind (Parent (N)) = N_Unchecked_Type_Conversion
-                 and then Etype (Parent (N)) = RTE (RE_Prim_Ptr)
+                 and then Is_RTE (Etype (Parent (N)), RE_Prim_Ptr)
                then
                   Set_Etype (N, RTE (RE_Prim_Ptr));
 


diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -10010,8 +10010,6 @@  package body Exp_Ch6 is
          elsif Nkind (Expr) = N_Function_Call
            and then Nkind (Name (Expr)) in N_Has_Entity
            and then Present (Entity (Name (Expr)))
-           and then RTU_Loaded (Ada_Tags)
-           and then RTE_Available (RE_Displace)
            and then Is_RTE (Entity (Name (Expr)), RE_Displace)
          then
             Has_Pointer_Displacement := True;


diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -161,9 +161,8 @@  package body Exp_Disp is
       --  This capability of dispatching directly by tag is also needed by the
       --  implementation of AI-260 (for the generic dispatching constructors).
 
-      if Ctrl_Typ = RTE (RE_Tag)
-        or else (RTE_Available (RE_Interface_Tag)
-                  and then Ctrl_Typ = RTE (RE_Interface_Tag))
+      if Is_RTE (Ctrl_Typ, RE_Tag)
+        or else Is_RTE (Ctrl_Typ, RE_Interface_Tag)
       then
          CW_Typ := Class_Wide_Type (Find_Dispatching_Type (Subp));
 
@@ -527,8 +526,7 @@  package body Exp_Disp is
              and then Is_Tag (Entity (Selector_Name (Expr))))
            or else
            (Nkind (Expr) = N_Function_Call
-             and then RTE_Available (RE_Displace)
-             and then Entity (Name (Expr)) = RTE (RE_Displace))));
+             and then Is_RTE (Entity (Name (Expr)), RE_Displace))));
 
       Anon_Type := Create_Itype (E_Anonymous_Access_Type, Expr);
       Set_Directly_Designated_Type (Anon_Type, Typ);
@@ -939,9 +937,8 @@  package body Exp_Disp is
       --  This capability of dispatching directly by tag is also needed by the
       --  implementation of AI-260 (for the generic dispatching constructors).
 
-      if Ctrl_Typ = RTE (RE_Tag)
-        or else (RTE_Available (RE_Interface_Tag)
-                  and then Ctrl_Typ = RTE (RE_Interface_Tag))
+      if Is_RTE (Ctrl_Typ, RE_Tag)
+        or else Is_RTE (Ctrl_Typ, RE_Interface_Tag)
       then
          CW_Typ := Class_Wide_Type (Find_Dispatching_Type (Subp));
 
@@ -1124,9 +1121,8 @@  package body Exp_Disp is
       --  interface class-wide type then use it directly. Otherwise, the tag
       --  must be extracted from the controlling object.
 
-      if Ctrl_Typ = RTE (RE_Tag)
-        or else (RTE_Available (RE_Interface_Tag)
-                  and then Ctrl_Typ = RTE (RE_Interface_Tag))
+      if Is_RTE (Ctrl_Typ, RE_Tag)
+        or else Is_RTE (Ctrl_Typ, RE_Interface_Tag)
       then
          Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg);
 
@@ -1138,11 +1134,9 @@  package body Exp_Disp is
 
       elsif Nkind (Ctrl_Arg) = N_Unchecked_Type_Conversion
         and then
-          (Etype (Expression (Ctrl_Arg)) = RTE (RE_Tag)
+          (Is_RTE (Etype (Expression (Ctrl_Arg)), RE_Tag)
             or else
-              (RTE_Available (RE_Interface_Tag)
-                and then
-                  Etype (Expression (Ctrl_Arg)) = RTE (RE_Interface_Tag)))
+           Is_RTE (Etype (Expression (Ctrl_Arg)), RE_Interface_Tag))
       then
          Controlling_Tag := Duplicate_Subexpr (Expression (Ctrl_Arg));
 
@@ -8692,7 +8686,7 @@  package body Exp_Disp is
          --  with an abstract interface type
 
          if Present (DTC_Entity (Prim)) then
-            if Etype (DTC_Entity (Prim)) = RTE (RE_Tag) then
+            if Is_RTE (Etype (DTC_Entity (Prim)), RE_Tag) then
                Write_Str ("[P] ");
             else
                Write_Str ("[s] ");


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
@@ -1140,7 +1140,7 @@  package body Exp_Imgv is
       --  There is a better way, test RTE_Available ???
 
       if No_Run_Time_Mode
-        and then Rtyp = RTE (RE_Integer_Address)
+        and then Is_RTE (Rtyp, RE_Integer_Address)
         and then RTU_Loaded (Ada_Tags)
         and then Cunit_Entity (Current_Sem_Unit)
                    = Body_Entity (RTU_Entity (Ada_Tags))


diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -834,7 +834,7 @@  package body Exp_Util is
       --  Optimize the case where we are using the default Global_Pool_Object,
       --  and we don't need the heavy finalization machinery.
 
-      elsif Pool_Id = RTE (RE_Global_Pool_Object)
+      elsif Is_RTE (Pool_Id, RE_Global_Pool_Object)
         and then not Needs_Finalization (Desig_Typ)
       then
          return;
@@ -9081,7 +9081,7 @@  package body Exp_Util is
         Is_Class_Wide_Type (Etype (Obj_Id))
           and then Present (Expr)
           and then Nkind (Expr) = N_Unchecked_Type_Conversion
-          and then Etype (Expression (Expr)) = RTE (RE_Tag);
+          and then Is_RTE (Etype (Expression (Expr)), RE_Tag);
    end Is_Tag_To_Class_Wide_Conversion;
 
    --------------------------------


diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -905,9 +905,9 @@  package body Sem_Attr is
             --  a tagged type cleans constant indications from its scope).
 
             elsif Nkind (Parent (N)) = N_Unchecked_Type_Conversion
-              and then (Etype (Parent (N)) = RTE (RE_Prim_Ptr)
+              and then (Is_RTE (Etype (Parent (N)), RE_Prim_Ptr)
                           or else
-                        Etype (Parent (N)) = RTE (RE_Size_Ptr))
+                        Is_RTE (Etype (Parent (N)), RE_Size_Ptr))
               and then Is_Dispatching_Operation
                          (Directly_Designated_Type (Etype (N)))
             then
@@ -2386,7 +2386,7 @@  package body Sem_Attr is
          --  root type of a class-wide type is the corresponding type (e.g.
          --  X for X'Class, and we really want to go to the root.)
 
-         if Root_Type (Root_Type (Etype (E1))) /= RTE (RE_Sink) then
+         if not Is_RTE (Root_Type (Root_Type (Etype (E1))), RE_Sink) then
             Error_Attr
               ("expected Ada.Strings.Text_Output.Sink''Class", E1);
          end if;
@@ -2556,8 +2556,8 @@  package body Sem_Attr is
          --  X for X'Class, and we really want to go to the root.)
 
          if not Is_Access_Type (Etyp)
-           or else Root_Type (Root_Type (Designated_Type (Etyp))) /=
-                     RTE (RE_Root_Stream_Type)
+           or else not Is_RTE (Root_Type (Root_Type (Designated_Type (Etyp))),
+                               RE_Root_Stream_Type)
          then
             Error_Attr
               ("expected access to Ada.Streams.Root_Stream_Type''Class", E1);


diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7430,9 +7430,7 @@  package body Sem_Ch13 is
             --    type Q is access Float;
             --    for Q'Storage_Size use T'Storage_Size; -- incorrect
 
-            if RTE_Available (RE_Stack_Bounded_Pool)
-              and then Base_Type (T) = RTE (RE_Stack_Bounded_Pool)
-            then
+            if Is_RTE (Base_Type (T), RE_Stack_Bounded_Pool) then
                Error_Msg_N ("non-shareable internal Pool", Expr);
                return;
             end if;
@@ -7722,7 +7720,7 @@  package body Sem_Ch13 is
 
       if Etype (Expression (N)) = Any_Type then
          return;
-      elsif Etype (Expression (N)) /= RTE (RE_Asm_Insn) then
+      elsif not Is_RTE (Etype (Expression (N)), RE_Asm_Insn) then
          Error_Msg_N ("incorrect type for code statement", N);
          return;
       end if;


diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -4443,7 +4443,7 @@  package body Sem_Ch8 is
 
       if not Configurable_Run_Time_Mode
         and then not Present (Corresponding_Formal_Spec (N))
-        and then Etype (Nam) /= RTE (RE_AST_Handler)
+        and then not Is_RTE (Etype (Nam), RE_AST_Handler)
       then
          declare
             P : constant Node_Id := Prefix (Nam);
@@ -7508,15 +7508,9 @@  package body Sem_Ch8 is
                   --  dispatch table wrappers. Required to avoid generating
                   --  elaboration code with HI runtimes.
 
-                  elsif RTU_Loaded (Ada_Tags)
-                    and then
-                      ((RTE_Available (RE_Dispatch_Table_Wrapper)
-                         and then Scope (Selector) =
-                                     RTE (RE_Dispatch_Table_Wrapper))
-                        or else
-                          (RTE_Available (RE_No_Dispatch_Table_Wrapper)
-                            and then Scope (Selector) =
-                                     RTE (RE_No_Dispatch_Table_Wrapper)))
+                  elsif Is_RTE (Scope (Selector), RE_Dispatch_Table_Wrapper)
+                    or else
+                      Is_RTE (Scope (Selector), RE_No_Dispatch_Table_Wrapper)
                   then
                      C_Etype := Empty;
                   else


diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -6104,7 +6104,9 @@  package body Sem_Eval is
          --  No message if we are dealing with System.Priority values in
          --  CodePeer mode where the target runtime may have more priorities.
 
-         elsif not CodePeer_Mode or else Etype (N) /= RTE (RE_Priority) then
+         elsif not CodePeer_Mode
+           or else not Is_RTE (Etype (N), RE_Priority)
+         then
             --  Determine if the out-of-range violation constitutes a warning
             --  or an error based on context, according to RM 4.9 (34/3).
 


diff --git a/gcc/ada/sem_scil.adb b/gcc/ada/sem_scil.adb
--- a/gcc/ada/sem_scil.adb
+++ b/gcc/ada/sem_scil.adb
@@ -71,13 +71,12 @@  package body Sem_SCIL is
                --  Interface types are unsupported
 
                if Is_Interface (Ctrl_Typ)
-                 or else (RTE_Available (RE_Interface_Tag)
-                            and then Ctrl_Typ = RTE (RE_Interface_Tag))
+                 or else Is_RTE (Ctrl_Typ, RE_Interface_Tag)
                then
                   null;
 
                else
-                  pragma Assert (Ctrl_Typ = RTE (RE_Tag));
+                  pragma Assert (Is_RTE (Ctrl_Typ, RE_Tag));
                   null;
                end if;
 
@@ -94,8 +93,7 @@  package body Sem_SCIL is
                --  Interface types are unsupported.
 
                if Is_Interface (Ctrl_Typ)
-                 or else (RTE_Available (RE_Interface_Tag)
-                           and then Ctrl_Typ = RTE (RE_Interface_Tag))
+                 or else Is_RTE (Ctrl_Typ, RE_Interface_Tag)
                  or else (Is_Access_Type (Ctrl_Typ)
                            and then
                              Is_Interface
@@ -106,12 +104,14 @@  package body Sem_SCIL is
 
                else
                   pragma Assert
-                    (Ctrl_Typ = RTE (RE_Tag)
+                    (Is_RTE (Ctrl_Typ, RE_Tag)
                        or else
                          (Is_Access_Type (Ctrl_Typ)
-                           and then Available_View
-                                      (Base_Type (Designated_Type (Ctrl_Typ)))
-                                        = RTE (RE_Tag)));
+                            and then
+                          Is_RTE
+                            (Available_View
+                               (Base_Type (Designated_Type (Ctrl_Typ))),
+                             RE_Tag)));
                   null;
                end if;
 
@@ -167,7 +167,7 @@  package body Sem_SCIL is
                --  tag of the tested object (i.e. Obj.Tag).
 
                when N_Selected_Component =>
-                  pragma Assert (Etype (Ctrl_Tag) = RTE (RE_Tag));
+                  pragma Assert (Is_RTE (Etype (Ctrl_Tag), RE_Tag));
                   null;
 
                when others =>


diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6438,7 +6438,7 @@  package body Sem_Util is
             --  appear in the target-specific extension to System.
 
             if No (Id)
-              and then B_Scope = RTU_Entity (System)
+              and then Is_RTU (B_Scope, System)
               and then Present_System_Aux
             then
                B_Scope := System_Aux_Id;
@@ -16897,8 +16897,8 @@  package body Sem_Util is
         Nkind (E) = N_Function_Call
           and then not Configurable_Run_Time_Mode
           and then Nkind (Original_Node (E)) = N_Attribute_Reference
-          and then (Entity (Name (E)) = RTE (RE_Get_Ceiling)
-                     or else Entity (Name (E)) = RTE (RO_PE_Get_Ceiling));
+          and then (Is_RTE (Entity (Name (E)), RE_Get_Ceiling)
+                     or else Is_RTE (Entity (Name (E)), RO_PE_Get_Ceiling));
    end Is_Expanded_Priority_Attribute;
 
    ----------------------------