-- Body_Entity Node19
-- Corresponding_Discriminant Node19
+ -- Extra_Accessibility_Of_Result Node19
-- Parent_Subtype Node19
-- Related_Array_Object Node19
-- Size_Check_Code Node19
-- Has_Implicit_Dereference Flag251
-- Is_Processed_Transient Flag252
-
- -- (unused) Flag253
- -- (unused) Flag254
+ -- Has_Anonymous_Master Flag253
+ -- Is_Implementation_Defined Flag254
-----------------------
-- Local subprograms --
return Node13 (Id);
end Extra_Accessibility;
+ function Extra_Accessibility_Of_Result (Id : E) return E is
+ begin
+ pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
+ return Node19 (Id);
+ end Extra_Accessibility_Of_Result;
+
function Extra_Constrained (Id : E) return E is
begin
pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
return Flag201 (Id);
end Has_Anon_Block_Suffix;
+ function Has_Anonymous_Master (Id : E) return B is
+ begin
+ pragma Assert
+ (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
+ return Flag253 (Id);
+ end Has_Anonymous_Master;
+
function Has_Atomic_Components (Id : E) return B is
begin
return Flag86 (Implementation_Base_Type (Id));
function Has_Xref_Entry (Id : E) return B is
begin
- return Flag182 (Implementation_Base_Type (Id));
+ return Flag182 (Id);
end Has_Xref_Entry;
function Hiding_Loop_Variable (Id : E) return E is
return Flag7 (Id);
end Is_Immediately_Visible;
+ function Is_Implementation_Defined (Id : E) return B is
+ begin
+ return Flag254 (Id);
+ end Is_Implementation_Defined;
+
function Is_Imported (Id : E) return B is
begin
return Flag24 (Id);
Set_Node13 (Id, V);
end Set_Extra_Accessibility;
+ procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is
+ begin
+ pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
+ Set_Node19 (Id, V);
+ end Set_Extra_Accessibility_Of_Result;
+
procedure Set_Extra_Constrained (Id : E; V : E) is
begin
pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
Set_Flag201 (Id, V);
end Set_Has_Anon_Block_Suffix;
+ procedure Set_Has_Anonymous_Master (Id : E; V : B := True) is
+ begin
+ pragma Assert
+ (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
+ Set_Flag253 (Id, V);
+ end Set_Has_Anonymous_Master;
+
procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
begin
pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
Set_Flag7 (Id, V);
end Set_Is_Immediately_Visible;
+ procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is
+ begin
+ Set_Flag254 (Id, V);
+ end Set_Is_Implementation_Defined;
+
procedure Set_Is_Imported (Id : E; V : B := True) is
begin
Set_Flag24 (Id, V);
Set_Uint14 (Id, No_Uint); -- Normalized_Position
end Init_Component_Location;
+ ----------------------------
+ -- Init_Object_Size_Align --
+ ----------------------------
+
+ procedure Init_Object_Size_Align (Id : E) is
+ begin
+ Set_Uint12 (Id, Uint_0); -- Esize
+ Set_Uint14 (Id, Uint_0); -- Alignment
+ end Init_Object_Size_Align;
+
---------------
-- Init_Size --
---------------
procedure Init_Size (Id : E; V : Int) is
begin
- Set_Uint12 (Id, UI_From_Int (V)); -- Esize
pragma Assert (not Is_Object (Id));
+ Set_Uint12 (Id, UI_From_Int (V)); -- Esize
Set_Uint13 (Id, UI_From_Int (V)); -- RM_Size
end Init_Size;
procedure Init_Size_Align (Id : E) is
begin
- Set_Uint12 (Id, Uint_0); -- Esize
pragma Assert (not Is_Object (Id));
+ Set_Uint12 (Id, Uint_0); -- Esize
Set_Uint13 (Id, Uint_0); -- RM_Size
Set_Uint14 (Id, Uint_0); -- Alignment
end Init_Size_Align;
- ----------------------------
- -- Init_Object_Size_Align --
- ----------------------------
-
- procedure Init_Object_Size_Align (Id : E) is
- begin
- Set_Uint12 (Id, Uint_0); -- Esize
- Set_Uint14 (Id, Uint_0); -- Alignment
- end Init_Object_Size_Align;
-
----------------------------------------------
-- Type Representation Attribute Predicates --
----------------------------------------------
if Is_Concurrent_Type (Id) then
if Present (Corresponding_Record_Type (Id)) then
return Direct_Primitive_Operations
- (Corresponding_Record_Type (Id));
+ (Corresponding_Record_Type (Id));
+
+ -- If expansion is disabled the corresponding record type is absent,
+ -- but if the type has ancestors it may have primitive operations.
+
+ elsif Is_Tagged_Type (Id) then
+ return Direct_Primitive_Operations (Id);
+
else
return No_Elist;
end if;
W ("Has_Alignment_Clause", Flag46 (Id));
W ("Has_All_Calls_Remote", Flag79 (Id));
W ("Has_Anon_Block_Suffix", Flag201 (Id));
+ W ("Has_Anonymous_Master", Flag253 (Id));
W ("Has_Atomic_Components", Flag86 (Id));
W ("Has_Biased_Representation", Flag139 (Id));
W ("Has_Completion", Flag26 (Id));
W ("Is_Hidden", Flag57 (Id));
W ("Is_Hidden_Open_Scope", Flag171 (Id));
W ("Is_Immediately_Visible", Flag7 (Id));
+ W ("Is_Implementation_Defined", Flag254 (Id));
W ("Is_Imported", Flag24 (Id));
W ("Is_Inlined", Flag11 (Id));
W ("Is_Instantiated", Flag126 (Id));
when Private_Kind =>
Write_Str ("Underlying_Full_View");
+ when E_Function | E_Operator | E_Subprogram_Type =>
+ Write_Str ("Extra_Accessibility_Of_Result");
+
when others =>
Write_Str ("Field19??");
end case;
procedure Write_Field28_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Procedure |
+ when E_Entry |
+ E_Entry_Family |
E_Function |
- E_Entry =>
+ E_Procedure |
+ E_Subprogram_Body |
+ E_Subprogram_Type =>
Write_Str ("Extra_Formals");
when E_Record_Type =>
OSDN Git Service
