-- Homonym Node4
-- First_Rep_Item Node6
-- Freeze_Node Node7
+ -- Associated_Entity Node37
-- The usage of other fields (and the entity kinds to which it applies)
-- depends on the particular field (see Einfo spec for details).
-- Part_Of_Constituents Elist9
-- Renaming_Map Uint9
- -- Encapsulating_State Node10
-- Direct_Primitive_Operations Elist10
-- Discriminal_Link Node10
-- Float_Rep Uint10 (but returns Float_Rep_Kind)
-- First_Literal Node17
-- Master_Id Node17
-- Modulus Uint17
- -- Non_Limited_View Node17
-- Prival Node17
-- Alias Node18
-- Default_Aspect_Value Node19
-- Entry_Bodies_Array Node19
-- Extra_Accessibility_Of_Result Node19
+ -- Non_Limited_View Node19
-- Parent_Subtype Node19
-- Size_Check_Code Node19
-- Spec_Entity Node19
-- Stored_Constraint Elist23
-- Related_Expression Node24
- -- Uplevel_References Elist24
-- Subps_Index Uint24
- -- Interface_Alias Node25
- -- Interfaces Elist25
-- Debug_Renaming_Link Node25
-- DT_Offset_To_Top_Func Node25
+ -- Interface_Alias Node25
+ -- Interfaces Elist25
-- PPC_Wrapper Node25
-- Related_Array_Object Node25
-- Static_Discrete_Predicate List25
-- Thunk_Entity Node31
-- Activation_Record_Component Node31
+ -- Encapsulating_State Node32
-- SPARK_Pragma Node32
-- No_Tagged_Streams_Pragma Node32
-- Import_Pragma Node35
+ -- (unused) Node36
+ -- (unused) Node38
+ -- (unused) Node39
+ -- (unused) Node40
+ -- (unused) Node41
+
---------------------------------------------
-- Usage of Flags in Defining Entity Nodes --
---------------------------------------------
-- Is_Static_Type Flag281
-- Has_Nested_Subprogram Flag282
- -- Uplevel_Reference_Noted Flag283
+ -- Is_Uplevel_Referenced_Entity Flag283
+ -- Is_Unimplemented Flag284
- -- (unused) Flag284
-- (unused) Flag285
-- (unused) Flag286
-
- -- Note: Flag287-317 are defined in atree.ads/adb, but not yet in atree.h
+ -- (unused) Flag287
+ -- (unused) Flag288
+ -- (unused) Flag289
+ -- (unused) Flag300
+
+ -- (unused) Flag301
+ -- (unused) Flag302
+ -- (unused) Flag303
+ -- (unused) Flag304
+ -- (unused) Flag305
+ -- (unused) Flag306
+ -- (unused) Flag307
+ -- (unused) Flag308
+ -- (unused) Flag309
+
+ -- Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h
-----------------------
-- Local subprograms --
return Uint14 (Id);
end Alignment;
+ function Associated_Entity (Id : E) return E is
+ begin
+ return Node37 (Id);
+ end Associated_Entity;
+
function Associated_Formal_Package (Id : E) return E is
begin
pragma Assert (Ekind (Id) = E_Package);
function Encapsulating_State (Id : E) return N is
begin
- pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
- return Node10 (Id);
+ pragma Assert (Ekind_In (Id, E_Abstract_State, E_Constant, E_Variable));
+ return Node32 (Id);
end Encapsulating_State;
function Enclosing_Scope (Id : E) return E is
E_Package,
E_Package_Body,
E_Subprogram_Body,
- E_Variable)
+ E_Variable,
+ E_Void)
or else Is_Subprogram_Or_Generic_Subprogram (Id));
return Node34 (Id);
end Contract;
function Is_Static_Type (Id : E) return B is
begin
- pragma Assert (Is_Type (Id));
return Flag281 (Id);
end Is_Static_Type;
return Flag246 (Id);
end Is_Underlying_Record_View;
+ function Is_Unimplemented (Id : E) return B is
+ begin
+ return Flag284 (Id);
+ end Is_Unimplemented;
+
function Is_Unsigned_Type (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
return Flag144 (Id);
end Is_Unsigned_Type;
+ function Is_Uplevel_Referenced_Entity (Id : E) return B is
+ begin
+ return Flag283 (Id);
+ end Is_Uplevel_Referenced_Entity;
+
function Is_Valued_Procedure (Id : E) return B is
begin
pragma Assert (Ekind (Id) = E_Procedure);
function Non_Limited_View (Id : E) return E is
begin
pragma Assert
- (Ekind (Id) in Incomplete_Kind or else Ekind (Id) = E_Abstract_State);
- return Node17 (Id);
+ (Ekind (Id) in Incomplete_Kind
+ or else
+ Ekind (Id) in Class_Wide_Kind
+ or else
+ Ekind (Id) = E_Abstract_State);
+ return Node19 (Id);
end Non_Limited_View;
function Nonzero_Is_True (Id : E) return B is
return Node16 (Id);
end Unset_Reference;
- function Uplevel_Reference_Noted (Id : E) return B is
- begin
- return Flag283 (Id);
- end Uplevel_Reference_Noted;
-
- function Uplevel_References (Id : E) return L is
- begin
- pragma Assert (Is_Subprogram (Id));
- return Elist24 (Id);
- end Uplevel_References;
-
function Used_As_Generic_Actual (Id : E) return B is
begin
return Flag222 (Id);
Set_Elist16 (Id, V);
end Set_Access_Disp_Table;
+ procedure Set_Associated_Entity (Id : E; V : E) is
+ begin
+ Set_Node37 (Id, V);
+ end Set_Associated_Entity;
+
procedure Set_Associated_Formal_Package (Id : E; V : E) is
begin
Set_Node12 (Id, V);
begin
pragma Assert
(Ekind_In (Id, E_Entry,
- E_Entry_Family,
- E_Generic_Package,
- E_Package,
- E_Package_Body,
- E_Subprogram_Body,
- E_Variable,
- E_Void)
+ E_Entry_Family,
+ E_Generic_Package,
+ E_Package,
+ E_Package_Body,
+ E_Subprogram_Body,
+ E_Variable,
+ E_Void)
or else Is_Subprogram_Or_Generic_Subprogram (Id));
Set_Node34 (Id, V);
end Set_Contract;
procedure Set_Encapsulating_State (Id : E; V : E) is
begin
- pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
- Set_Node10 (Id, V);
+ pragma Assert (Ekind_In (Id, E_Abstract_State, E_Constant, E_Variable));
+ Set_Node32 (Id, V);
end Set_Encapsulating_State;
procedure Set_Enclosing_Scope (Id : E; V : E) is
Set_Flag282 (Id, V);
end Set_Has_Nested_Subprogram;
- procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
- begin
- Set_Flag215 (Id, V);
- end Set_Has_Uplevel_Reference;
-
procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
Set_Flag72 (Id, V);
end Set_Has_Unknown_Discriminants;
+ procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
+ begin
+ Set_Flag215 (Id, V);
+ end Set_Has_Uplevel_Reference;
+
procedure Set_Has_Visible_Refinement (Id : E; V : B := True) is
begin
pragma Assert (Ekind (Id) = E_Abstract_State);
Set_Flag246 (Id, V);
end Set_Is_Underlying_Record_View;
+ procedure Set_Is_Unimplemented (Id : E; V : B := True) is
+ begin
+ Set_Flag284 (Id, V);
+ end Set_Is_Unimplemented;
+
procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
begin
pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
Set_Flag144 (Id, V);
end Set_Is_Unsigned_Type;
+ procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
+ begin
+ pragma Assert
+ (Ekind_In (Id, E_Constant, E_Variable)
+ or else Is_Formal (Id)
+ or else Is_Type (Id));
+ Set_Flag283 (Id, V);
+ end Set_Is_Uplevel_Referenced_Entity;
+
procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
begin
pragma Assert (Ekind (Id) = E_Procedure);
procedure Set_Non_Limited_View (Id : E; V : E) is
begin
pragma Assert
- (Ekind (Id) in Incomplete_Kind or else Ekind (Id) = E_Abstract_State);
- Set_Node17 (Id, V);
+ (Ekind (Id) in Incomplete_Kind
+ or else Ekind_In (Id, E_Abstract_State, E_Class_Wide_Type));
+ Set_Node19 (Id, V);
end Set_Non_Limited_View;
procedure Set_Nonzero_Is_True (Id : E; V : B := True) is
Set_Node16 (Id, V);
end Set_Unset_Reference;
- procedure Set_Uplevel_Reference_Noted (Id : E; V : B := True) is
- begin
- Set_Flag283 (Id, V);
- end Set_Uplevel_Reference_Noted;
-
- procedure Set_Uplevel_References (Id : E; V : L) is
- begin
- pragma Assert (Is_Subprogram (Id));
- Set_Elist24 (Id, V);
- end Set_Uplevel_References;
-
procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
begin
Set_Flag222 (Id, V);
return False;
end Has_Interrupt_Handler;
+ --------------------------
+ -- Has_Non_Limited_View --
+ --------------------------
+
+ function Has_Non_Limited_View (Id : E) return B is
+ begin
+ return (Ekind (Id) in Incomplete_Kind
+ or else Ekind (Id) in Class_Wide_Kind
+ or else Ekind (Id) = E_Abstract_State)
+ and then Present (Non_Limited_View (Id));
+ end Has_Non_Limited_View;
+
-----------------------------
-- Has_Non_Null_Refinement --
-----------------------------
P := Id;
loop
- P := Next_Entity (P);
+ Next_Entity (P);
if No (P) or else Is_Formal (P) then
return P;
--------------------
function Number_Entries (Id : E) return Nat is
- N : Int;
- Ent : Entity_Id;
+ N : Int;
+ Ent : Entity_Id;
begin
pragma Assert (Is_Concurrent_Type (Id));
W ("Is_True_Constant", Flag163 (Id));
W ("Is_Unchecked_Union", Flag117 (Id));
W ("Is_Underlying_Record_View", Flag246 (Id));
+ W ("Is_Unimplemented", Flag284 (Id));
W ("Is_Unsigned_Type", Flag144 (Id));
+ W ("Is_Uplevel_Referenced_Entity", Flag283 (Id));
W ("Is_Valued_Procedure", Flag127 (Id));
W ("Is_Visible_Formal", Flag206 (Id));
W ("Is_Visible_Lib_Unit", Flag116 (Id));
W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
W ("Treat_As_Volatile", Flag41 (Id));
W ("Universal_Aliasing", Flag216 (Id));
- W ("Uplevel_Reference_Noted", Flag283 (Id));
W ("Used_As_Generic_Actual", Flag222 (Id));
W ("Uses_Sec_Stack", Flag95 (Id));
W ("Warnings_Off", Flag96 (Id));
-----------------------
procedure Write_Field6_Name (Id : Entity_Id) is
- pragma Warnings (Off, Id);
+ pragma Unreferenced (Id);
begin
Write_Str ("First_Rep_Item");
end Write_Field6_Name;
-----------------------
procedure Write_Field7_Name (Id : Entity_Id) is
- pragma Warnings (Off, Id);
+ pragma Unreferenced (Id);
begin
Write_Str ("Freeze_Node");
end Write_Field7_Name;
procedure Write_Field10_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Abstract_State |
- E_Variable =>
- Write_Str ("Encapsulating_State");
-
when Class_Wide_Kind |
Incomplete_Kind |
E_Record_Type |
Concurrent_Kind =>
Write_Str ("Direct_Primitive_Operations");
- when Float_Kind =>
- Write_Str ("Float_Rep");
-
when E_In_Parameter |
E_Constant =>
Write_Str ("Discriminal_Link");
+ when Float_Kind =>
+ Write_Str ("Float_Rep");
+
when E_Function |
E_Package |
E_Package_Body |
when Modular_Integer_Kind =>
Write_Str ("Modulus");
- when E_Abstract_State |
- E_Incomplete_Type =>
- Write_Str ("Non_Limited_View");
-
when E_Incomplete_Subtype =>
if From_Limited_With (Id) then
Write_Str ("Non_Limited_View");
when Scalar_Kind =>
Write_Str ("Default_Aspect_Value");
+ when E_Abstract_State |
+ E_Class_Wide_Type |
+ E_Incomplete_Type =>
+ Write_Str ("Non_Limited_View");
+
when E_Array_Type =>
Write_Str ("Default_Component_Value");
when E_Function |
E_Operator |
E_Procedure =>
- if Field24 (Id) in Uint_Range then
- Write_Str ("Subps_Index");
- else
- Write_Str ("Uplevel_References");
- end if;
+ Write_Str ("Subps_Index");
when others =>
Write_Str ("Field24???");
procedure Write_Field32_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
+ when E_Abstract_State |
+ E_Constant |
+ E_Variable =>
+ Write_Str ("Encapsulating_State");
+
when E_Function |
E_Generic_Function |
E_Generic_Package |
E_Package_Body |
E_Subprogram_Body |
E_Variable |
+ E_Void |
Generic_Subprogram_Kind |
Subprogram_Kind =>
Write_Str ("Contract");
end case;
end Write_Field35_Name;
+ ------------------------
+ -- Write_Field36_Name --
+ ------------------------
+
+ procedure Write_Field36_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field36??");
+ end case;
+ end Write_Field36_Name;
+
+ ------------------------
+ -- Write_Field37_Name --
+ ------------------------
+
+ procedure Write_Field37_Name (Id : Entity_Id) is
+ pragma Unreferenced (Id);
+ begin
+ Write_Str ("Associated_Entity");
+ end Write_Field37_Name;
+
+ ------------------------
+ -- Write_Field38_Name --
+ ------------------------
+
+ procedure Write_Field38_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field38??");
+ end case;
+ end Write_Field38_Name;
+
+ ------------------------
+ -- Write_Field39_Name --
+ ------------------------
+
+ procedure Write_Field39_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field39??");
+ end case;
+ end Write_Field39_Name;
+
+ ------------------------
+ -- Write_Field40_Name --
+ ------------------------
+
+ procedure Write_Field40_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field40??");
+ end case;
+ end Write_Field40_Name;
+
+ ------------------------
+ -- Write_Field41_Name --
+ ------------------------
+
+ procedure Write_Field41_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field41??");
+ end case;
+ end Write_Field41_Name;
+
-------------------------
-- Iterator Procedures --
-------------------------