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.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;
----------------------------
