1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 pragma Style_Checks
(All_Checks
);
35 -- Turn off subprogram ordering, not used for this unit
37 with Atree
; use Atree
;
38 with Namet
; use Namet
;
39 with Nlists
; use Nlists
;
40 with Sinfo
; use Sinfo
;
41 with Stand
; use Stand
;
42 with Output
; use Output
;
46 use Atree
.Unchecked_Access
;
47 -- This is one of the packages that is allowed direct untyped access to
48 -- the fields in a node, since it provides the next level abstraction
49 -- which incorporates appropriate checks.
51 ----------------------------------------------
52 -- Usage of Fields in Defining Entity Nodes --
53 ----------------------------------------------
55 -- Four of these fields are defined in Sinfo, since they in are the
56 -- base part of the node. The access routines for these fields and
57 -- the corresponding set procedures are defined in Sinfo. These fields
58 -- are present in all entities. Note that Homonym is also in the base
59 -- part of the node, but has access routines that are more properly
60 -- part of Einfo, which is why they are defined here.
67 -- Remaining fields are present only in extended nodes (i.e. entities)
69 -- The following fields are present in all entities
72 -- First_Rep_Item Node6
75 -- The usage of each field (and the entity kinds to which it applies)
76 -- depends on the particular field (see Einfo spec for details).
78 -- Associated_Node_For_Itype Node8
79 -- Dependent_Instances Elist8
80 -- Hiding_Loop_Variable Node8
81 -- Mechanism Uint8 (but returns Mechanism_Type)
82 -- Normalized_First_Bit Uint8
84 -- Class_Wide_Type Node9
85 -- Current_Value Node9
88 -- Discriminal_Link Node10
89 -- Handler_Records List10
90 -- Normalized_Position_Max Uint10
91 -- Referenced_Object Node10
93 -- Component_Bit_Offset Uint11
95 -- Entry_Component Node11
96 -- Enumeration_Pos Uint11
97 -- Generic_Homonym Node11
98 -- Protected_Body_Subprogram Node11
101 -- Barrier_Function Node12
102 -- Enumeration_Rep Uint12
104 -- Next_Inlined_Subprogram Node12
106 -- Corresponding_Equality Node13
107 -- Component_Clause Node13
108 -- Debug_Renaming_Link Node13
109 -- Elaboration_Entity Node13
110 -- Extra_Accessibility Node13
114 -- First_Optional_Parameter Node14
115 -- Normalized_Position Uint14
116 -- Shadow_Entities List14
118 -- Discriminant_Number Uint15
119 -- DT_Position Uint15
120 -- DT_Entry_Count Uint15
121 -- Entry_Bodies_Array Node15
122 -- Entry_Parameters_Type Node15
123 -- Extra_Formal Node15
124 -- Lit_Indexes Node15
125 -- Primitive_Operations Elist15
126 -- Related_Instance Node15
127 -- Scale_Value Uint15
128 -- Storage_Size_Variable Node15
129 -- String_Literal_Low_Bound Node15
130 -- Shared_Var_Read_Proc Node15
132 -- Access_Disp_Table Elist16
133 -- Cloned_Subtype Node16
135 -- Entry_Formal Node16
136 -- First_Private_Entity Node16
137 -- Lit_Strings Node16
138 -- String_Literal_Length Uint16
139 -- Unset_Reference Node16
141 -- Actual_Subtype Node17
142 -- Digits_Value Uint17
143 -- Discriminal Node17
144 -- First_Entity Node17
145 -- First_Index Node17
146 -- First_Literal Node17
149 -- Non_Limited_View Node17
154 -- Corresponding_Concurrent_Type Node18
155 -- Corresponding_Record_Type Node18
156 -- Delta_Value Ureal18
157 -- Enclosing_Scope Node18
158 -- Equivalent_Type Node18
159 -- Private_Dependents Elist18
160 -- Renamed_Entity Node18
161 -- Renamed_Object Node18
163 -- Body_Entity Node19
164 -- Corresponding_Discriminant Node19
165 -- Finalization_Chain_Entity Node19
166 -- Parent_Subtype Node19
167 -- Related_Array_Object Node19
168 -- Size_Check_Code Node19
169 -- Spec_Entity Node19
170 -- Underlying_Full_View Node19
172 -- Component_Type Node20
173 -- Default_Value Node20
174 -- Directly_Designated_Type Node20
175 -- Discriminant_Checking_Func Node20
176 -- Discriminant_Default_Value Node20
177 -- Last_Entity Node20
178 -- Register_Exception_Call Node20
179 -- Scalar_Range Node20
181 -- Accept_Address Elist21
182 -- Default_Expr_Function Node21
183 -- Discriminant_Constraint Elist21
184 -- Interface_Name Node21
185 -- Original_Array_Type Node21
186 -- Small_Value Ureal21
188 -- Associated_Storage_Pool Node22
189 -- Component_Size Uint22
190 -- Corresponding_Remote_Type Node22
191 -- Enumeration_Rep_Expr Node22
192 -- Exception_Code Uint22
193 -- Original_Record_Component Node22
194 -- Private_View Node22
195 -- Protected_Formal Node22
196 -- Scope_Depth_Value Uint22
197 -- Shared_Var_Assign_Proc Node22
199 -- Associated_Final_Chain Node23
200 -- CR_Discriminant Node23
201 -- Stored_Constraint Elist23
202 -- Entry_Cancel_Parameter Node23
203 -- Extra_Constrained Node23
204 -- Generic_Renamings Elist23
205 -- Inner_Instances Elist23
206 -- Enum_Pos_To_Rep Node23
207 -- Packed_Array_Type Node23
208 -- Limited_View Node23
209 -- Privals_Chain Elist23
210 -- Protected_Operation Node23
212 -- DT_Offset_To_Top_Func Node24
213 -- Obsolescent_Warning Node24
214 -- Task_Body_Procedure Node24
215 -- Abstract_Interfaces Elist24
217 -- Abstract_Interface_Alias Node25
218 -- Current_Use_Clause Node25
220 -- Overridden_Operation Node26
221 -- Package_Instantiation Node26
223 -- Wrapped_Entity Node27
225 ---------------------------------------------
226 -- Usage of Flags in Defining Entity Nodes --
227 ---------------------------------------------
229 -- All flags are unique, there is no overlaying, so each flag is physically
230 -- present in every entity. However, for many of the flags, it only makes
231 -- sense for them to be set true for certain subsets of entity kinds. See
232 -- the spec of Einfo for further details.
234 -- Note: Flag1-Flag3 are absent from this list, since these flag positions
235 -- are used for the flags Analyzed, Comes_From_Source, and Error_Posted,
236 -- which are common to all nodes, including entity nodes.
239 -- Has_Discriminants Flag5
240 -- Is_Dispatching_Operation Flag6
241 -- Is_Immediately_Visible Flag7
243 -- Is_Potentially_Use_Visible Flag9
247 -- Is_Constrained Flag12
248 -- Is_Generic_Type Flag13
249 -- Depends_On_Private Flag14
251 -- Is_Volatile Flag16
252 -- Is_Internal Flag17
253 -- Has_Delayed_Freeze Flag18
254 -- Is_Abstract Flag19
255 -- Is_Concurrent_Record_Type Flag20
257 -- Has_Master_Entity Flag21
258 -- Needs_No_Actuals Flag22
259 -- Has_Storage_Size_Clause Flag23
260 -- Is_Imported Flag24
261 -- Is_Limited_Record Flag25
262 -- Has_Completion Flag26
263 -- Has_Pragma_Controlled Flag27
264 -- Is_Statically_Allocated Flag28
265 -- Has_Size_Clause Flag29
268 -- Checks_May_Be_Suppressed Flag31
269 -- Kill_Elaboration_Checks Flag32
270 -- Kill_Range_Checks Flag33
271 -- Kill_Tag_Checks Flag34
272 -- Is_Class_Wide_Equivalent_Type Flag35
273 -- Referenced_As_LHS Flag36
274 -- Is_Known_Non_Null Flag37
275 -- Can_Never_Be_Null Flag38
276 -- Is_Overriding_Operation Flag39
277 -- Body_Needed_For_SAL Flag40
279 -- Treat_As_Volatile Flag41
280 -- Is_Controlled Flag42
281 -- Has_Controlled_Component Flag43
283 -- In_Private_Part Flag45
284 -- Has_Alignment_Clause Flag46
286 -- In_Package_Body Flag48
288 -- Delay_Subprogram_Descriptors Flag50
291 -- Is_Entry_Formal Flag52
292 -- Is_Private_Descendant Flag53
293 -- Return_Present Flag54
294 -- Is_Tagged_Type Flag55
295 -- Has_Homonym Flag56
297 -- Non_Binary_Modulus Flag58
298 -- Is_Preelaborated Flag59
299 -- Is_Shared_Passive Flag60
301 -- Is_Remote_Types Flag61
302 -- Is_Remote_Call_Interface Flag62
303 -- Is_Character_Type Flag63
304 -- Is_Intrinsic_Subprogram Flag64
305 -- Has_Record_Rep_Clause Flag65
306 -- Has_Enumeration_Rep_Clause Flag66
307 -- Has_Small_Clause Flag67
308 -- Has_Component_Size_Clause Flag68
309 -- Is_Access_Constant Flag69
310 -- Is_First_Subtype Flag70
312 -- Has_Completion_In_Body Flag71
313 -- Has_Unknown_Discriminants Flag72
314 -- Is_Child_Unit Flag73
315 -- Is_CPP_Class Flag74
316 -- Has_Non_Standard_Rep Flag75
317 -- Is_Constructor Flag76
318 -- Is_Thread_Body Flag77
320 -- Has_All_Calls_Remote Flag79
321 -- Is_Constr_Subt_For_U_Nominal Flag80
323 -- Is_Asynchronous Flag81
324 -- Has_Gigi_Rep_Item Flag82
325 -- Has_Machine_Radix_Clause Flag83
326 -- Machine_Radix_10 Flag84
328 -- Has_Atomic_Components Flag86
329 -- Has_Volatile_Components Flag87
330 -- Discard_Names Flag88
331 -- Is_Interrupt_Handler Flag89
332 -- Returns_By_Ref Flag90
335 -- Size_Known_At_Compile_Time Flag92
336 -- Has_Subprogram_Descriptor Flag93
337 -- Is_Generic_Actual_Type Flag94
338 -- Uses_Sec_Stack Flag95
339 -- Warnings_Off Flag96
340 -- Is_Controlling_Formal Flag97
341 -- Has_Controlling_Result Flag98
342 -- Is_Exported Flag99
343 -- Has_Specified_Layout Flag100
345 -- Has_Nested_Block_With_Handler Flag101
347 -- Is_Completely_Hidden Flag103
348 -- Address_Taken Flag104
349 -- Suppress_Init_Proc Flag105
350 -- Is_Limited_Composite Flag106
351 -- Is_Private_Composite Flag107
352 -- Default_Expressions_Processed Flag108
353 -- Is_Non_Static_Subtype Flag109
354 -- Has_External_Tag_Rep_Clause Flag110
356 -- Is_Formal_Subprogram Flag111
357 -- Is_Renaming_Of_Object Flag112
359 -- Delay_Cleanups Flag114
360 -- Never_Set_In_Source Flag115
361 -- Is_Visible_Child_Unit Flag116
362 -- Is_Unchecked_Union Flag117
363 -- Is_For_Access_Subtype Flag118
364 -- Has_Convention_Pragma Flag119
365 -- Has_Primitive_Operations Flag120
367 -- Has_Pragma_Pack Flag121
368 -- Is_Bit_Packed_Array Flag122
369 -- Has_Unchecked_Union Flag123
370 -- Is_Eliminated Flag124
371 -- C_Pass_By_Copy Flag125
372 -- Is_Instantiated Flag126
373 -- Is_Valued_Procedure Flag127
374 -- (used for Component_Alignment) Flag128
375 -- (used for Component_Alignment) Flag129
376 -- Is_Generic_Instance Flag130
378 -- No_Pool_Assigned Flag131
379 -- Is_AST_Entry Flag132
380 -- Is_VMS_Exception Flag133
381 -- Is_Optional_Parameter Flag134
382 -- Has_Aliased_Components Flag135
383 -- No_Strict_Aliasing Flag136
384 -- Is_Machine_Code_Subprogram Flag137
385 -- Is_Packed_Array_Type Flag138
386 -- Has_Biased_Representation Flag139
387 -- Has_Complex_Representation Flag140
389 -- Is_Constr_Subt_For_UN_Aliased Flag141
390 -- Has_Missing_Return Flag142
391 -- Has_Recursive_Call Flag143
392 -- Is_Unsigned_Type Flag144
393 -- Strict_Alignment Flag145
395 -- Needs_Debug_Info Flag147
396 -- Suppress_Elaboration_Warnings Flag148
397 -- Is_Compilation_Unit Flag149
398 -- Has_Pragma_Elaborate_Body Flag150
401 -- Entry_Accepted Flag152
402 -- Is_Obsolescent Flag153
403 -- Has_Per_Object_Constraint Flag154
404 -- Has_Private_Declaration Flag155
405 -- Referenced Flag156
406 -- Has_Pragma_Inline Flag157
407 -- Finalize_Storage_Only Flag158
408 -- From_With_Type Flag159
409 -- Is_Package_Body_Entity Flag160
411 -- Has_Qualified_Name Flag161
412 -- Nonzero_Is_True Flag162
413 -- Is_True_Constant Flag163
414 -- Reverse_Bit_Order Flag164
415 -- Suppress_Style_Checks Flag165
416 -- Debug_Info_Off Flag166
417 -- Sec_Stack_Needed_For_Return Flag167
418 -- Materialize_Entity Flag168
419 -- Function_Returns_With_DSP Flag169
420 -- Is_Known_Valid Flag170
422 -- Is_Hidden_Open_Scope Flag171
423 -- Has_Object_Size_Clause Flag172
424 -- Has_Fully_Qualified_Name Flag173
425 -- Elaboration_Entity_Required Flag174
426 -- Has_Forward_Instantiation Flag175
427 -- Is_Discrim_SO_Function Flag176
428 -- Size_Depends_On_Discriminant Flag177
429 -- Is_Null_Init_Proc Flag178
430 -- Has_Pragma_Pure_Function Flag179
431 -- Has_Pragma_Unreferenced Flag180
433 -- Has_Contiguous_Rep Flag181
434 -- Has_Xref_Entry Flag182
435 -- Must_Be_On_Byte_Boundary Flag183
436 -- Has_Stream_Size_Clause Flag184
437 -- Is_Ada_2005 Flag185
438 -- Is_Interface Flag186
439 -- Has_Constrained_Partial_View Flag187
440 -- Has_Persistent_BSS Flag188
441 -- Is_Pure_Unit_Access_Type Flag189
442 -- Has_Specified_Stream_Input Flag190
444 -- Has_Specified_Stream_Output Flag191
445 -- Has_Specified_Stream_Read Flag192
446 -- Has_Specified_Stream_Write Flag193
447 -- Is_Local_Anonymous_Access Flag194
448 -- Is_Primitive_Wrapper Flag195
449 -- Was_Hidden Flag196
450 -- Is_Limited_Interface Flag197
451 -- Is_Protected_Interface Flag198
452 -- Is_Synchronized_Interface Flag199
453 -- Is_Task_Interface Flag200
455 -- Has_Anon_Block_Suffix Flag201
456 -- Itype_Printed Flag202
457 -- Has_Pragma_Pure Flag203
458 -- Is_Known_Null Flag204
472 -----------------------
473 -- Local subprograms --
474 -----------------------
476 function Rep_Clause
(Id
: E
; Rep_Name
: Name_Id
) return N
;
477 -- Returns the attribute definition clause whose name is Rep_Name. Returns
478 -- Empty if not found.
484 function Rep_Clause
(Id
: E
; Rep_Name
: Name_Id
) return N
is
488 Ritem
:= First_Rep_Item
(Id
);
489 while Present
(Ritem
) loop
490 if Nkind
(Ritem
) = N_Attribute_Definition_Clause
491 and then Chars
(Ritem
) = Rep_Name
495 Ritem
:= Next_Rep_Item
(Ritem
);
502 --------------------------------
503 -- Attribute Access Functions --
504 --------------------------------
506 function Abstract_Interfaces
(Id
: E
) return L
is
509 (Ekind
(Id
) = E_Record_Type
510 or else Ekind
(Id
) = E_Record_Subtype
511 or else Ekind
(Id
) = E_Record_Type_With_Private
512 or else Ekind
(Id
) = E_Record_Subtype_With_Private
513 or else Ekind
(Id
) = E_Class_Wide_Type
);
515 end Abstract_Interfaces
;
517 function Abstract_Interface_Alias
(Id
: E
) return E
is
519 pragma Assert
(Is_Subprogram
(Id
));
521 end Abstract_Interface_Alias
;
523 function Accept_Address
(Id
: E
) return L
is
528 function Access_Disp_Table
(Id
: E
) return L
is
530 pragma Assert
(Is_Tagged_Type
(Id
));
531 return Elist16
(Implementation_Base_Type
(Id
));
532 end Access_Disp_Table
;
534 function Actual_Subtype
(Id
: E
) return E
is
537 (Ekind
(Id
) = E_Constant
538 or else Ekind
(Id
) = E_Variable
539 or else Ekind
(Id
) = E_Generic_In_Out_Parameter
540 or else Ekind
(Id
) in E_In_Parameter
.. E_In_Out_Parameter
);
544 function Address_Taken
(Id
: E
) return B
is
549 function Alias
(Id
: E
) return E
is
552 (Is_Overloadable
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
556 function Alignment
(Id
: E
) return U
is
558 pragma Assert
(Is_Type
(Id
)
559 or else Is_Formal
(Id
)
560 or else Ekind
(Id
) = E_Loop_Parameter
561 or else Ekind
(Id
) = E_Constant
562 or else Ekind
(Id
) = E_Exception
563 or else Ekind
(Id
) = E_Variable
);
567 function Associated_Final_Chain
(Id
: E
) return E
is
569 pragma Assert
(Is_Access_Type
(Id
));
571 end Associated_Final_Chain
;
573 function Associated_Formal_Package
(Id
: E
) return E
is
575 pragma Assert
(Ekind
(Id
) = E_Package
);
577 end Associated_Formal_Package
;
579 function Associated_Node_For_Itype
(Id
: E
) return N
is
582 end Associated_Node_For_Itype
;
584 function Associated_Storage_Pool
(Id
: E
) return E
is
586 pragma Assert
(Is_Access_Type
(Id
));
587 return Node22
(Root_Type
(Id
));
588 end Associated_Storage_Pool
;
590 function Barrier_Function
(Id
: E
) return N
is
592 pragma Assert
(Is_Entry
(Id
));
594 end Barrier_Function
;
596 function Block_Node
(Id
: E
) return N
is
598 pragma Assert
(Ekind
(Id
) = E_Block
);
602 function Body_Entity
(Id
: E
) return E
is
605 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
609 function Body_Needed_For_SAL
(Id
: E
) return B
is
612 (Ekind
(Id
) = E_Package
613 or else Is_Subprogram
(Id
)
614 or else Is_Generic_Unit
(Id
));
616 end Body_Needed_For_SAL
;
618 function C_Pass_By_Copy
(Id
: E
) return B
is
620 pragma Assert
(Is_Record_Type
(Id
));
621 return Flag125
(Implementation_Base_Type
(Id
));
624 function Can_Never_Be_Null
(Id
: E
) return B
is
627 end Can_Never_Be_Null
;
629 function Checks_May_Be_Suppressed
(Id
: E
) return B
is
632 end Checks_May_Be_Suppressed
;
634 function Class_Wide_Type
(Id
: E
) return E
is
636 pragma Assert
(Is_Type
(Id
));
640 function Cloned_Subtype
(Id
: E
) return E
is
643 (Ekind
(Id
) = E_Record_Subtype
644 or else Ekind
(Id
) = E_Class_Wide_Subtype
);
648 function Component_Bit_Offset
(Id
: E
) return U
is
651 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
653 end Component_Bit_Offset
;
655 function Component_Clause
(Id
: E
) return N
is
658 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
660 end Component_Clause
;
662 function Component_Size
(Id
: E
) return U
is
664 pragma Assert
(Is_Array_Type
(Id
));
665 return Uint22
(Implementation_Base_Type
(Id
));
668 function Component_Type
(Id
: E
) return E
is
670 return Node20
(Implementation_Base_Type
(Id
));
673 function Corresponding_Concurrent_Type
(Id
: E
) return E
is
675 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
677 end Corresponding_Concurrent_Type
;
679 function Corresponding_Discriminant
(Id
: E
) return E
is
681 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
683 end Corresponding_Discriminant
;
685 function Corresponding_Equality
(Id
: E
) return E
is
688 (Ekind
(Id
) = E_Function
689 and then not Comes_From_Source
(Id
)
690 and then Chars
(Id
) = Name_Op_Ne
);
692 end Corresponding_Equality
;
694 function Corresponding_Record_Type
(Id
: E
) return E
is
696 pragma Assert
(Is_Concurrent_Type
(Id
));
698 end Corresponding_Record_Type
;
700 function Corresponding_Remote_Type
(Id
: E
) return E
is
703 end Corresponding_Remote_Type
;
705 function Current_Use_Clause
(Id
: E
) return E
is
707 pragma Assert
(Ekind
(Id
) = E_Package
);
709 end Current_Use_Clause
;
711 function Current_Value
(Id
: E
) return N
is
713 pragma Assert
(Ekind
(Id
) in Object_Kind
);
717 function CR_Discriminant
(Id
: E
) return E
is
722 function Debug_Info_Off
(Id
: E
) return B
is
727 function Debug_Renaming_Link
(Id
: E
) return E
is
730 end Debug_Renaming_Link
;
732 function Default_Expr_Function
(Id
: E
) return E
is
734 pragma Assert
(Is_Formal
(Id
));
736 end Default_Expr_Function
;
738 function Default_Expressions_Processed
(Id
: E
) return B
is
741 end Default_Expressions_Processed
;
743 function Default_Value
(Id
: E
) return N
is
745 pragma Assert
(Is_Formal
(Id
));
749 function Delay_Cleanups
(Id
: E
) return B
is
754 function Delay_Subprogram_Descriptors
(Id
: E
) return B
is
757 end Delay_Subprogram_Descriptors
;
759 function Delta_Value
(Id
: E
) return R
is
761 pragma Assert
(Is_Fixed_Point_Type
(Id
));
765 function Dependent_Instances
(Id
: E
) return L
is
767 pragma Assert
(Is_Generic_Instance
(Id
));
769 end Dependent_Instances
;
771 function Depends_On_Private
(Id
: E
) return B
is
773 pragma Assert
(Nkind
(Id
) in N_Entity
);
775 end Depends_On_Private
;
777 function Digits_Value
(Id
: E
) return U
is
780 (Is_Floating_Point_Type
(Id
)
781 or else Is_Decimal_Fixed_Point_Type
(Id
));
785 function Directly_Designated_Type
(Id
: E
) return E
is
788 end Directly_Designated_Type
;
790 function Discard_Names
(Id
: E
) return B
is
795 function Discriminal
(Id
: E
) return E
is
797 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
801 function Discriminal_Link
(Id
: E
) return N
is
804 end Discriminal_Link
;
806 function Discriminant_Checking_Func
(Id
: E
) return E
is
808 pragma Assert
(Ekind
(Id
) = E_Component
);
810 end Discriminant_Checking_Func
;
812 function Discriminant_Constraint
(Id
: E
) return L
is
814 pragma Assert
(Is_Composite_Type
(Id
) and then Has_Discriminants
(Id
));
816 end Discriminant_Constraint
;
818 function Discriminant_Default_Value
(Id
: E
) return N
is
820 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
822 end Discriminant_Default_Value
;
824 function Discriminant_Number
(Id
: E
) return U
is
826 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
828 end Discriminant_Number
;
830 function DT_Entry_Count
(Id
: E
) return U
is
832 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
836 function DT_Offset_To_Top_Func
(Id
: E
) return E
is
838 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
840 end DT_Offset_To_Top_Func
;
842 function DT_Position
(Id
: E
) return U
is
845 ((Ekind
(Id
) = E_Function
846 or else Ekind
(Id
) = E_Procedure
)
847 and then Present
(DTC_Entity
(Id
)));
851 function DTC_Entity
(Id
: E
) return E
is
854 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
858 function Elaboration_Entity
(Id
: E
) return E
is
863 Ekind
(Id
) = E_Package
865 Is_Generic_Unit
(Id
));
867 end Elaboration_Entity
;
869 function Elaboration_Entity_Required
(Id
: E
) return B
is
874 Ekind
(Id
) = E_Package
876 Is_Generic_Unit
(Id
));
878 end Elaboration_Entity_Required
;
880 function Enclosing_Scope
(Id
: E
) return E
is
885 function Entry_Accepted
(Id
: E
) return B
is
887 pragma Assert
(Is_Entry
(Id
));
891 function Entry_Bodies_Array
(Id
: E
) return E
is
894 end Entry_Bodies_Array
;
896 function Entry_Cancel_Parameter
(Id
: E
) return E
is
899 end Entry_Cancel_Parameter
;
901 function Entry_Component
(Id
: E
) return E
is
906 function Entry_Formal
(Id
: E
) return E
is
911 function Entry_Index_Constant
(Id
: E
) return N
is
913 pragma Assert
(Ekind
(Id
) = E_Entry_Index_Parameter
);
915 end Entry_Index_Constant
;
917 function Entry_Parameters_Type
(Id
: E
) return E
is
920 end Entry_Parameters_Type
;
922 function Enum_Pos_To_Rep
(Id
: E
) return E
is
924 pragma Assert
(Ekind
(Id
) = E_Enumeration_Type
);
928 function Enumeration_Pos
(Id
: E
) return Uint
is
930 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
934 function Enumeration_Rep
(Id
: E
) return U
is
936 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
940 function Enumeration_Rep_Expr
(Id
: E
) return N
is
942 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
944 end Enumeration_Rep_Expr
;
946 function Equivalent_Type
(Id
: E
) return E
is
949 (Ekind
(Id
) = E_Class_Wide_Subtype
or else
950 Ekind
(Id
) = E_Access_Protected_Subprogram_Type
or else
951 Ekind
(Id
) = E_Access_Subprogram_Type
or else
952 Ekind
(Id
) = E_Exception_Type
);
956 function Esize
(Id
: E
) return Uint
is
961 function Exception_Code
(Id
: E
) return Uint
is
963 pragma Assert
(Ekind
(Id
) = E_Exception
);
967 function Extra_Accessibility
(Id
: E
) return E
is
969 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
971 end Extra_Accessibility
;
973 function Extra_Constrained
(Id
: E
) return E
is
975 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
977 end Extra_Constrained
;
979 function Extra_Formal
(Id
: E
) return E
is
984 function Finalization_Chain_Entity
(Id
: E
) return E
is
987 end Finalization_Chain_Entity
;
989 function Finalize_Storage_Only
(Id
: E
) return B
is
991 pragma Assert
(Is_Type
(Id
));
992 return Flag158
(Base_Type
(Id
));
993 end Finalize_Storage_Only
;
995 function First_Entity
(Id
: E
) return E
is
1000 function First_Index
(Id
: E
) return N
is
1005 function First_Literal
(Id
: E
) return E
is
1010 function First_Optional_Parameter
(Id
: E
) return E
is
1013 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
1015 end First_Optional_Parameter
;
1017 function First_Private_Entity
(Id
: E
) return E
is
1019 pragma Assert
(Ekind
(Id
) = E_Package
1020 or else Ekind
(Id
) = E_Generic_Package
1021 or else Ekind
(Id
) = E_Protected_Type
1022 or else Ekind
(Id
) = E_Protected_Subtype
1023 or else Ekind
(Id
) = E_Task_Type
1024 or else Ekind
(Id
) = E_Task_Subtype
);
1026 end First_Private_Entity
;
1028 function First_Rep_Item
(Id
: E
) return E
is
1033 function Freeze_Node
(Id
: E
) return N
is
1038 function From_With_Type
(Id
: E
) return B
is
1040 return Flag159
(Id
);
1043 function Full_View
(Id
: E
) return E
is
1045 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Constant
);
1049 function Function_Returns_With_DSP
(Id
: E
) return B
is
1052 (Is_Subprogram
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
1053 return Flag169
(Id
);
1054 end Function_Returns_With_DSP
;
1056 function Generic_Homonym
(Id
: E
) return E
is
1058 pragma Assert
(Ekind
(Id
) = E_Generic_Package
);
1060 end Generic_Homonym
;
1062 function Generic_Renamings
(Id
: E
) return L
is
1064 return Elist23
(Id
);
1065 end Generic_Renamings
;
1067 function Handler_Records
(Id
: E
) return S
is
1070 end Handler_Records
;
1072 function Has_Aliased_Components
(Id
: E
) return B
is
1074 return Flag135
(Implementation_Base_Type
(Id
));
1075 end Has_Aliased_Components
;
1077 function Has_Alignment_Clause
(Id
: E
) return B
is
1080 end Has_Alignment_Clause
;
1082 function Has_All_Calls_Remote
(Id
: E
) return B
is
1085 end Has_All_Calls_Remote
;
1087 function Has_Anon_Block_Suffix
(Id
: E
) return B
is
1089 return Flag201
(Id
);
1090 end Has_Anon_Block_Suffix
;
1092 function Has_Atomic_Components
(Id
: E
) return B
is
1094 return Flag86
(Implementation_Base_Type
(Id
));
1095 end Has_Atomic_Components
;
1097 function Has_Biased_Representation
(Id
: E
) return B
is
1099 return Flag139
(Id
);
1100 end Has_Biased_Representation
;
1102 function Has_Completion
(Id
: E
) return B
is
1107 function Has_Completion_In_Body
(Id
: E
) return B
is
1109 pragma Assert
(Is_Type
(Id
));
1111 end Has_Completion_In_Body
;
1113 function Has_Complex_Representation
(Id
: E
) return B
is
1115 pragma Assert
(Is_Type
(Id
));
1116 return Flag140
(Implementation_Base_Type
(Id
));
1117 end Has_Complex_Representation
;
1119 function Has_Component_Size_Clause
(Id
: E
) return B
is
1121 pragma Assert
(Is_Array_Type
(Id
));
1122 return Flag68
(Implementation_Base_Type
(Id
));
1123 end Has_Component_Size_Clause
;
1125 function Has_Constrained_Partial_View
(Id
: E
) return B
is
1127 pragma Assert
(Is_Type
(Id
));
1128 return Flag187
(Id
);
1129 end Has_Constrained_Partial_View
;
1131 function Has_Controlled_Component
(Id
: E
) return B
is
1133 return Flag43
(Base_Type
(Id
));
1134 end Has_Controlled_Component
;
1136 function Has_Contiguous_Rep
(Id
: E
) return B
is
1138 return Flag181
(Id
);
1139 end Has_Contiguous_Rep
;
1141 function Has_Controlling_Result
(Id
: E
) return B
is
1144 end Has_Controlling_Result
;
1146 function Has_Convention_Pragma
(Id
: E
) return B
is
1148 return Flag119
(Id
);
1149 end Has_Convention_Pragma
;
1151 function Has_Delayed_Freeze
(Id
: E
) return B
is
1153 pragma Assert
(Nkind
(Id
) in N_Entity
);
1155 end Has_Delayed_Freeze
;
1157 function Has_Discriminants
(Id
: E
) return B
is
1159 pragma Assert
(Nkind
(Id
) in N_Entity
);
1161 end Has_Discriminants
;
1163 function Has_Enumeration_Rep_Clause
(Id
: E
) return B
is
1165 pragma Assert
(Is_Enumeration_Type
(Id
));
1167 end Has_Enumeration_Rep_Clause
;
1169 function Has_Exit
(Id
: E
) return B
is
1174 function Has_External_Tag_Rep_Clause
(Id
: E
) return B
is
1176 pragma Assert
(Is_Tagged_Type
(Id
));
1177 return Flag110
(Id
);
1178 end Has_External_Tag_Rep_Clause
;
1180 function Has_Forward_Instantiation
(Id
: E
) return B
is
1182 return Flag175
(Id
);
1183 end Has_Forward_Instantiation
;
1185 function Has_Fully_Qualified_Name
(Id
: E
) return B
is
1187 return Flag173
(Id
);
1188 end Has_Fully_Qualified_Name
;
1190 function Has_Gigi_Rep_Item
(Id
: E
) return B
is
1193 end Has_Gigi_Rep_Item
;
1195 function Has_Homonym
(Id
: E
) return B
is
1200 function Has_Machine_Radix_Clause
(Id
: E
) return B
is
1202 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
1204 end Has_Machine_Radix_Clause
;
1206 function Has_Master_Entity
(Id
: E
) return B
is
1209 end Has_Master_Entity
;
1211 function Has_Missing_Return
(Id
: E
) return B
is
1214 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Generic_Function
);
1215 return Flag142
(Id
);
1216 end Has_Missing_Return
;
1218 function Has_Nested_Block_With_Handler
(Id
: E
) return B
is
1220 return Flag101
(Id
);
1221 end Has_Nested_Block_With_Handler
;
1223 function Has_Non_Standard_Rep
(Id
: E
) return B
is
1225 return Flag75
(Implementation_Base_Type
(Id
));
1226 end Has_Non_Standard_Rep
;
1228 function Has_Object_Size_Clause
(Id
: E
) return B
is
1230 pragma Assert
(Is_Type
(Id
));
1231 return Flag172
(Id
);
1232 end Has_Object_Size_Clause
;
1234 function Has_Per_Object_Constraint
(Id
: E
) return B
is
1236 return Flag154
(Id
);
1237 end Has_Per_Object_Constraint
;
1239 function Has_Persistent_BSS
(Id
: E
) return B
is
1241 return Flag188
(Id
);
1242 end Has_Persistent_BSS
;
1244 function Has_Pragma_Controlled
(Id
: E
) return B
is
1246 pragma Assert
(Is_Access_Type
(Id
));
1247 return Flag27
(Implementation_Base_Type
(Id
));
1248 end Has_Pragma_Controlled
;
1250 function Has_Pragma_Elaborate_Body
(Id
: E
) return B
is
1252 return Flag150
(Id
);
1253 end Has_Pragma_Elaborate_Body
;
1255 function Has_Pragma_Inline
(Id
: E
) return B
is
1257 return Flag157
(Id
);
1258 end Has_Pragma_Inline
;
1260 function Has_Pragma_Pack
(Id
: E
) return B
is
1262 pragma Assert
(Is_Record_Type
(Id
) or else Is_Array_Type
(Id
));
1263 return Flag121
(Implementation_Base_Type
(Id
));
1264 end Has_Pragma_Pack
;
1266 function Has_Pragma_Pure
(Id
: E
) return B
is
1268 return Flag203
(Id
);
1269 end Has_Pragma_Pure
;
1271 function Has_Pragma_Pure_Function
(Id
: E
) return B
is
1273 return Flag179
(Id
);
1274 end Has_Pragma_Pure_Function
;
1276 function Has_Pragma_Unreferenced
(Id
: E
) return B
is
1278 return Flag180
(Id
);
1279 end Has_Pragma_Unreferenced
;
1281 function Has_Primitive_Operations
(Id
: E
) return B
is
1283 pragma Assert
(Is_Type
(Id
));
1284 return Flag120
(Base_Type
(Id
));
1285 end Has_Primitive_Operations
;
1287 function Has_Private_Declaration
(Id
: E
) return B
is
1289 return Flag155
(Id
);
1290 end Has_Private_Declaration
;
1292 function Has_Qualified_Name
(Id
: E
) return B
is
1294 return Flag161
(Id
);
1295 end Has_Qualified_Name
;
1297 function Has_Record_Rep_Clause
(Id
: E
) return B
is
1299 pragma Assert
(Is_Record_Type
(Id
));
1300 return Flag65
(Implementation_Base_Type
(Id
));
1301 end Has_Record_Rep_Clause
;
1303 function Has_Recursive_Call
(Id
: E
) return B
is
1305 pragma Assert
(Is_Subprogram
(Id
));
1306 return Flag143
(Id
);
1307 end Has_Recursive_Call
;
1309 function Has_Size_Clause
(Id
: E
) return B
is
1312 end Has_Size_Clause
;
1314 function Has_Small_Clause
(Id
: E
) return B
is
1317 end Has_Small_Clause
;
1319 function Has_Specified_Layout
(Id
: E
) return B
is
1321 pragma Assert
(Is_Type
(Id
));
1322 return Flag100
(Implementation_Base_Type
(Id
));
1323 end Has_Specified_Layout
;
1325 function Has_Specified_Stream_Input
(Id
: E
) return B
is
1327 pragma Assert
(Is_Type
(Id
));
1328 return Flag190
(Id
);
1329 end Has_Specified_Stream_Input
;
1331 function Has_Specified_Stream_Output
(Id
: E
) return B
is
1333 pragma Assert
(Is_Type
(Id
));
1334 return Flag191
(Id
);
1335 end Has_Specified_Stream_Output
;
1337 function Has_Specified_Stream_Read
(Id
: E
) return B
is
1339 pragma Assert
(Is_Type
(Id
));
1340 return Flag192
(Id
);
1341 end Has_Specified_Stream_Read
;
1343 function Has_Specified_Stream_Write
(Id
: E
) return B
is
1345 pragma Assert
(Is_Type
(Id
));
1346 return Flag193
(Id
);
1347 end Has_Specified_Stream_Write
;
1349 function Has_Storage_Size_Clause
(Id
: E
) return B
is
1351 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
1352 return Flag23
(Implementation_Base_Type
(Id
));
1353 end Has_Storage_Size_Clause
;
1355 function Has_Stream_Size_Clause
(Id
: E
) return B
is
1357 pragma Assert
(Is_Elementary_Type
(Id
));
1358 return Flag184
(Id
);
1359 end Has_Stream_Size_Clause
;
1361 function Has_Subprogram_Descriptor
(Id
: E
) return B
is
1364 end Has_Subprogram_Descriptor
;
1366 function Has_Task
(Id
: E
) return B
is
1368 return Flag30
(Base_Type
(Id
));
1371 function Has_Unchecked_Union
(Id
: E
) return B
is
1373 return Flag123
(Base_Type
(Id
));
1374 end Has_Unchecked_Union
;
1376 function Has_Unknown_Discriminants
(Id
: E
) return B
is
1378 pragma Assert
(Is_Type
(Id
));
1380 end Has_Unknown_Discriminants
;
1382 function Has_Volatile_Components
(Id
: E
) return B
is
1384 return Flag87
(Implementation_Base_Type
(Id
));
1385 end Has_Volatile_Components
;
1387 function Has_Xref_Entry
(Id
: E
) return B
is
1389 return Flag182
(Implementation_Base_Type
(Id
));
1392 function Hiding_Loop_Variable
(Id
: E
) return E
is
1394 pragma Assert
(Ekind
(Id
) = E_Variable
);
1396 end Hiding_Loop_Variable
;
1398 function Homonym
(Id
: E
) return E
is
1403 function In_Package_Body
(Id
: E
) return B
is
1406 end In_Package_Body
;
1408 function In_Private_Part
(Id
: E
) return B
is
1411 end In_Private_Part
;
1413 function In_Use
(Id
: E
) return B
is
1415 pragma Assert
(Nkind
(Id
) in N_Entity
);
1419 function Inner_Instances
(Id
: E
) return L
is
1421 return Elist23
(Id
);
1422 end Inner_Instances
;
1424 function Interface_Name
(Id
: E
) return N
is
1429 function Is_Abstract
(Id
: E
) return B
is
1434 function Is_Local_Anonymous_Access
(Id
: E
) return B
is
1436 pragma Assert
(Is_Access_Type
(Id
));
1437 return Flag194
(Id
);
1438 end Is_Local_Anonymous_Access
;
1440 function Is_Access_Constant
(Id
: E
) return B
is
1442 pragma Assert
(Is_Access_Type
(Id
));
1444 end Is_Access_Constant
;
1446 function Is_Ada_2005
(Id
: E
) return B
is
1448 return Flag185
(Id
);
1451 function Is_Aliased
(Id
: E
) return B
is
1453 pragma Assert
(Nkind
(Id
) in N_Entity
);
1457 function Is_AST_Entry
(Id
: E
) return B
is
1459 pragma Assert
(Is_Entry
(Id
));
1460 return Flag132
(Id
);
1463 function Is_Asynchronous
(Id
: E
) return B
is
1466 (Ekind
(Id
) = E_Procedure
or else Is_Type
(Id
));
1468 end Is_Asynchronous
;
1470 function Is_Atomic
(Id
: E
) return B
is
1475 function Is_Bit_Packed_Array
(Id
: E
) return B
is
1477 return Flag122
(Implementation_Base_Type
(Id
));
1478 end Is_Bit_Packed_Array
;
1480 function Is_Called
(Id
: E
) return B
is
1483 (Ekind
(Id
) = E_Procedure
or else Ekind
(Id
) = E_Function
);
1484 return Flag102
(Id
);
1487 function Is_Character_Type
(Id
: E
) return B
is
1490 end Is_Character_Type
;
1492 function Is_Child_Unit
(Id
: E
) return B
is
1497 function Is_Class_Wide_Equivalent_Type
(Id
: E
) return B
is
1500 end Is_Class_Wide_Equivalent_Type
;
1502 function Is_Compilation_Unit
(Id
: E
) return B
is
1504 return Flag149
(Id
);
1505 end Is_Compilation_Unit
;
1507 function Is_Completely_Hidden
(Id
: E
) return B
is
1509 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
1510 return Flag103
(Id
);
1511 end Is_Completely_Hidden
;
1513 function Is_Constr_Subt_For_U_Nominal
(Id
: E
) return B
is
1516 end Is_Constr_Subt_For_U_Nominal
;
1518 function Is_Constr_Subt_For_UN_Aliased
(Id
: E
) return B
is
1520 return Flag141
(Id
);
1521 end Is_Constr_Subt_For_UN_Aliased
;
1523 function Is_Constrained
(Id
: E
) return B
is
1525 pragma Assert
(Nkind
(Id
) in N_Entity
);
1529 function Is_Constructor
(Id
: E
) return B
is
1534 function Is_Controlled
(Id
: E
) return B
is
1536 return Flag42
(Base_Type
(Id
));
1539 function Is_Controlling_Formal
(Id
: E
) return B
is
1541 pragma Assert
(Is_Formal
(Id
));
1543 end Is_Controlling_Formal
;
1545 function Is_CPP_Class
(Id
: E
) return B
is
1550 function Is_Discrim_SO_Function
(Id
: E
) return B
is
1552 return Flag176
(Id
);
1553 end Is_Discrim_SO_Function
;
1555 function Is_Dispatching_Operation
(Id
: E
) return B
is
1557 pragma Assert
(Nkind
(Id
) in N_Entity
);
1559 end Is_Dispatching_Operation
;
1561 function Is_Eliminated
(Id
: E
) return B
is
1563 return Flag124
(Id
);
1566 function Is_Entry_Formal
(Id
: E
) return B
is
1569 end Is_Entry_Formal
;
1571 function Is_Exported
(Id
: E
) return B
is
1576 function Is_First_Subtype
(Id
: E
) return B
is
1579 end Is_First_Subtype
;
1581 function Is_For_Access_Subtype
(Id
: E
) return B
is
1584 (Ekind
(Id
) = E_Record_Subtype
1586 Ekind
(Id
) = E_Private_Subtype
);
1587 return Flag118
(Id
);
1588 end Is_For_Access_Subtype
;
1590 function Is_Formal_Subprogram
(Id
: E
) return B
is
1592 return Flag111
(Id
);
1593 end Is_Formal_Subprogram
;
1595 function Is_Frozen
(Id
: E
) return B
is
1600 function Is_Generic_Actual_Type
(Id
: E
) return B
is
1602 pragma Assert
(Is_Type
(Id
));
1604 end Is_Generic_Actual_Type
;
1606 function Is_Generic_Instance
(Id
: E
) return B
is
1608 return Flag130
(Id
);
1609 end Is_Generic_Instance
;
1611 function Is_Generic_Type
(Id
: E
) return B
is
1613 pragma Assert
(Nkind
(Id
) in N_Entity
);
1615 end Is_Generic_Type
;
1617 function Is_Hidden
(Id
: E
) return B
is
1622 function Is_Hidden_Open_Scope
(Id
: E
) return B
is
1624 return Flag171
(Id
);
1625 end Is_Hidden_Open_Scope
;
1627 function Is_Immediately_Visible
(Id
: E
) return B
is
1629 pragma Assert
(Nkind
(Id
) in N_Entity
);
1631 end Is_Immediately_Visible
;
1633 function Is_Imported
(Id
: E
) return B
is
1638 function Is_Inlined
(Id
: E
) return B
is
1643 function Is_Interface
(Id
: E
) return B
is
1645 return Flag186
(Id
);
1648 function Is_Instantiated
(Id
: E
) return B
is
1650 return Flag126
(Id
);
1651 end Is_Instantiated
;
1653 function Is_Internal
(Id
: E
) return B
is
1655 pragma Assert
(Nkind
(Id
) in N_Entity
);
1659 function Is_Interrupt_Handler
(Id
: E
) return B
is
1661 pragma Assert
(Nkind
(Id
) in N_Entity
);
1663 end Is_Interrupt_Handler
;
1665 function Is_Intrinsic_Subprogram
(Id
: E
) return B
is
1668 end Is_Intrinsic_Subprogram
;
1670 function Is_Itype
(Id
: E
) return B
is
1675 function Is_Known_Non_Null
(Id
: E
) return B
is
1678 end Is_Known_Non_Null
;
1680 function Is_Known_Null
(Id
: E
) return B
is
1682 return Flag204
(Id
);
1685 function Is_Known_Valid
(Id
: E
) return B
is
1687 return Flag170
(Id
);
1690 function Is_Limited_Composite
(Id
: E
) return B
is
1692 return Flag106
(Id
);
1693 end Is_Limited_Composite
;
1695 function Is_Limited_Interface
(Id
: E
) return B
is
1697 pragma Assert
(Is_Interface
(Id
));
1698 return Flag197
(Id
);
1699 end Is_Limited_Interface
;
1701 function Is_Limited_Record
(Id
: E
) return B
is
1704 end Is_Limited_Record
;
1706 function Is_Machine_Code_Subprogram
(Id
: E
) return B
is
1708 pragma Assert
(Is_Subprogram
(Id
));
1709 return Flag137
(Id
);
1710 end Is_Machine_Code_Subprogram
;
1712 function Is_Non_Static_Subtype
(Id
: E
) return B
is
1714 pragma Assert
(Is_Type
(Id
));
1715 return Flag109
(Id
);
1716 end Is_Non_Static_Subtype
;
1718 function Is_Null_Init_Proc
(Id
: E
) return B
is
1720 pragma Assert
(Ekind
(Id
) = E_Procedure
);
1721 return Flag178
(Id
);
1722 end Is_Null_Init_Proc
;
1724 function Is_Obsolescent
(Id
: E
) return B
is
1726 return Flag153
(Id
);
1729 function Is_Optional_Parameter
(Id
: E
) return B
is
1731 pragma Assert
(Is_Formal
(Id
));
1732 return Flag134
(Id
);
1733 end Is_Optional_Parameter
;
1735 function Is_Overriding_Operation
(Id
: E
) return B
is
1737 pragma Assert
(Is_Subprogram
(Id
));
1739 end Is_Overriding_Operation
;
1741 function Is_Package_Body_Entity
(Id
: E
) return B
is
1743 return Flag160
(Id
);
1744 end Is_Package_Body_Entity
;
1746 function Is_Packed
(Id
: E
) return B
is
1748 return Flag51
(Implementation_Base_Type
(Id
));
1751 function Is_Packed_Array_Type
(Id
: E
) return B
is
1753 return Flag138
(Id
);
1754 end Is_Packed_Array_Type
;
1756 function Is_Potentially_Use_Visible
(Id
: E
) return B
is
1758 pragma Assert
(Nkind
(Id
) in N_Entity
);
1760 end Is_Potentially_Use_Visible
;
1762 function Is_Preelaborated
(Id
: E
) return B
is
1765 end Is_Preelaborated
;
1767 function Is_Primitive_Wrapper
(Id
: E
) return B
is
1769 pragma Assert
(Ekind
(Id
) = E_Procedure
);
1770 return Flag195
(Id
);
1771 end Is_Primitive_Wrapper
;
1773 function Is_Private_Composite
(Id
: E
) return B
is
1775 pragma Assert
(Is_Type
(Id
));
1776 return Flag107
(Id
);
1777 end Is_Private_Composite
;
1779 function Is_Private_Descendant
(Id
: E
) return B
is
1782 end Is_Private_Descendant
;
1784 function Is_Protected_Interface
(Id
: E
) return B
is
1786 pragma Assert
(Is_Interface
(Id
));
1787 return Flag198
(Id
);
1788 end Is_Protected_Interface
;
1790 function Is_Public
(Id
: E
) return B
is
1792 pragma Assert
(Nkind
(Id
) in N_Entity
);
1796 function Is_Pure
(Id
: E
) return B
is
1801 function Is_Pure_Unit_Access_Type
(Id
: E
) return B
is
1803 pragma Assert
(Is_Access_Type
(Id
));
1804 return Flag189
(Id
);
1805 end Is_Pure_Unit_Access_Type
;
1807 function Is_Remote_Call_Interface
(Id
: E
) return B
is
1810 end Is_Remote_Call_Interface
;
1812 function Is_Remote_Types
(Id
: E
) return B
is
1815 end Is_Remote_Types
;
1817 function Is_Renaming_Of_Object
(Id
: E
) return B
is
1819 return Flag112
(Id
);
1820 end Is_Renaming_Of_Object
;
1822 function Is_Shared_Passive
(Id
: E
) return B
is
1825 end Is_Shared_Passive
;
1827 function Is_Statically_Allocated
(Id
: E
) return B
is
1830 end Is_Statically_Allocated
;
1832 function Is_Synchronized_Interface
(Id
: E
) return B
is
1834 pragma Assert
(Is_Interface
(Id
));
1835 return Flag199
(Id
);
1836 end Is_Synchronized_Interface
;
1838 function Is_Tag
(Id
: E
) return B
is
1840 pragma Assert
(Nkind
(Id
) in N_Entity
);
1844 function Is_Tagged_Type
(Id
: E
) return B
is
1849 function Is_Task_Interface
(Id
: E
) return B
is
1851 pragma Assert
(Is_Interface
(Id
));
1852 return Flag200
(Id
);
1853 end Is_Task_Interface
;
1855 function Is_Thread_Body
(Id
: E
) return B
is
1860 function Is_True_Constant
(Id
: E
) return B
is
1862 return Flag163
(Id
);
1863 end Is_True_Constant
;
1865 function Is_Unchecked_Union
(Id
: E
) return B
is
1867 return Flag117
(Implementation_Base_Type
(Id
));
1868 end Is_Unchecked_Union
;
1870 function Is_Unsigned_Type
(Id
: E
) return B
is
1872 pragma Assert
(Is_Type
(Id
));
1873 return Flag144
(Id
);
1874 end Is_Unsigned_Type
;
1876 function Is_Valued_Procedure
(Id
: E
) return B
is
1878 pragma Assert
(Ekind
(Id
) = E_Procedure
);
1879 return Flag127
(Id
);
1880 end Is_Valued_Procedure
;
1882 function Is_Visible_Child_Unit
(Id
: E
) return B
is
1884 pragma Assert
(Is_Child_Unit
(Id
));
1885 return Flag116
(Id
);
1886 end Is_Visible_Child_Unit
;
1888 function Is_VMS_Exception
(Id
: E
) return B
is
1890 return Flag133
(Id
);
1891 end Is_VMS_Exception
;
1893 function Is_Volatile
(Id
: E
) return B
is
1895 pragma Assert
(Nkind
(Id
) in N_Entity
);
1897 if Is_Type
(Id
) then
1898 return Flag16
(Base_Type
(Id
));
1904 function Itype_Printed
(Id
: E
) return B
is
1906 pragma Assert
(Is_Itype
(Id
));
1907 return Flag202
(Id
);
1910 function Kill_Elaboration_Checks
(Id
: E
) return B
is
1913 end Kill_Elaboration_Checks
;
1915 function Kill_Range_Checks
(Id
: E
) return B
is
1918 end Kill_Range_Checks
;
1920 function Kill_Tag_Checks
(Id
: E
) return B
is
1923 end Kill_Tag_Checks
;
1925 function Last_Entity
(Id
: E
) return E
is
1930 function Limited_View
(Id
: E
) return E
is
1932 pragma Assert
(Ekind
(Id
) = E_Package
);
1936 function Lit_Indexes
(Id
: E
) return E
is
1938 pragma Assert
(Is_Enumeration_Type
(Id
));
1942 function Lit_Strings
(Id
: E
) return E
is
1944 pragma Assert
(Is_Enumeration_Type
(Id
));
1948 function Machine_Radix_10
(Id
: E
) return B
is
1950 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
1952 end Machine_Radix_10
;
1954 function Master_Id
(Id
: E
) return E
is
1959 function Materialize_Entity
(Id
: E
) return B
is
1961 return Flag168
(Id
);
1962 end Materialize_Entity
;
1964 function Mechanism
(Id
: E
) return M
is
1966 pragma Assert
(Ekind
(Id
) = E_Function
or else Is_Formal
(Id
));
1967 return UI_To_Int
(Uint8
(Id
));
1970 function Modulus
(Id
: E
) return Uint
is
1972 pragma Assert
(Is_Modular_Integer_Type
(Id
));
1973 return Uint17
(Base_Type
(Id
));
1976 function Must_Be_On_Byte_Boundary
(Id
: E
) return B
is
1978 pragma Assert
(Is_Type
(Id
));
1979 return Flag183
(Id
);
1980 end Must_Be_On_Byte_Boundary
;
1982 function Needs_Debug_Info
(Id
: E
) return B
is
1984 return Flag147
(Id
);
1985 end Needs_Debug_Info
;
1987 function Needs_No_Actuals
(Id
: E
) return B
is
1990 (Is_Overloadable
(Id
)
1991 or else Ekind
(Id
) = E_Subprogram_Type
1992 or else Ekind
(Id
) = E_Entry_Family
);
1994 end Needs_No_Actuals
;
1996 function Never_Set_In_Source
(Id
: E
) return B
is
1998 return Flag115
(Id
);
1999 end Never_Set_In_Source
;
2001 function Next_Inlined_Subprogram
(Id
: E
) return E
is
2004 end Next_Inlined_Subprogram
;
2006 function No_Pool_Assigned
(Id
: E
) return B
is
2008 pragma Assert
(Is_Access_Type
(Id
));
2009 return Flag131
(Root_Type
(Id
));
2010 end No_Pool_Assigned
;
2012 function No_Return
(Id
: E
) return B
is
2014 return Flag113
(Id
);
2017 function No_Strict_Aliasing
(Id
: E
) return B
is
2019 pragma Assert
(Is_Access_Type
(Id
));
2020 return Flag136
(Base_Type
(Id
));
2021 end No_Strict_Aliasing
;
2023 function Non_Binary_Modulus
(Id
: E
) return B
is
2025 pragma Assert
(Is_Modular_Integer_Type
(Id
));
2026 return Flag58
(Base_Type
(Id
));
2027 end Non_Binary_Modulus
;
2029 function Non_Limited_View
(Id
: E
) return E
is
2031 pragma Assert
(False
2032 or else Ekind
(Id
) = E_Incomplete_Type
);
2034 end Non_Limited_View
;
2036 function Nonzero_Is_True
(Id
: E
) return B
is
2038 pragma Assert
(Root_Type
(Id
) = Standard_Boolean
);
2039 return Flag162
(Base_Type
(Id
));
2040 end Nonzero_Is_True
;
2042 function Normalized_First_Bit
(Id
: E
) return U
is
2045 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2047 end Normalized_First_Bit
;
2049 function Normalized_Position
(Id
: E
) return U
is
2052 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2054 end Normalized_Position
;
2056 function Normalized_Position_Max
(Id
: E
) return U
is
2059 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2061 end Normalized_Position_Max
;
2063 function Object_Ref
(Id
: E
) return E
is
2065 pragma Assert
(Ekind
(Id
) = E_Protected_Body
);
2069 function Obsolescent_Warning
(Id
: E
) return N
is
2072 (Is_Subprogram
(Id
) or else Is_Package_Or_Generic_Package
(Id
));
2074 end Obsolescent_Warning
;
2076 function Original_Access_Type
(Id
: E
) return E
is
2079 (Ekind
(Id
) = E_Access_Subprogram_Type
2080 or else Ekind
(Id
) = E_Access_Protected_Subprogram_Type
);
2082 end Original_Access_Type
;
2084 function Original_Array_Type
(Id
: E
) return E
is
2086 pragma Assert
(Is_Array_Type
(Id
) or else Is_Modular_Integer_Type
(Id
));
2088 end Original_Array_Type
;
2090 function Original_Record_Component
(Id
: E
) return E
is
2093 (Ekind
(Id
) = E_Void
2094 or else Ekind
(Id
) = E_Component
2095 or else Ekind
(Id
) = E_Discriminant
);
2097 end Original_Record_Component
;
2099 function Overridden_Operation
(Id
: E
) return E
is
2102 end Overridden_Operation
;
2104 function Package_Instantiation
(Id
: E
) return N
is
2108 or else Ekind
(Id
) = E_Generic_Package
2109 or else Ekind
(Id
) = E_Package
);
2111 end Package_Instantiation
;
2113 function Packed_Array_Type
(Id
: E
) return E
is
2115 pragma Assert
(Is_Array_Type
(Id
));
2117 end Packed_Array_Type
;
2119 function Parent_Subtype
(Id
: E
) return E
is
2121 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
2125 function Primitive_Operations
(Id
: E
) return L
is
2127 pragma Assert
(Is_Tagged_Type
(Id
));
2128 return Elist15
(Id
);
2129 end Primitive_Operations
;
2131 function Prival
(Id
: E
) return E
is
2133 pragma Assert
(Is_Protected_Private
(Id
));
2137 function Privals_Chain
(Id
: E
) return L
is
2139 pragma Assert
(Is_Overloadable
(Id
)
2140 or else Ekind
(Id
) = E_Entry_Family
);
2141 return Elist23
(Id
);
2144 function Private_Dependents
(Id
: E
) return L
is
2146 pragma Assert
(Is_Incomplete_Or_Private_Type
(Id
));
2147 return Elist18
(Id
);
2148 end Private_Dependents
;
2150 function Private_View
(Id
: E
) return N
is
2152 pragma Assert
(Is_Private_Type
(Id
));
2156 function Protected_Body_Subprogram
(Id
: E
) return E
is
2158 pragma Assert
(Is_Subprogram
(Id
) or else Is_Entry
(Id
));
2160 end Protected_Body_Subprogram
;
2162 function Protected_Formal
(Id
: E
) return E
is
2164 pragma Assert
(Is_Formal
(Id
));
2166 end Protected_Formal
;
2168 function Protected_Operation
(Id
: E
) return N
is
2170 pragma Assert
(Is_Protected_Private
(Id
));
2172 end Protected_Operation
;
2174 function Reachable
(Id
: E
) return B
is
2179 function Referenced
(Id
: E
) return B
is
2181 return Flag156
(Id
);
2184 function Referenced_As_LHS
(Id
: E
) return B
is
2187 end Referenced_As_LHS
;
2189 function Referenced_Object
(Id
: E
) return N
is
2191 pragma Assert
(Is_Type
(Id
));
2193 end Referenced_Object
;
2195 function Register_Exception_Call
(Id
: E
) return N
is
2197 pragma Assert
(Ekind
(Id
) = E_Exception
);
2199 end Register_Exception_Call
;
2201 function Related_Array_Object
(Id
: E
) return E
is
2203 pragma Assert
(Is_Array_Type
(Id
));
2205 end Related_Array_Object
;
2207 function Related_Instance
(Id
: E
) return E
is
2210 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Package_Body
);
2212 end Related_Instance
;
2214 function Renamed_Entity
(Id
: E
) return N
is
2219 function Renamed_Object
(Id
: E
) return N
is
2224 function Renaming_Map
(Id
: E
) return U
is
2229 function Return_Present
(Id
: E
) return B
is
2234 function Returns_By_Ref
(Id
: E
) return B
is
2239 function Reverse_Bit_Order
(Id
: E
) return B
is
2241 pragma Assert
(Is_Record_Type
(Id
));
2242 return Flag164
(Base_Type
(Id
));
2243 end Reverse_Bit_Order
;
2245 function RM_Size
(Id
: E
) return U
is
2247 pragma Assert
(Is_Type
(Id
));
2251 function Scalar_Range
(Id
: E
) return N
is
2256 function Scale_Value
(Id
: E
) return U
is
2261 function Scope_Depth_Value
(Id
: E
) return U
is
2264 end Scope_Depth_Value
;
2266 function Sec_Stack_Needed_For_Return
(Id
: E
) return B
is
2268 return Flag167
(Id
);
2269 end Sec_Stack_Needed_For_Return
;
2271 function Shadow_Entities
(Id
: E
) return S
is
2274 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
2276 end Shadow_Entities
;
2278 function Shared_Var_Assign_Proc
(Id
: E
) return E
is
2280 pragma Assert
(Ekind
(Id
) = E_Variable
);
2282 end Shared_Var_Assign_Proc
;
2284 function Shared_Var_Read_Proc
(Id
: E
) return E
is
2286 pragma Assert
(Ekind
(Id
) = E_Variable
);
2288 end Shared_Var_Read_Proc
;
2290 function Size_Check_Code
(Id
: E
) return N
is
2292 pragma Assert
(Ekind
(Id
) = E_Constant
or else Ekind
(Id
) = E_Variable
);
2294 end Size_Check_Code
;
2296 function Size_Depends_On_Discriminant
(Id
: E
) return B
is
2298 return Flag177
(Id
);
2299 end Size_Depends_On_Discriminant
;
2301 function Size_Known_At_Compile_Time
(Id
: E
) return B
is
2304 end Size_Known_At_Compile_Time
;
2306 function Small_Value
(Id
: E
) return R
is
2308 pragma Assert
(Is_Fixed_Point_Type
(Id
));
2309 return Ureal21
(Id
);
2312 function Spec_Entity
(Id
: E
) return E
is
2315 (Ekind
(Id
) = E_Package_Body
or else Is_Formal
(Id
));
2319 function Storage_Size_Variable
(Id
: E
) return E
is
2321 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
2322 return Node15
(Implementation_Base_Type
(Id
));
2323 end Storage_Size_Variable
;
2325 function Stored_Constraint
(Id
: E
) return L
is
2328 (Is_Composite_Type
(Id
) and then not Is_Array_Type
(Id
));
2329 return Elist23
(Id
);
2330 end Stored_Constraint
;
2332 function Strict_Alignment
(Id
: E
) return B
is
2334 return Flag145
(Implementation_Base_Type
(Id
));
2335 end Strict_Alignment
;
2337 function String_Literal_Length
(Id
: E
) return U
is
2340 end String_Literal_Length
;
2342 function String_Literal_Low_Bound
(Id
: E
) return N
is
2345 end String_Literal_Low_Bound
;
2347 function Suppress_Elaboration_Warnings
(Id
: E
) return B
is
2349 return Flag148
(Id
);
2350 end Suppress_Elaboration_Warnings
;
2352 function Suppress_Init_Proc
(Id
: E
) return B
is
2354 return Flag105
(Base_Type
(Id
));
2355 end Suppress_Init_Proc
;
2357 function Suppress_Style_Checks
(Id
: E
) return B
is
2359 return Flag165
(Id
);
2360 end Suppress_Style_Checks
;
2362 function Task_Body_Procedure
(Id
: E
) return N
is
2364 pragma Assert
(Ekind
(Id
) = E_Task_Type
2365 or else Ekind
(Id
) = E_Task_Subtype
);
2367 end Task_Body_Procedure
;
2369 function Treat_As_Volatile
(Id
: E
) return B
is
2372 end Treat_As_Volatile
;
2374 function Underlying_Full_View
(Id
: E
) return E
is
2376 pragma Assert
(Ekind
(Id
) in Private_Kind
);
2378 end Underlying_Full_View
;
2380 function Unset_Reference
(Id
: E
) return N
is
2383 end Unset_Reference
;
2385 function Uses_Sec_Stack
(Id
: E
) return B
is
2390 function Vax_Float
(Id
: E
) return B
is
2392 return Flag151
(Base_Type
(Id
));
2395 function Warnings_Off
(Id
: E
) return B
is
2400 function Wrapped_Entity
(Id
: E
) return E
is
2402 pragma Assert
(Ekind
(Id
) = E_Procedure
2403 and then Is_Primitive_Wrapper
(Id
));
2407 function Was_Hidden
(Id
: E
) return B
is
2409 return Flag196
(Id
);
2412 ------------------------------
2413 -- Classification Functions --
2414 ------------------------------
2416 function Is_Access_Type
(Id
: E
) return B
is
2418 return Ekind
(Id
) in Access_Kind
;
2421 function Is_Array_Type
(Id
: E
) return B
is
2423 return Ekind
(Id
) in Array_Kind
;
2426 function Is_Class_Wide_Type
(Id
: E
) return B
is
2428 return Ekind
(Id
) in Class_Wide_Kind
;
2429 end Is_Class_Wide_Type
;
2431 function Is_Composite_Type
(Id
: E
) return B
is
2433 return Ekind
(Id
) in Composite_Kind
;
2434 end Is_Composite_Type
;
2436 function Is_Concurrent_Body
(Id
: E
) return B
is
2438 return Ekind
(Id
) in
2439 Concurrent_Body_Kind
;
2440 end Is_Concurrent_Body
;
2442 function Is_Concurrent_Record_Type
(Id
: E
) return B
is
2445 end Is_Concurrent_Record_Type
;
2447 function Is_Concurrent_Type
(Id
: E
) return B
is
2449 return Ekind
(Id
) in Concurrent_Kind
;
2450 end Is_Concurrent_Type
;
2452 function Is_Decimal_Fixed_Point_Type
(Id
: E
) return B
is
2454 return Ekind
(Id
) in
2455 Decimal_Fixed_Point_Kind
;
2456 end Is_Decimal_Fixed_Point_Type
;
2458 function Is_Digits_Type
(Id
: E
) return B
is
2460 return Ekind
(Id
) in Digits_Kind
;
2463 function Is_Discrete_Or_Fixed_Point_Type
(Id
: E
) return B
is
2465 return Ekind
(Id
) in Discrete_Or_Fixed_Point_Kind
;
2466 end Is_Discrete_Or_Fixed_Point_Type
;
2468 function Is_Discrete_Type
(Id
: E
) return B
is
2470 return Ekind
(Id
) in Discrete_Kind
;
2471 end Is_Discrete_Type
;
2473 function Is_Elementary_Type
(Id
: E
) return B
is
2475 return Ekind
(Id
) in Elementary_Kind
;
2476 end Is_Elementary_Type
;
2478 function Is_Entry
(Id
: E
) return B
is
2480 return Ekind
(Id
) in Entry_Kind
;
2483 function Is_Enumeration_Type
(Id
: E
) return B
is
2485 return Ekind
(Id
) in
2487 end Is_Enumeration_Type
;
2489 function Is_Fixed_Point_Type
(Id
: E
) return B
is
2491 return Ekind
(Id
) in
2493 end Is_Fixed_Point_Type
;
2495 function Is_Floating_Point_Type
(Id
: E
) return B
is
2497 return Ekind
(Id
) in Float_Kind
;
2498 end Is_Floating_Point_Type
;
2500 function Is_Formal
(Id
: E
) return B
is
2502 return Ekind
(Id
) in Formal_Kind
;
2505 function Is_Generic_Subprogram
(Id
: E
) return B
is
2507 return Ekind
(Id
) in Generic_Subprogram_Kind
;
2508 end Is_Generic_Subprogram
;
2510 function Is_Generic_Unit
(Id
: E
) return B
is
2512 return Ekind
(Id
) in Generic_Unit_Kind
;
2513 end Is_Generic_Unit
;
2515 function Is_Incomplete_Or_Private_Type
(Id
: E
) return B
is
2517 return Ekind
(Id
) in
2518 Incomplete_Or_Private_Kind
;
2519 end Is_Incomplete_Or_Private_Type
;
2521 function Is_Integer_Type
(Id
: E
) return B
is
2523 return Ekind
(Id
) in Integer_Kind
;
2524 end Is_Integer_Type
;
2526 function Is_Modular_Integer_Type
(Id
: E
) return B
is
2528 return Ekind
(Id
) in
2529 Modular_Integer_Kind
;
2530 end Is_Modular_Integer_Type
;
2532 function Is_Named_Number
(Id
: E
) return B
is
2534 return Ekind
(Id
) in Named_Kind
;
2535 end Is_Named_Number
;
2537 function Is_Numeric_Type
(Id
: E
) return B
is
2539 return Ekind
(Id
) in Numeric_Kind
;
2540 end Is_Numeric_Type
;
2542 function Is_Object
(Id
: E
) return B
is
2544 return Ekind
(Id
) in Object_Kind
;
2547 function Is_Ordinary_Fixed_Point_Type
(Id
: E
) return B
is
2549 return Ekind
(Id
) in
2550 Ordinary_Fixed_Point_Kind
;
2551 end Is_Ordinary_Fixed_Point_Type
;
2553 function Is_Overloadable
(Id
: E
) return B
is
2555 return Ekind
(Id
) in Overloadable_Kind
;
2556 end Is_Overloadable
;
2558 function Is_Private_Type
(Id
: E
) return B
is
2560 return Ekind
(Id
) in Private_Kind
;
2561 end Is_Private_Type
;
2563 function Is_Protected_Type
(Id
: E
) return B
is
2565 return Ekind
(Id
) in Protected_Kind
;
2566 end Is_Protected_Type
;
2568 function Is_Real_Type
(Id
: E
) return B
is
2570 return Ekind
(Id
) in Real_Kind
;
2573 function Is_Record_Type
(Id
: E
) return B
is
2575 return Ekind
(Id
) in Record_Kind
;
2578 function Is_Scalar_Type
(Id
: E
) return B
is
2580 return Ekind
(Id
) in Scalar_Kind
;
2583 function Is_Signed_Integer_Type
(Id
: E
) return B
is
2585 return Ekind
(Id
) in
2586 Signed_Integer_Kind
;
2587 end Is_Signed_Integer_Type
;
2589 function Is_Subprogram
(Id
: E
) return B
is
2591 return Ekind
(Id
) in Subprogram_Kind
;
2594 function Is_Task_Type
(Id
: E
) return B
is
2596 return Ekind
(Id
) in Task_Kind
;
2599 function Is_Type
(Id
: E
) return B
is
2601 return Ekind
(Id
) in Type_Kind
;
2604 ------------------------------
2605 -- Attribute Set Procedures --
2606 ------------------------------
2608 procedure Set_Abstract_Interfaces
(Id
: E
; V
: L
) is
2611 (Ekind
(Id
) = E_Record_Type
2612 or else Ekind
(Id
) = E_Record_Subtype
2613 or else Ekind
(Id
) = E_Record_Type_With_Private
2614 or else Ekind
(Id
) = E_Record_Subtype_With_Private
2615 or else Ekind
(Id
) = E_Class_Wide_Type
);
2616 Set_Elist24
(Id
, V
);
2617 end Set_Abstract_Interfaces
;
2619 procedure Set_Abstract_Interface_Alias
(Id
: E
; V
: E
) is
2622 (Ekind
(Id
) = E_Procedure
or Ekind
(Id
) = E_Function
);
2624 end Set_Abstract_Interface_Alias
;
2626 procedure Set_Accept_Address
(Id
: E
; V
: L
) is
2628 Set_Elist21
(Id
, V
);
2629 end Set_Accept_Address
;
2631 procedure Set_Access_Disp_Table
(Id
: E
; V
: L
) is
2633 pragma Assert
(Is_Tagged_Type
(Id
) and then Id
= Base_Type
(Id
));
2634 Set_Elist16
(Id
, V
);
2635 end Set_Access_Disp_Table
;
2637 procedure Set_Associated_Final_Chain
(Id
: E
; V
: E
) is
2639 pragma Assert
(Is_Access_Type
(Id
));
2641 end Set_Associated_Final_Chain
;
2643 procedure Set_Associated_Formal_Package
(Id
: E
; V
: E
) is
2646 end Set_Associated_Formal_Package
;
2648 procedure Set_Associated_Node_For_Itype
(Id
: E
; V
: E
) is
2651 end Set_Associated_Node_For_Itype
;
2653 procedure Set_Associated_Storage_Pool
(Id
: E
; V
: E
) is
2655 pragma Assert
(Is_Access_Type
(Id
) and then Id
= Base_Type
(Id
));
2657 end Set_Associated_Storage_Pool
;
2659 procedure Set_Actual_Subtype
(Id
: E
; V
: E
) is
2662 (Ekind
(Id
) = E_Constant
2663 or else Ekind
(Id
) = E_Variable
2664 or else Ekind
(Id
) = E_Generic_In_Out_Parameter
2665 or else Ekind
(Id
) in E_In_Parameter
.. E_In_Out_Parameter
);
2667 end Set_Actual_Subtype
;
2669 procedure Set_Address_Taken
(Id
: E
; V
: B
:= True) is
2671 Set_Flag104
(Id
, V
);
2672 end Set_Address_Taken
;
2674 procedure Set_Alias
(Id
: E
; V
: E
) is
2677 (Is_Overloadable
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
2681 procedure Set_Alignment
(Id
: E
; V
: U
) is
2683 pragma Assert
(Is_Type
(Id
)
2684 or else Is_Formal
(Id
)
2685 or else Ekind
(Id
) = E_Loop_Parameter
2686 or else Ekind
(Id
) = E_Constant
2687 or else Ekind
(Id
) = E_Exception
2688 or else Ekind
(Id
) = E_Variable
);
2692 procedure Set_Barrier_Function
(Id
: E
; V
: N
) is
2694 pragma Assert
(Is_Entry
(Id
));
2696 end Set_Barrier_Function
;
2698 procedure Set_Block_Node
(Id
: E
; V
: N
) is
2700 pragma Assert
(Ekind
(Id
) = E_Block
);
2704 procedure Set_Body_Entity
(Id
: E
; V
: E
) is
2707 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
2709 end Set_Body_Entity
;
2711 procedure Set_Body_Needed_For_SAL
(Id
: E
; V
: B
:= True) is
2714 (Ekind
(Id
) = E_Package
2715 or else Is_Subprogram
(Id
)
2716 or else Is_Generic_Unit
(Id
));
2718 end Set_Body_Needed_For_SAL
;
2720 procedure Set_C_Pass_By_Copy
(Id
: E
; V
: B
:= True) is
2722 pragma Assert
(Is_Record_Type
(Id
) and then Id
= Base_Type
(Id
));
2723 Set_Flag125
(Id
, V
);
2724 end Set_C_Pass_By_Copy
;
2726 procedure Set_Can_Never_Be_Null
(Id
: E
; V
: B
:= True) is
2729 end Set_Can_Never_Be_Null
;
2731 procedure Set_Checks_May_Be_Suppressed
(Id
: E
; V
: B
:= True) is
2734 end Set_Checks_May_Be_Suppressed
;
2736 procedure Set_Class_Wide_Type
(Id
: E
; V
: E
) is
2738 pragma Assert
(Is_Type
(Id
));
2740 end Set_Class_Wide_Type
;
2742 procedure Set_Cloned_Subtype
(Id
: E
; V
: E
) is
2745 (Ekind
(Id
) = E_Record_Subtype
2746 or else Ekind
(Id
) = E_Class_Wide_Subtype
);
2748 end Set_Cloned_Subtype
;
2750 procedure Set_Component_Bit_Offset
(Id
: E
; V
: U
) is
2753 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2755 end Set_Component_Bit_Offset
;
2757 procedure Set_Component_Clause
(Id
: E
; V
: N
) is
2760 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2762 end Set_Component_Clause
;
2764 procedure Set_Component_Size
(Id
: E
; V
: U
) is
2766 pragma Assert
(Is_Array_Type
(Id
) and then Id
= Base_Type
(Id
));
2768 end Set_Component_Size
;
2770 procedure Set_Component_Type
(Id
: E
; V
: E
) is
2772 pragma Assert
(Is_Array_Type
(Id
) and then Id
= Base_Type
(Id
));
2774 end Set_Component_Type
;
2776 procedure Set_Corresponding_Concurrent_Type
(Id
: E
; V
: E
) is
2779 (Ekind
(Id
) = E_Record_Type
and then Is_Concurrent_Type
(V
));
2781 end Set_Corresponding_Concurrent_Type
;
2783 procedure Set_Corresponding_Discriminant
(Id
: E
; V
: E
) is
2785 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
2787 end Set_Corresponding_Discriminant
;
2789 procedure Set_Corresponding_Equality
(Id
: E
; V
: E
) is
2792 (Ekind
(Id
) = E_Function
2793 and then not Comes_From_Source
(Id
)
2794 and then Chars
(Id
) = Name_Op_Ne
);
2796 end Set_Corresponding_Equality
;
2798 procedure Set_Corresponding_Record_Type
(Id
: E
; V
: E
) is
2800 pragma Assert
(Is_Concurrent_Type
(Id
));
2802 end Set_Corresponding_Record_Type
;
2804 procedure Set_Corresponding_Remote_Type
(Id
: E
; V
: E
) is
2807 end Set_Corresponding_Remote_Type
;
2809 procedure Set_Current_Use_Clause
(Id
: E
; V
: E
) is
2811 pragma Assert
(Ekind
(Id
) = E_Package
);
2813 end Set_Current_Use_Clause
;
2815 procedure Set_Current_Value
(Id
: E
; V
: N
) is
2817 pragma Assert
(Ekind
(Id
) in Object_Kind
or else Ekind
(Id
) = E_Void
);
2819 end Set_Current_Value
;
2821 procedure Set_CR_Discriminant
(Id
: E
; V
: E
) is
2824 end Set_CR_Discriminant
;
2826 procedure Set_Debug_Info_Off
(Id
: E
; V
: B
:= True) is
2828 Set_Flag166
(Id
, V
);
2829 end Set_Debug_Info_Off
;
2831 procedure Set_Debug_Renaming_Link
(Id
: E
; V
: E
) is
2834 end Set_Debug_Renaming_Link
;
2836 procedure Set_Default_Expr_Function
(Id
: E
; V
: E
) is
2838 pragma Assert
(Is_Formal
(Id
));
2840 end Set_Default_Expr_Function
;
2842 procedure Set_Default_Expressions_Processed
(Id
: E
; V
: B
:= True) is
2844 Set_Flag108
(Id
, V
);
2845 end Set_Default_Expressions_Processed
;
2847 procedure Set_Default_Value
(Id
: E
; V
: N
) is
2849 pragma Assert
(Is_Formal
(Id
));
2851 end Set_Default_Value
;
2853 procedure Set_Delay_Cleanups
(Id
: E
; V
: B
:= True) is
2857 or else Is_Task_Type
(Id
)
2858 or else Ekind
(Id
) = E_Block
);
2859 Set_Flag114
(Id
, V
);
2860 end Set_Delay_Cleanups
;
2862 procedure Set_Delay_Subprogram_Descriptors
(Id
: E
; V
: B
:= True) is
2866 or else Ekind
(Id
) = E_Package
2867 or else Ekind
(Id
) = E_Package_Body
);
2869 end Set_Delay_Subprogram_Descriptors
;
2871 procedure Set_Delta_Value
(Id
: E
; V
: R
) is
2873 pragma Assert
(Is_Fixed_Point_Type
(Id
));
2874 Set_Ureal18
(Id
, V
);
2875 end Set_Delta_Value
;
2877 procedure Set_Dependent_Instances
(Id
: E
; V
: L
) is
2879 pragma Assert
(Is_Generic_Instance
(Id
));
2881 end Set_Dependent_Instances
;
2883 procedure Set_Depends_On_Private
(Id
: E
; V
: B
:= True) is
2885 pragma Assert
(Nkind
(Id
) in N_Entity
);
2887 end Set_Depends_On_Private
;
2889 procedure Set_Digits_Value
(Id
: E
; V
: U
) is
2892 (Is_Floating_Point_Type
(Id
)
2893 or else Is_Decimal_Fixed_Point_Type
(Id
));
2895 end Set_Digits_Value
;
2897 procedure Set_Directly_Designated_Type
(Id
: E
; V
: E
) is
2900 end Set_Directly_Designated_Type
;
2902 procedure Set_Discard_Names
(Id
: E
; V
: B
:= True) is
2905 end Set_Discard_Names
;
2907 procedure Set_Discriminal
(Id
: E
; V
: E
) is
2909 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
2911 end Set_Discriminal
;
2913 procedure Set_Discriminal_Link
(Id
: E
; V
: E
) is
2916 end Set_Discriminal_Link
;
2918 procedure Set_Discriminant_Checking_Func
(Id
: E
; V
: E
) is
2920 pragma Assert
(Ekind
(Id
) = E_Component
);
2922 end Set_Discriminant_Checking_Func
;
2924 procedure Set_Discriminant_Constraint
(Id
: E
; V
: L
) is
2926 pragma Assert
(Nkind
(Id
) in N_Entity
);
2927 Set_Elist21
(Id
, V
);
2928 end Set_Discriminant_Constraint
;
2930 procedure Set_Discriminant_Default_Value
(Id
: E
; V
: N
) is
2933 end Set_Discriminant_Default_Value
;
2935 procedure Set_Discriminant_Number
(Id
: E
; V
: U
) is
2938 end Set_Discriminant_Number
;
2940 procedure Set_DT_Entry_Count
(Id
: E
; V
: U
) is
2942 pragma Assert
(Ekind
(Id
) = E_Component
);
2944 end Set_DT_Entry_Count
;
2946 procedure Set_DT_Offset_To_Top_Func
(Id
: E
; V
: E
) is
2948 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
2950 end Set_DT_Offset_To_Top_Func
;
2952 procedure Set_DT_Position
(Id
: E
; V
: U
) is
2954 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
2956 end Set_DT_Position
;
2958 procedure Set_DTC_Entity
(Id
: E
; V
: E
) is
2961 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
2965 procedure Set_Elaboration_Entity
(Id
: E
; V
: E
) is
2970 Ekind
(Id
) = E_Package
2972 Is_Generic_Unit
(Id
));
2974 end Set_Elaboration_Entity
;
2976 procedure Set_Elaboration_Entity_Required
(Id
: E
; V
: B
:= True) is
2981 Ekind
(Id
) = E_Package
2983 Is_Generic_Unit
(Id
));
2984 Set_Flag174
(Id
, V
);
2985 end Set_Elaboration_Entity_Required
;
2987 procedure Set_Enclosing_Scope
(Id
: E
; V
: E
) is
2990 end Set_Enclosing_Scope
;
2992 procedure Set_Entry_Accepted
(Id
: E
; V
: B
:= True) is
2994 pragma Assert
(Is_Entry
(Id
));
2995 Set_Flag152
(Id
, V
);
2996 end Set_Entry_Accepted
;
2998 procedure Set_Entry_Bodies_Array
(Id
: E
; V
: E
) is
3001 end Set_Entry_Bodies_Array
;
3003 procedure Set_Entry_Cancel_Parameter
(Id
: E
; V
: E
) is
3006 end Set_Entry_Cancel_Parameter
;
3008 procedure Set_Entry_Component
(Id
: E
; V
: E
) is
3011 end Set_Entry_Component
;
3013 procedure Set_Entry_Formal
(Id
: E
; V
: E
) is
3016 end Set_Entry_Formal
;
3018 procedure Set_Entry_Index_Constant
(Id
: E
; V
: E
) is
3020 pragma Assert
(Ekind
(Id
) = E_Entry_Index_Parameter
);
3022 end Set_Entry_Index_Constant
;
3024 procedure Set_Entry_Parameters_Type
(Id
: E
; V
: E
) is
3027 end Set_Entry_Parameters_Type
;
3029 procedure Set_Enum_Pos_To_Rep
(Id
: E
; V
: E
) is
3031 pragma Assert
(Ekind
(Id
) = E_Enumeration_Type
);
3033 end Set_Enum_Pos_To_Rep
;
3035 procedure Set_Enumeration_Pos
(Id
: E
; V
: U
) is
3037 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3039 end Set_Enumeration_Pos
;
3041 procedure Set_Enumeration_Rep
(Id
: E
; V
: U
) is
3043 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3045 end Set_Enumeration_Rep
;
3047 procedure Set_Enumeration_Rep_Expr
(Id
: E
; V
: N
) is
3049 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3051 end Set_Enumeration_Rep_Expr
;
3053 procedure Set_Equivalent_Type
(Id
: E
; V
: E
) is
3056 (Ekind
(Id
) = E_Class_Wide_Type
or else
3057 Ekind
(Id
) = E_Class_Wide_Subtype
or else
3058 Ekind
(Id
) = E_Access_Protected_Subprogram_Type
or else
3059 Ekind
(Id
) = E_Access_Subprogram_Type
or else
3060 Ekind
(Id
) = E_Exception_Type
);
3062 end Set_Equivalent_Type
;
3064 procedure Set_Esize
(Id
: E
; V
: U
) is
3069 procedure Set_Exception_Code
(Id
: E
; V
: U
) is
3071 pragma Assert
(Ekind
(Id
) = E_Exception
);
3073 end Set_Exception_Code
;
3075 procedure Set_Extra_Accessibility
(Id
: E
; V
: E
) is
3077 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
3079 end Set_Extra_Accessibility
;
3081 procedure Set_Extra_Constrained
(Id
: E
; V
: E
) is
3083 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
3085 end Set_Extra_Constrained
;
3087 procedure Set_Extra_Formal
(Id
: E
; V
: E
) is
3090 end Set_Extra_Formal
;
3092 procedure Set_Finalization_Chain_Entity
(Id
: E
; V
: E
) is
3095 end Set_Finalization_Chain_Entity
;
3097 procedure Set_Finalize_Storage_Only
(Id
: E
; V
: B
:= True) is
3099 pragma Assert
(Is_Type
(Id
) and then Id
= Base_Type
(Id
));
3100 Set_Flag158
(Id
, V
);
3101 end Set_Finalize_Storage_Only
;
3103 procedure Set_First_Entity
(Id
: E
; V
: E
) is
3106 end Set_First_Entity
;
3108 procedure Set_First_Index
(Id
: E
; V
: N
) is
3111 end Set_First_Index
;
3113 procedure Set_First_Literal
(Id
: E
; V
: E
) is
3116 end Set_First_Literal
;
3118 procedure Set_First_Optional_Parameter
(Id
: E
; V
: E
) is
3121 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
3123 end Set_First_Optional_Parameter
;
3125 procedure Set_First_Private_Entity
(Id
: E
; V
: E
) is
3127 pragma Assert
(Ekind
(Id
) = E_Package
3128 or else Ekind
(Id
) = E_Generic_Package
3129 or else Ekind
(Id
) = E_Protected_Type
3130 or else Ekind
(Id
) = E_Protected_Subtype
3131 or else Ekind
(Id
) = E_Task_Type
3132 or else Ekind
(Id
) = E_Task_Subtype
);
3134 end Set_First_Private_Entity
;
3136 procedure Set_First_Rep_Item
(Id
: E
; V
: N
) is
3139 end Set_First_Rep_Item
;
3141 procedure Set_Freeze_Node
(Id
: E
; V
: N
) is
3144 end Set_Freeze_Node
;
3146 procedure Set_From_With_Type
(Id
: E
; V
: B
:= True) is
3150 or else Ekind
(Id
) = E_Package
);
3151 Set_Flag159
(Id
, V
);
3152 end Set_From_With_Type
;
3154 procedure Set_Full_View
(Id
: E
; V
: E
) is
3156 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Constant
);
3160 procedure Set_Function_Returns_With_DSP
(Id
: E
; V
: B
:= True) is
3163 (Is_Subprogram
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
3164 Set_Flag169
(Id
, V
);
3165 end Set_Function_Returns_With_DSP
;
3167 procedure Set_Generic_Homonym
(Id
: E
; V
: E
) is
3170 end Set_Generic_Homonym
;
3172 procedure Set_Generic_Renamings
(Id
: E
; V
: L
) is
3174 Set_Elist23
(Id
, V
);
3175 end Set_Generic_Renamings
;
3177 procedure Set_Handler_Records
(Id
: E
; V
: S
) is
3180 end Set_Handler_Records
;
3182 procedure Set_Has_Aliased_Components
(Id
: E
; V
: B
:= True) is
3184 pragma Assert
(Base_Type
(Id
) = Id
);
3185 Set_Flag135
(Id
, V
);
3186 end Set_Has_Aliased_Components
;
3188 procedure Set_Has_Alignment_Clause
(Id
: E
; V
: B
:= True) is
3191 end Set_Has_Alignment_Clause
;
3193 procedure Set_Has_All_Calls_Remote
(Id
: E
; V
: B
:= True) is
3196 end Set_Has_All_Calls_Remote
;
3198 procedure Set_Has_Anon_Block_Suffix
(Id
: E
; V
: B
:= True) is
3200 Set_Flag201
(Id
, V
);
3201 end Set_Has_Anon_Block_Suffix
;
3203 procedure Set_Has_Atomic_Components
(Id
: E
; V
: B
:= True) is
3205 pragma Assert
(not Is_Type
(Id
) or else Base_Type
(Id
) = Id
);
3207 end Set_Has_Atomic_Components
;
3209 procedure Set_Has_Biased_Representation
(Id
: E
; V
: B
:= True) is
3212 ((V
= False) or else (Is_Discrete_Type
(Id
) or Is_Object
(Id
)));
3213 Set_Flag139
(Id
, V
);
3214 end Set_Has_Biased_Representation
;
3216 procedure Set_Has_Completion
(Id
: E
; V
: B
:= True) is
3219 end Set_Has_Completion
;
3221 procedure Set_Has_Completion_In_Body
(Id
: E
; V
: B
:= True) is
3223 pragma Assert
(Ekind
(Id
) = E_Incomplete_Type
);
3225 end Set_Has_Completion_In_Body
;
3227 procedure Set_Has_Complex_Representation
(Id
: E
; V
: B
:= True) is
3229 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
3230 Set_Flag140
(Id
, V
);
3231 end Set_Has_Complex_Representation
;
3233 procedure Set_Has_Component_Size_Clause
(Id
: E
; V
: B
:= True) is
3235 pragma Assert
(Ekind
(Id
) = E_Array_Type
);
3237 end Set_Has_Component_Size_Clause
;
3239 procedure Set_Has_Constrained_Partial_View
(Id
: E
; V
: B
:= True) is
3241 pragma Assert
(Is_Type
(Id
));
3242 Set_Flag187
(Id
, V
);
3243 end Set_Has_Constrained_Partial_View
;
3245 procedure Set_Has_Contiguous_Rep
(Id
: E
; V
: B
:= True) is
3247 Set_Flag181
(Id
, V
);
3248 end Set_Has_Contiguous_Rep
;
3250 procedure Set_Has_Controlled_Component
(Id
: E
; V
: B
:= True) is
3252 pragma Assert
(Base_Type
(Id
) = Id
);
3254 end Set_Has_Controlled_Component
;
3256 procedure Set_Has_Controlling_Result
(Id
: E
; V
: B
:= True) is
3259 end Set_Has_Controlling_Result
;
3261 procedure Set_Has_Convention_Pragma
(Id
: E
; V
: B
:= True) is
3263 Set_Flag119
(Id
, V
);
3264 end Set_Has_Convention_Pragma
;
3266 procedure Set_Has_Delayed_Freeze
(Id
: E
; V
: B
:= True) is
3268 pragma Assert
(Nkind
(Id
) in N_Entity
);
3270 end Set_Has_Delayed_Freeze
;
3272 procedure Set_Has_Discriminants
(Id
: E
; V
: B
:= True) is
3274 pragma Assert
(Nkind
(Id
) in N_Entity
);
3276 end Set_Has_Discriminants
;
3278 procedure Set_Has_Enumeration_Rep_Clause
(Id
: E
; V
: B
:= True) is
3280 pragma Assert
(Is_Enumeration_Type
(Id
));
3282 end Set_Has_Enumeration_Rep_Clause
;
3284 procedure Set_Has_Exit
(Id
: E
; V
: B
:= True) is
3289 procedure Set_Has_External_Tag_Rep_Clause
(Id
: E
; V
: B
:= True) is
3291 pragma Assert
(Is_Tagged_Type
(Id
));
3292 Set_Flag110
(Id
, V
);
3293 end Set_Has_External_Tag_Rep_Clause
;
3295 procedure Set_Has_Forward_Instantiation
(Id
: E
; V
: B
:= True) is
3297 Set_Flag175
(Id
, V
);
3298 end Set_Has_Forward_Instantiation
;
3300 procedure Set_Has_Fully_Qualified_Name
(Id
: E
; V
: B
:= True) is
3302 Set_Flag173
(Id
, V
);
3303 end Set_Has_Fully_Qualified_Name
;
3305 procedure Set_Has_Gigi_Rep_Item
(Id
: E
; V
: B
:= True) is
3308 end Set_Has_Gigi_Rep_Item
;
3310 procedure Set_Has_Homonym
(Id
: E
; V
: B
:= True) is
3313 end Set_Has_Homonym
;
3315 procedure Set_Has_Machine_Radix_Clause
(Id
: E
; V
: B
:= True) is
3317 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
3319 end Set_Has_Machine_Radix_Clause
;
3321 procedure Set_Has_Master_Entity
(Id
: E
; V
: B
:= True) is
3324 end Set_Has_Master_Entity
;
3326 procedure Set_Has_Missing_Return
(Id
: E
; V
: B
:= True) is
3329 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Generic_Function
);
3330 Set_Flag142
(Id
, V
);
3331 end Set_Has_Missing_Return
;
3333 procedure Set_Has_Nested_Block_With_Handler
(Id
: E
; V
: B
:= True) is
3335 Set_Flag101
(Id
, V
);
3336 end Set_Has_Nested_Block_With_Handler
;
3338 procedure Set_Has_Non_Standard_Rep
(Id
: E
; V
: B
:= True) is
3340 pragma Assert
(Base_Type
(Id
) = Id
);
3342 end Set_Has_Non_Standard_Rep
;
3344 procedure Set_Has_Object_Size_Clause
(Id
: E
; V
: B
:= True) is
3346 pragma Assert
(Is_Type
(Id
));
3347 Set_Flag172
(Id
, V
);
3348 end Set_Has_Object_Size_Clause
;
3350 procedure Set_Has_Per_Object_Constraint
(Id
: E
; V
: B
:= True) is
3352 Set_Flag154
(Id
, V
);
3353 end Set_Has_Per_Object_Constraint
;
3355 procedure Set_Has_Persistent_BSS
(Id
: E
; V
: B
:= True) is
3357 Set_Flag188
(Id
, V
);
3358 end Set_Has_Persistent_BSS
;
3360 procedure Set_Has_Pragma_Controlled
(Id
: E
; V
: B
:= True) is
3362 pragma Assert
(Is_Access_Type
(Id
));
3363 Set_Flag27
(Base_Type
(Id
), V
);
3364 end Set_Has_Pragma_Controlled
;
3366 procedure Set_Has_Pragma_Elaborate_Body
(Id
: E
; V
: B
:= True) is
3368 Set_Flag150
(Id
, V
);
3369 end Set_Has_Pragma_Elaborate_Body
;
3371 procedure Set_Has_Pragma_Inline
(Id
: E
; V
: B
:= True) is
3373 Set_Flag157
(Id
, V
);
3374 end Set_Has_Pragma_Inline
;
3376 procedure Set_Has_Pragma_Pack
(Id
: E
; V
: B
:= True) is
3378 pragma Assert
(Is_Array_Type
(Id
) or else Is_Record_Type
(Id
));
3379 pragma Assert
(Id
= Base_Type
(Id
));
3380 Set_Flag121
(Id
, V
);
3381 end Set_Has_Pragma_Pack
;
3383 procedure Set_Has_Pragma_Pure
(Id
: E
; V
: B
:= True) is
3385 Set_Flag203
(Id
, V
);
3386 end Set_Has_Pragma_Pure
;
3388 procedure Set_Has_Pragma_Pure_Function
(Id
: E
; V
: B
:= True) is
3390 Set_Flag179
(Id
, V
);
3391 end Set_Has_Pragma_Pure_Function
;
3393 procedure Set_Has_Pragma_Unreferenced
(Id
: E
; V
: B
:= True) is
3395 Set_Flag180
(Id
, V
);
3396 end Set_Has_Pragma_Unreferenced
;
3398 procedure Set_Has_Primitive_Operations
(Id
: E
; V
: B
:= True) is
3400 pragma Assert
(Id
= Base_Type
(Id
));
3401 Set_Flag120
(Id
, V
);
3402 end Set_Has_Primitive_Operations
;
3404 procedure Set_Has_Private_Declaration
(Id
: E
; V
: B
:= True) is
3406 Set_Flag155
(Id
, V
);
3407 end Set_Has_Private_Declaration
;
3409 procedure Set_Has_Qualified_Name
(Id
: E
; V
: B
:= True) is
3411 Set_Flag161
(Id
, V
);
3412 end Set_Has_Qualified_Name
;
3414 procedure Set_Has_Record_Rep_Clause
(Id
: E
; V
: B
:= True) is
3416 pragma Assert
(Id
= Base_Type
(Id
));
3418 end Set_Has_Record_Rep_Clause
;
3420 procedure Set_Has_Recursive_Call
(Id
: E
; V
: B
:= True) is
3422 pragma Assert
(Is_Subprogram
(Id
));
3423 Set_Flag143
(Id
, V
);
3424 end Set_Has_Recursive_Call
;
3426 procedure Set_Has_Size_Clause
(Id
: E
; V
: B
:= True) is
3429 end Set_Has_Size_Clause
;
3431 procedure Set_Has_Small_Clause
(Id
: E
; V
: B
:= True) is
3434 end Set_Has_Small_Clause
;
3436 procedure Set_Has_Specified_Layout
(Id
: E
; V
: B
:= True) is
3438 pragma Assert
(Id
= Base_Type
(Id
));
3439 Set_Flag100
(Id
, V
);
3440 end Set_Has_Specified_Layout
;
3442 procedure Set_Has_Specified_Stream_Input
(Id
: E
; V
: B
:= True) is
3444 pragma Assert
(Is_Type
(Id
));
3445 Set_Flag190
(Id
, V
);
3446 end Set_Has_Specified_Stream_Input
;
3448 procedure Set_Has_Specified_Stream_Output
(Id
: E
; V
: B
:= True) is
3450 pragma Assert
(Is_Type
(Id
));
3451 Set_Flag191
(Id
, V
);
3452 end Set_Has_Specified_Stream_Output
;
3454 procedure Set_Has_Specified_Stream_Read
(Id
: E
; V
: B
:= True) is
3456 pragma Assert
(Is_Type
(Id
));
3457 Set_Flag192
(Id
, V
);
3458 end Set_Has_Specified_Stream_Read
;
3460 procedure Set_Has_Specified_Stream_Write
(Id
: E
; V
: B
:= True) is
3462 pragma Assert
(Is_Type
(Id
));
3463 Set_Flag193
(Id
, V
);
3464 end Set_Has_Specified_Stream_Write
;
3466 procedure Set_Has_Storage_Size_Clause
(Id
: E
; V
: B
:= True) is
3468 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
3469 pragma Assert
(Base_Type
(Id
) = Id
);
3471 end Set_Has_Storage_Size_Clause
;
3473 procedure Set_Has_Stream_Size_Clause
(Id
: E
; V
: B
:= True) is
3475 pragma Assert
(Is_Elementary_Type
(Id
));
3476 Set_Flag184
(Id
, V
);
3477 end Set_Has_Stream_Size_Clause
;
3479 procedure Set_Has_Subprogram_Descriptor
(Id
: E
; V
: B
:= True) is
3482 end Set_Has_Subprogram_Descriptor
;
3484 procedure Set_Has_Task
(Id
: E
; V
: B
:= True) is
3486 pragma Assert
(Base_Type
(Id
) = Id
);
3490 procedure Set_Has_Unchecked_Union
(Id
: E
; V
: B
:= True) is
3492 pragma Assert
(Base_Type
(Id
) = Id
);
3493 Set_Flag123
(Id
, V
);
3494 end Set_Has_Unchecked_Union
;
3496 procedure Set_Has_Unknown_Discriminants
(Id
: E
; V
: B
:= True) is
3498 pragma Assert
(Is_Type
(Id
));
3500 end Set_Has_Unknown_Discriminants
;
3502 procedure Set_Has_Volatile_Components
(Id
: E
; V
: B
:= True) is
3504 pragma Assert
(not Is_Type
(Id
) or else Base_Type
(Id
) = Id
);
3506 end Set_Has_Volatile_Components
;
3508 procedure Set_Has_Xref_Entry
(Id
: E
; V
: B
:= True) is
3510 Set_Flag182
(Id
, V
);
3511 end Set_Has_Xref_Entry
;
3513 procedure Set_Hiding_Loop_Variable
(Id
: E
; V
: E
) is
3515 pragma Assert
(Ekind
(Id
) = E_Variable
);
3517 end Set_Hiding_Loop_Variable
;
3519 procedure Set_Homonym
(Id
: E
; V
: E
) is
3521 pragma Assert
(Id
/= V
);
3525 procedure Set_In_Package_Body
(Id
: E
; V
: B
:= True) is
3528 end Set_In_Package_Body
;
3530 procedure Set_In_Private_Part
(Id
: E
; V
: B
:= True) is
3533 end Set_In_Private_Part
;
3535 procedure Set_In_Use
(Id
: E
; V
: B
:= True) is
3537 pragma Assert
(Nkind
(Id
) in N_Entity
);
3541 procedure Set_Inner_Instances
(Id
: E
; V
: L
) is
3543 Set_Elist23
(Id
, V
);
3544 end Set_Inner_Instances
;
3546 procedure Set_Interface_Name
(Id
: E
; V
: N
) is
3549 end Set_Interface_Name
;
3551 procedure Set_Is_Abstract
(Id
: E
; V
: B
:= True) is
3554 end Set_Is_Abstract
;
3556 procedure Set_Is_Local_Anonymous_Access
(Id
: E
; V
: B
:= True) is
3558 pragma Assert
(Is_Access_Type
(Id
));
3559 Set_Flag194
(Id
, V
);
3560 end Set_Is_Local_Anonymous_Access
;
3562 procedure Set_Is_Access_Constant
(Id
: E
; V
: B
:= True) is
3564 pragma Assert
(Is_Access_Type
(Id
));
3566 end Set_Is_Access_Constant
;
3568 procedure Set_Is_Ada_2005
(Id
: E
; V
: B
:= True) is
3570 Set_Flag185
(Id
, V
);
3571 end Set_Is_Ada_2005
;
3573 procedure Set_Is_Aliased
(Id
: E
; V
: B
:= True) is
3575 pragma Assert
(Nkind
(Id
) in N_Entity
);
3579 procedure Set_Is_AST_Entry
(Id
: E
; V
: B
:= True) is
3581 pragma Assert
(Is_Entry
(Id
));
3582 Set_Flag132
(Id
, V
);
3583 end Set_Is_AST_Entry
;
3585 procedure Set_Is_Asynchronous
(Id
: E
; V
: B
:= True) is
3588 (Ekind
(Id
) = E_Procedure
or else Is_Type
(Id
));
3590 end Set_Is_Asynchronous
;
3592 procedure Set_Is_Atomic
(Id
: E
; V
: B
:= True) is
3597 procedure Set_Is_Bit_Packed_Array
(Id
: E
; V
: B
:= True) is
3599 pragma Assert
((not V
)
3600 or else (Is_Array_Type
(Id
) and then Id
= Base_Type
(Id
)));
3602 Set_Flag122
(Id
, V
);
3603 end Set_Is_Bit_Packed_Array
;
3605 procedure Set_Is_Called
(Id
: E
; V
: B
:= True) is
3608 (Ekind
(Id
) = E_Procedure
or else Ekind
(Id
) = E_Function
);
3609 Set_Flag102
(Id
, V
);
3612 procedure Set_Is_Character_Type
(Id
: E
; V
: B
:= True) is
3615 end Set_Is_Character_Type
;
3617 procedure Set_Is_Child_Unit
(Id
: E
; V
: B
:= True) is
3620 end Set_Is_Child_Unit
;
3622 procedure Set_Is_Class_Wide_Equivalent_Type
(Id
: E
; V
: B
:= True) is
3625 end Set_Is_Class_Wide_Equivalent_Type
;
3627 procedure Set_Is_Compilation_Unit
(Id
: E
; V
: B
:= True) is
3629 Set_Flag149
(Id
, V
);
3630 end Set_Is_Compilation_Unit
;
3632 procedure Set_Is_Completely_Hidden
(Id
: E
; V
: B
:= True) is
3634 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
3635 Set_Flag103
(Id
, V
);
3636 end Set_Is_Completely_Hidden
;
3638 procedure Set_Is_Concurrent_Record_Type
(Id
: E
; V
: B
:= True) is
3641 end Set_Is_Concurrent_Record_Type
;
3643 procedure Set_Is_Constr_Subt_For_U_Nominal
(Id
: E
; V
: B
:= True) is
3646 end Set_Is_Constr_Subt_For_U_Nominal
;
3648 procedure Set_Is_Constr_Subt_For_UN_Aliased
(Id
: E
; V
: B
:= True) is
3650 Set_Flag141
(Id
, V
);
3651 end Set_Is_Constr_Subt_For_UN_Aliased
;
3653 procedure Set_Is_Constrained
(Id
: E
; V
: B
:= True) is
3655 pragma Assert
(Nkind
(Id
) in N_Entity
);
3657 end Set_Is_Constrained
;
3659 procedure Set_Is_Constructor
(Id
: E
; V
: B
:= True) is
3662 end Set_Is_Constructor
;
3664 procedure Set_Is_Controlled
(Id
: E
; V
: B
:= True) is
3666 pragma Assert
(Id
= Base_Type
(Id
));
3668 end Set_Is_Controlled
;
3670 procedure Set_Is_Controlling_Formal
(Id
: E
; V
: B
:= True) is
3672 pragma Assert
(Is_Formal
(Id
));
3674 end Set_Is_Controlling_Formal
;
3676 procedure Set_Is_CPP_Class
(Id
: E
; V
: B
:= True) is
3679 end Set_Is_CPP_Class
;
3681 procedure Set_Is_Discrim_SO_Function
(Id
: E
; V
: B
:= True) is
3683 Set_Flag176
(Id
, V
);
3684 end Set_Is_Discrim_SO_Function
;
3686 procedure Set_Is_Dispatching_Operation
(Id
: E
; V
: B
:= True) is
3691 Is_Overloadable
(Id
)
3693 Ekind
(Id
) = E_Subprogram_Type
);
3696 end Set_Is_Dispatching_Operation
;
3698 procedure Set_Is_Eliminated
(Id
: E
; V
: B
:= True) is
3700 Set_Flag124
(Id
, V
);
3701 end Set_Is_Eliminated
;
3703 procedure Set_Is_Entry_Formal
(Id
: E
; V
: B
:= True) is
3706 end Set_Is_Entry_Formal
;
3708 procedure Set_Is_Exported
(Id
: E
; V
: B
:= True) is
3711 end Set_Is_Exported
;
3713 procedure Set_Is_First_Subtype
(Id
: E
; V
: B
:= True) is
3716 end Set_Is_First_Subtype
;
3718 procedure Set_Is_For_Access_Subtype
(Id
: E
; V
: B
:= True) is
3721 (Ekind
(Id
) = E_Record_Subtype
3723 Ekind
(Id
) = E_Private_Subtype
);
3724 Set_Flag118
(Id
, V
);
3725 end Set_Is_For_Access_Subtype
;
3727 procedure Set_Is_Formal_Subprogram
(Id
: E
; V
: B
:= True) is
3729 Set_Flag111
(Id
, V
);
3730 end Set_Is_Formal_Subprogram
;
3732 procedure Set_Is_Frozen
(Id
: E
; V
: B
:= True) is
3734 pragma Assert
(Nkind
(Id
) in N_Entity
);
3738 procedure Set_Is_Generic_Actual_Type
(Id
: E
; V
: B
:= True) is
3740 pragma Assert
(Is_Type
(Id
));
3742 end Set_Is_Generic_Actual_Type
;
3744 procedure Set_Is_Generic_Instance
(Id
: E
; V
: B
:= True) is
3746 Set_Flag130
(Id
, V
);
3747 end Set_Is_Generic_Instance
;
3749 procedure Set_Is_Generic_Type
(Id
: E
; V
: B
:= True) is
3751 pragma Assert
(Nkind
(Id
) in N_Entity
);
3753 end Set_Is_Generic_Type
;
3755 procedure Set_Is_Hidden
(Id
: E
; V
: B
:= True) is
3760 procedure Set_Is_Hidden_Open_Scope
(Id
: E
; V
: B
:= True) is
3762 Set_Flag171
(Id
, V
);
3763 end Set_Is_Hidden_Open_Scope
;
3765 procedure Set_Is_Immediately_Visible
(Id
: E
; V
: B
:= True) is
3767 pragma Assert
(Nkind
(Id
) in N_Entity
);
3769 end Set_Is_Immediately_Visible
;
3771 procedure Set_Is_Imported
(Id
: E
; V
: B
:= True) is
3774 end Set_Is_Imported
;
3776 procedure Set_Is_Inlined
(Id
: E
; V
: B
:= True) is
3781 procedure Set_Is_Interface
(Id
: E
; V
: B
:= True) is
3784 (Ekind
(Id
) = E_Record_Type
3785 or else Ekind
(Id
) = E_Record_Subtype
3786 or else Ekind
(Id
) = E_Record_Type_With_Private
3787 or else Ekind
(Id
) = E_Record_Subtype_With_Private
3788 or else Ekind
(Id
) = E_Class_Wide_Type
);
3789 Set_Flag186
(Id
, V
);
3790 end Set_Is_Interface
;
3792 procedure Set_Is_Instantiated
(Id
: E
; V
: B
:= True) is
3794 Set_Flag126
(Id
, V
);
3795 end Set_Is_Instantiated
;
3797 procedure Set_Is_Internal
(Id
: E
; V
: B
:= True) is
3799 pragma Assert
(Nkind
(Id
) in N_Entity
);
3801 end Set_Is_Internal
;
3803 procedure Set_Is_Interrupt_Handler
(Id
: E
; V
: B
:= True) is
3805 pragma Assert
(Nkind
(Id
) in N_Entity
);
3807 end Set_Is_Interrupt_Handler
;
3809 procedure Set_Is_Intrinsic_Subprogram
(Id
: E
; V
: B
:= True) is
3812 end Set_Is_Intrinsic_Subprogram
;
3814 procedure Set_Is_Itype
(Id
: E
; V
: B
:= True) is
3819 procedure Set_Is_Known_Non_Null
(Id
: E
; V
: B
:= True) is
3822 end Set_Is_Known_Non_Null
;
3824 procedure Set_Is_Known_Null
(Id
: E
; V
: B
:= True) is
3826 Set_Flag204
(Id
, V
);
3827 end Set_Is_Known_Null
;
3829 procedure Set_Is_Known_Valid
(Id
: E
; V
: B
:= True) is
3831 Set_Flag170
(Id
, V
);
3832 end Set_Is_Known_Valid
;
3834 procedure Set_Is_Limited_Composite
(Id
: E
; V
: B
:= True) is
3836 pragma Assert
(Is_Type
(Id
));
3837 Set_Flag106
(Id
, V
);
3838 end Set_Is_Limited_Composite
;
3840 procedure Set_Is_Limited_Interface
(Id
: E
; V
: B
:= True) is
3842 pragma Assert
(Is_Interface
(Id
));
3843 Set_Flag197
(Id
, V
);
3844 end Set_Is_Limited_Interface
;
3846 procedure Set_Is_Limited_Record
(Id
: E
; V
: B
:= True) is
3849 end Set_Is_Limited_Record
;
3851 procedure Set_Is_Machine_Code_Subprogram
(Id
: E
; V
: B
:= True) is
3853 pragma Assert
(Is_Subprogram
(Id
));
3854 Set_Flag137
(Id
, V
);
3855 end Set_Is_Machine_Code_Subprogram
;
3857 procedure Set_Is_Non_Static_Subtype
(Id
: E
; V
: B
:= True) is
3859 pragma Assert
(Is_Type
(Id
));
3860 Set_Flag109
(Id
, V
);
3861 end Set_Is_Non_Static_Subtype
;
3863 procedure Set_Is_Null_Init_Proc
(Id
: E
; V
: B
:= True) is
3865 pragma Assert
(Ekind
(Id
) = E_Procedure
);
3866 Set_Flag178
(Id
, V
);
3867 end Set_Is_Null_Init_Proc
;
3869 procedure Set_Is_Obsolescent
(Id
: E
; V
: B
:= True) is
3871 Set_Flag153
(Id
, V
);
3872 end Set_Is_Obsolescent
;
3874 procedure Set_Is_Optional_Parameter
(Id
: E
; V
: B
:= True) is
3876 pragma Assert
(Is_Formal
(Id
));
3877 Set_Flag134
(Id
, V
);
3878 end Set_Is_Optional_Parameter
;
3880 procedure Set_Is_Overriding_Operation
(Id
: E
; V
: B
:= True) is
3882 pragma Assert
(Is_Subprogram
(Id
));
3884 end Set_Is_Overriding_Operation
;
3886 procedure Set_Is_Package_Body_Entity
(Id
: E
; V
: B
:= True) is
3888 Set_Flag160
(Id
, V
);
3889 end Set_Is_Package_Body_Entity
;
3891 procedure Set_Is_Packed
(Id
: E
; V
: B
:= True) is
3893 pragma Assert
(Base_Type
(Id
) = Id
);
3897 procedure Set_Is_Packed_Array_Type
(Id
: E
; V
: B
:= True) is
3899 Set_Flag138
(Id
, V
);
3900 end Set_Is_Packed_Array_Type
;
3902 procedure Set_Is_Potentially_Use_Visible
(Id
: E
; V
: B
:= True) is
3904 pragma Assert
(Nkind
(Id
) in N_Entity
);
3906 end Set_Is_Potentially_Use_Visible
;
3908 procedure Set_Is_Preelaborated
(Id
: E
; V
: B
:= True) is
3911 end Set_Is_Preelaborated
;
3913 procedure Set_Is_Primitive_Wrapper
(Id
: E
; V
: B
:= True) is
3915 pragma Assert
(Ekind
(Id
) = E_Procedure
);
3916 Set_Flag195
(Id
, V
);
3917 end Set_Is_Primitive_Wrapper
;
3919 procedure Set_Is_Private_Composite
(Id
: E
; V
: B
:= True) is
3921 pragma Assert
(Is_Type
(Id
));
3922 Set_Flag107
(Id
, V
);
3923 end Set_Is_Private_Composite
;
3925 procedure Set_Is_Private_Descendant
(Id
: E
; V
: B
:= True) is
3928 end Set_Is_Private_Descendant
;
3930 procedure Set_Is_Protected_Interface
(Id
: E
; V
: B
:= True) is
3932 pragma Assert
(Is_Interface
(Id
));
3933 Set_Flag198
(Id
, V
);
3934 end Set_Is_Protected_Interface
;
3936 procedure Set_Is_Public
(Id
: E
; V
: B
:= True) is
3938 pragma Assert
(Nkind
(Id
) in N_Entity
);
3942 procedure Set_Is_Pure
(Id
: E
; V
: B
:= True) is
3947 procedure Set_Is_Pure_Unit_Access_Type
(Id
: E
; V
: B
:= True) is
3949 pragma Assert
(Is_Access_Type
(Id
));
3950 Set_Flag189
(Id
, V
);
3951 end Set_Is_Pure_Unit_Access_Type
;
3953 procedure Set_Is_Remote_Call_Interface
(Id
: E
; V
: B
:= True) is
3956 end Set_Is_Remote_Call_Interface
;
3958 procedure Set_Is_Remote_Types
(Id
: E
; V
: B
:= True) is
3961 end Set_Is_Remote_Types
;
3963 procedure Set_Is_Renaming_Of_Object
(Id
: E
; V
: B
:= True) is
3965 Set_Flag112
(Id
, V
);
3966 end Set_Is_Renaming_Of_Object
;
3968 procedure Set_Is_Shared_Passive
(Id
: E
; V
: B
:= True) is
3971 end Set_Is_Shared_Passive
;
3973 procedure Set_Is_Statically_Allocated
(Id
: E
; V
: B
:= True) is
3976 (Ekind
(Id
) = E_Exception
3977 or else Ekind
(Id
) = E_Variable
3978 or else Ekind
(Id
) = E_Constant
3979 or else Is_Type
(Id
)
3980 or else Ekind
(Id
) = E_Void
);
3982 end Set_Is_Statically_Allocated
;
3984 procedure Set_Is_Synchronized_Interface
(Id
: E
; V
: B
:= True) is
3986 pragma Assert
(Is_Interface
(Id
));
3987 Set_Flag199
(Id
, V
);
3988 end Set_Is_Synchronized_Interface
;
3990 procedure Set_Is_Tag
(Id
: E
; V
: B
:= True) is
3992 pragma Assert
(Nkind
(Id
) in N_Entity
);
3996 procedure Set_Is_Tagged_Type
(Id
: E
; V
: B
:= True) is
3999 end Set_Is_Tagged_Type
;
4001 procedure Set_Is_Thread_Body
(Id
: E
; V
: B
:= True) is
4004 end Set_Is_Thread_Body
;
4006 procedure Set_Is_Task_Interface
(Id
: E
; V
: B
:= True) is
4008 pragma Assert
(Is_Interface
(Id
));
4009 Set_Flag200
(Id
, V
);
4010 end Set_Is_Task_Interface
;
4012 procedure Set_Is_True_Constant
(Id
: E
; V
: B
:= True) is
4014 Set_Flag163
(Id
, V
);
4015 end Set_Is_True_Constant
;
4017 procedure Set_Is_Unchecked_Union
(Id
: E
; V
: B
:= True) is
4019 pragma Assert
(Base_Type
(Id
) = Id
);
4020 Set_Flag117
(Id
, V
);
4021 end Set_Is_Unchecked_Union
;
4023 procedure Set_Is_Unsigned_Type
(Id
: E
; V
: B
:= True) is
4025 pragma Assert
(Is_Discrete_Or_Fixed_Point_Type
(Id
));
4026 Set_Flag144
(Id
, V
);
4027 end Set_Is_Unsigned_Type
;
4029 procedure Set_Is_Valued_Procedure
(Id
: E
; V
: B
:= True) is
4031 pragma Assert
(Ekind
(Id
) = E_Procedure
);
4032 Set_Flag127
(Id
, V
);
4033 end Set_Is_Valued_Procedure
;
4035 procedure Set_Is_Visible_Child_Unit
(Id
: E
; V
: B
:= True) is
4037 pragma Assert
(Is_Child_Unit
(Id
));
4038 Set_Flag116
(Id
, V
);
4039 end Set_Is_Visible_Child_Unit
;
4041 procedure Set_Is_VMS_Exception
(Id
: E
; V
: B
:= True) is
4043 pragma Assert
(Ekind
(Id
) = E_Exception
);
4044 Set_Flag133
(Id
, V
);
4045 end Set_Is_VMS_Exception
;
4047 procedure Set_Is_Volatile
(Id
: E
; V
: B
:= True) is
4049 pragma Assert
(Nkind
(Id
) in N_Entity
);
4051 end Set_Is_Volatile
;
4053 procedure Set_Itype_Printed
(Id
: E
; V
: B
:= True) is
4055 pragma Assert
(Is_Itype
(Id
));
4056 Set_Flag202
(Id
, V
);
4057 end Set_Itype_Printed
;
4059 procedure Set_Kill_Elaboration_Checks
(Id
: E
; V
: B
:= True) is
4062 end Set_Kill_Elaboration_Checks
;
4064 procedure Set_Kill_Range_Checks
(Id
: E
; V
: B
:= True) is
4067 end Set_Kill_Range_Checks
;
4069 procedure Set_Kill_Tag_Checks
(Id
: E
; V
: B
:= True) is
4072 end Set_Kill_Tag_Checks
;
4074 procedure Set_Last_Entity
(Id
: E
; V
: E
) is
4077 end Set_Last_Entity
;
4079 procedure Set_Limited_View
(Id
: E
; V
: E
) is
4081 pragma Assert
(Ekind
(Id
) = E_Package
);
4083 end Set_Limited_View
;
4085 procedure Set_Lit_Indexes
(Id
: E
; V
: E
) is
4087 pragma Assert
(Is_Enumeration_Type
(Id
) and then Root_Type
(Id
) = Id
);
4089 end Set_Lit_Indexes
;
4091 procedure Set_Lit_Strings
(Id
: E
; V
: E
) is
4093 pragma Assert
(Is_Enumeration_Type
(Id
) and then Root_Type
(Id
) = Id
);
4095 end Set_Lit_Strings
;
4097 procedure Set_Machine_Radix_10
(Id
: E
; V
: B
:= True) is
4099 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
4101 end Set_Machine_Radix_10
;
4103 procedure Set_Master_Id
(Id
: E
; V
: E
) is
4108 procedure Set_Materialize_Entity
(Id
: E
; V
: B
:= True) is
4110 Set_Flag168
(Id
, V
);
4111 end Set_Materialize_Entity
;
4113 procedure Set_Mechanism
(Id
: E
; V
: M
) is
4115 pragma Assert
(Ekind
(Id
) = E_Function
or else Is_Formal
(Id
));
4116 Set_Uint8
(Id
, UI_From_Int
(V
));
4119 procedure Set_Modulus
(Id
: E
; V
: U
) is
4121 pragma Assert
(Ekind
(Id
) = E_Modular_Integer_Type
);
4125 procedure Set_Must_Be_On_Byte_Boundary
(Id
: E
; V
: B
:= True) is
4127 pragma Assert
(Is_Type
(Id
));
4128 Set_Flag183
(Id
, V
);
4129 end Set_Must_Be_On_Byte_Boundary
;
4131 procedure Set_Needs_Debug_Info
(Id
: E
; V
: B
:= True) is
4133 Set_Flag147
(Id
, V
);
4134 end Set_Needs_Debug_Info
;
4136 procedure Set_Needs_No_Actuals
(Id
: E
; V
: B
:= True) is
4139 (Is_Overloadable
(Id
)
4140 or else Ekind
(Id
) = E_Subprogram_Type
4141 or else Ekind
(Id
) = E_Entry_Family
);
4143 end Set_Needs_No_Actuals
;
4145 procedure Set_Never_Set_In_Source
(Id
: E
; V
: B
:= True) is
4147 Set_Flag115
(Id
, V
);
4148 end Set_Never_Set_In_Source
;
4150 procedure Set_Next_Inlined_Subprogram
(Id
: E
; V
: E
) is
4153 end Set_Next_Inlined_Subprogram
;
4155 procedure Set_No_Pool_Assigned
(Id
: E
; V
: B
:= True) is
4157 pragma Assert
(Is_Access_Type
(Id
) and then Base_Type
(Id
) = Id
);
4158 Set_Flag131
(Id
, V
);
4159 end Set_No_Pool_Assigned
;
4161 procedure Set_No_Return
(Id
: E
; V
: B
:= True) is
4165 or else Ekind
(Id
) = E_Procedure
4166 or else Ekind
(Id
) = E_Generic_Procedure
);
4167 Set_Flag113
(Id
, V
);
4170 procedure Set_No_Strict_Aliasing
(Id
: E
; V
: B
:= True) is
4172 pragma Assert
(Is_Access_Type
(Id
) and then Base_Type
(Id
) = Id
);
4173 Set_Flag136
(Id
, V
);
4174 end Set_No_Strict_Aliasing
;
4176 procedure Set_Non_Binary_Modulus
(Id
: E
; V
: B
:= True) is
4178 pragma Assert
(Ekind
(Id
) = E_Modular_Integer_Type
);
4180 end Set_Non_Binary_Modulus
;
4182 procedure Set_Non_Limited_View
(Id
: E
; V
: E
) is
4183 pragma Assert
(False
4184 or else Ekind
(Id
) = E_Incomplete_Type
);
4187 end Set_Non_Limited_View
;
4189 procedure Set_Nonzero_Is_True
(Id
: E
; V
: B
:= True) is
4192 (Root_Type
(Id
) = Standard_Boolean
4193 and then Ekind
(Id
) = E_Enumeration_Type
);
4194 Set_Flag162
(Id
, V
);
4195 end Set_Nonzero_Is_True
;
4197 procedure Set_Normalized_First_Bit
(Id
: E
; V
: U
) is
4200 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
4202 end Set_Normalized_First_Bit
;
4204 procedure Set_Normalized_Position
(Id
: E
; V
: U
) is
4207 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
4209 end Set_Normalized_Position
;
4211 procedure Set_Normalized_Position_Max
(Id
: E
; V
: U
) is
4214 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
4216 end Set_Normalized_Position_Max
;
4218 procedure Set_Object_Ref
(Id
: E
; V
: E
) is
4220 pragma Assert
(Ekind
(Id
) = E_Protected_Body
);
4224 procedure Set_Obsolescent_Warning
(Id
: E
; V
: N
) is
4227 (Is_Subprogram
(Id
) or else Is_Package_Or_Generic_Package
(Id
));
4229 end Set_Obsolescent_Warning
;
4231 procedure Set_Original_Access_Type
(Id
: E
; V
: E
) is
4234 (Ekind
(Id
) = E_Access_Subprogram_Type
4235 or else Ekind
(Id
) = E_Access_Protected_Subprogram_Type
);
4237 end Set_Original_Access_Type
;
4239 procedure Set_Original_Array_Type
(Id
: E
; V
: E
) is
4241 pragma Assert
(Is_Array_Type
(Id
) or else Is_Modular_Integer_Type
(Id
));
4243 end Set_Original_Array_Type
;
4245 procedure Set_Original_Record_Component
(Id
: E
; V
: E
) is
4248 (Ekind
(Id
) = E_Void
4249 or else Ekind
(Id
) = E_Component
4250 or else Ekind
(Id
) = E_Discriminant
);
4252 end Set_Original_Record_Component
;
4254 procedure Set_Overridden_Operation
(Id
: E
; V
: E
) is
4257 end Set_Overridden_Operation
;
4259 procedure Set_Package_Instantiation
(Id
: E
; V
: N
) is
4262 (Ekind
(Id
) = E_Void
4263 or else Ekind
(Id
) = E_Generic_Package
4264 or else Ekind
(Id
) = E_Package
);
4266 end Set_Package_Instantiation
;
4268 procedure Set_Packed_Array_Type
(Id
: E
; V
: E
) is
4270 pragma Assert
(Is_Array_Type
(Id
));
4272 end Set_Packed_Array_Type
;
4274 procedure Set_Parent_Subtype
(Id
: E
; V
: E
) is
4276 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
4278 end Set_Parent_Subtype
;
4280 procedure Set_Primitive_Operations
(Id
: E
; V
: L
) is
4282 pragma Assert
(Is_Tagged_Type
(Id
));
4283 Set_Elist15
(Id
, V
);
4284 end Set_Primitive_Operations
;
4286 procedure Set_Prival
(Id
: E
; V
: E
) is
4288 pragma Assert
(Is_Protected_Private
(Id
));
4292 procedure Set_Privals_Chain
(Id
: E
; V
: L
) is
4294 pragma Assert
(Is_Overloadable
(Id
)
4295 or else Ekind
(Id
) = E_Entry_Family
);
4296 Set_Elist23
(Id
, V
);
4297 end Set_Privals_Chain
;
4299 procedure Set_Private_Dependents
(Id
: E
; V
: L
) is
4301 pragma Assert
(Is_Incomplete_Or_Private_Type
(Id
));
4302 Set_Elist18
(Id
, V
);
4303 end Set_Private_Dependents
;
4305 procedure Set_Private_View
(Id
: E
; V
: N
) is
4307 pragma Assert
(Is_Private_Type
(Id
));
4309 end Set_Private_View
;
4311 procedure Set_Protected_Body_Subprogram
(Id
: E
; V
: E
) is
4313 pragma Assert
(Is_Subprogram
(Id
) or else Is_Entry
(Id
));
4315 end Set_Protected_Body_Subprogram
;
4317 procedure Set_Protected_Formal
(Id
: E
; V
: E
) is
4319 pragma Assert
(Is_Formal
(Id
));
4321 end Set_Protected_Formal
;
4323 procedure Set_Protected_Operation
(Id
: E
; V
: N
) is
4325 pragma Assert
(Is_Protected_Private
(Id
));
4327 end Set_Protected_Operation
;
4329 procedure Set_Reachable
(Id
: E
; V
: B
:= True) is
4334 procedure Set_Referenced
(Id
: E
; V
: B
:= True) is
4336 Set_Flag156
(Id
, V
);
4339 procedure Set_Referenced_As_LHS
(Id
: E
; V
: B
:= True) is
4342 end Set_Referenced_As_LHS
;
4344 procedure Set_Referenced_Object
(Id
: E
; V
: N
) is
4346 pragma Assert
(Is_Type
(Id
));
4348 end Set_Referenced_Object
;
4350 procedure Set_Register_Exception_Call
(Id
: E
; V
: N
) is
4352 pragma Assert
(Ekind
(Id
) = E_Exception
);
4354 end Set_Register_Exception_Call
;
4356 procedure Set_Related_Array_Object
(Id
: E
; V
: E
) is
4358 pragma Assert
(Is_Array_Type
(Id
));
4360 end Set_Related_Array_Object
;
4362 procedure Set_Related_Instance
(Id
: E
; V
: E
) is
4365 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Package_Body
);
4367 end Set_Related_Instance
;
4369 procedure Set_Renamed_Entity
(Id
: E
; V
: N
) is
4372 end Set_Renamed_Entity
;
4374 procedure Set_Renamed_Object
(Id
: E
; V
: N
) is
4377 end Set_Renamed_Object
;
4379 procedure Set_Renaming_Map
(Id
: E
; V
: U
) is
4382 end Set_Renaming_Map
;
4384 procedure Set_Return_Present
(Id
: E
; V
: B
:= True) is
4387 end Set_Return_Present
;
4389 procedure Set_Returns_By_Ref
(Id
: E
; V
: B
:= True) is
4392 end Set_Returns_By_Ref
;
4394 procedure Set_Reverse_Bit_Order
(Id
: E
; V
: B
:= True) is
4397 (Is_Record_Type
(Id
) and then Id
= Base_Type
(Id
));
4398 Set_Flag164
(Id
, V
);
4399 end Set_Reverse_Bit_Order
;
4401 procedure Set_RM_Size
(Id
: E
; V
: U
) is
4403 pragma Assert
(Is_Type
(Id
));
4407 procedure Set_Scalar_Range
(Id
: E
; V
: N
) is
4410 end Set_Scalar_Range
;
4412 procedure Set_Scale_Value
(Id
: E
; V
: U
) is
4415 end Set_Scale_Value
;
4417 procedure Set_Scope_Depth_Value
(Id
: E
; V
: U
) is
4419 pragma Assert
(not Is_Record_Type
(Id
));
4421 end Set_Scope_Depth_Value
;
4423 procedure Set_Sec_Stack_Needed_For_Return
(Id
: E
; V
: B
:= True) is
4425 Set_Flag167
(Id
, V
);
4426 end Set_Sec_Stack_Needed_For_Return
;
4428 procedure Set_Shadow_Entities
(Id
: E
; V
: S
) is
4431 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
4433 end Set_Shadow_Entities
;
4435 procedure Set_Shared_Var_Assign_Proc
(Id
: E
; V
: E
) is
4437 pragma Assert
(Ekind
(Id
) = E_Variable
);
4439 end Set_Shared_Var_Assign_Proc
;
4441 procedure Set_Shared_Var_Read_Proc
(Id
: E
; V
: E
) is
4443 pragma Assert
(Ekind
(Id
) = E_Variable
);
4445 end Set_Shared_Var_Read_Proc
;
4447 procedure Set_Size_Check_Code
(Id
: E
; V
: N
) is
4449 pragma Assert
(Ekind
(Id
) = E_Constant
or else Ekind
(Id
) = E_Variable
);
4451 end Set_Size_Check_Code
;
4453 procedure Set_Size_Depends_On_Discriminant
(Id
: E
; V
: B
:= True) is
4455 Set_Flag177
(Id
, V
);
4456 end Set_Size_Depends_On_Discriminant
;
4458 procedure Set_Size_Known_At_Compile_Time
(Id
: E
; V
: B
:= True) is
4461 end Set_Size_Known_At_Compile_Time
;
4463 procedure Set_Small_Value
(Id
: E
; V
: R
) is
4465 pragma Assert
(Is_Fixed_Point_Type
(Id
));
4466 Set_Ureal21
(Id
, V
);
4467 end Set_Small_Value
;
4469 procedure Set_Spec_Entity
(Id
: E
; V
: E
) is
4471 pragma Assert
(Ekind
(Id
) = E_Package_Body
or else Is_Formal
(Id
));
4473 end Set_Spec_Entity
;
4475 procedure Set_Storage_Size_Variable
(Id
: E
; V
: E
) is
4477 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
4478 pragma Assert
(Base_Type
(Id
) = Id
);
4480 end Set_Storage_Size_Variable
;
4482 procedure Set_Stored_Constraint
(Id
: E
; V
: L
) is
4484 pragma Assert
(Nkind
(Id
) in N_Entity
);
4485 Set_Elist23
(Id
, V
);
4486 end Set_Stored_Constraint
;
4488 procedure Set_Strict_Alignment
(Id
: E
; V
: B
:= True) is
4490 pragma Assert
(Base_Type
(Id
) = Id
);
4491 Set_Flag145
(Id
, V
);
4492 end Set_Strict_Alignment
;
4494 procedure Set_String_Literal_Length
(Id
: E
; V
: U
) is
4496 pragma Assert
(Ekind
(Id
) = E_String_Literal_Subtype
);
4498 end Set_String_Literal_Length
;
4500 procedure Set_String_Literal_Low_Bound
(Id
: E
; V
: N
) is
4502 pragma Assert
(Ekind
(Id
) = E_String_Literal_Subtype
);
4504 end Set_String_Literal_Low_Bound
;
4506 procedure Set_Suppress_Elaboration_Warnings
(Id
: E
; V
: B
:= True) is
4508 Set_Flag148
(Id
, V
);
4509 end Set_Suppress_Elaboration_Warnings
;
4511 procedure Set_Suppress_Init_Proc
(Id
: E
; V
: B
:= True) is
4513 pragma Assert
(Id
= Base_Type
(Id
));
4514 Set_Flag105
(Id
, V
);
4515 end Set_Suppress_Init_Proc
;
4517 procedure Set_Suppress_Style_Checks
(Id
: E
; V
: B
:= True) is
4519 Set_Flag165
(Id
, V
);
4520 end Set_Suppress_Style_Checks
;
4522 procedure Set_Task_Body_Procedure
(Id
: E
; V
: N
) is
4524 pragma Assert
(Ekind
(Id
) = E_Task_Type
4525 or else Ekind
(Id
) = E_Task_Subtype
);
4527 end Set_Task_Body_Procedure
;
4529 procedure Set_Treat_As_Volatile
(Id
: E
; V
: B
:= True) is
4532 end Set_Treat_As_Volatile
;
4534 procedure Set_Underlying_Full_View
(Id
: E
; V
: E
) is
4536 pragma Assert
(Ekind
(Id
) in Private_Kind
);
4538 end Set_Underlying_Full_View
;
4540 procedure Set_Unset_Reference
(Id
: E
; V
: N
) is
4543 end Set_Unset_Reference
;
4545 procedure Set_Uses_Sec_Stack
(Id
: E
; V
: B
:= True) is
4548 end Set_Uses_Sec_Stack
;
4550 procedure Set_Vax_Float
(Id
: E
; V
: B
:= True) is
4552 pragma Assert
(Id
= Base_Type
(Id
));
4553 Set_Flag151
(Id
, V
);
4556 procedure Set_Warnings_Off
(Id
: E
; V
: B
:= True) is
4559 end Set_Warnings_Off
;
4561 procedure Set_Was_Hidden
(Id
: E
; V
: B
:= True) is
4563 Set_Flag196
(Id
, V
);
4566 procedure Set_Wrapped_Entity
(Id
: E
; V
: E
) is
4568 pragma Assert
(Ekind
(Id
) = E_Procedure
4569 and then Is_Primitive_Wrapper
(Id
));
4571 end Set_Wrapped_Entity
;
4573 -----------------------------------
4574 -- Field Initialization Routines --
4575 -----------------------------------
4577 procedure Init_Alignment
(Id
: E
) is
4579 Set_Uint14
(Id
, Uint_0
);
4582 procedure Init_Alignment
(Id
: E
; V
: Int
) is
4584 Set_Uint14
(Id
, UI_From_Int
(V
));
4587 procedure Init_Component_Bit_Offset
(Id
: E
) is
4589 Set_Uint11
(Id
, No_Uint
);
4590 end Init_Component_Bit_Offset
;
4592 procedure Init_Component_Bit_Offset
(Id
: E
; V
: Int
) is
4594 Set_Uint11
(Id
, UI_From_Int
(V
));
4595 end Init_Component_Bit_Offset
;
4597 procedure Init_Component_Size
(Id
: E
) is
4599 Set_Uint22
(Id
, Uint_0
);
4600 end Init_Component_Size
;
4602 procedure Init_Component_Size
(Id
: E
; V
: Int
) is
4604 Set_Uint22
(Id
, UI_From_Int
(V
));
4605 end Init_Component_Size
;
4607 procedure Init_Digits_Value
(Id
: E
) is
4609 Set_Uint17
(Id
, Uint_0
);
4610 end Init_Digits_Value
;
4612 procedure Init_Digits_Value
(Id
: E
; V
: Int
) is
4614 Set_Uint17
(Id
, UI_From_Int
(V
));
4615 end Init_Digits_Value
;
4617 procedure Init_Esize
(Id
: E
) is
4619 Set_Uint12
(Id
, Uint_0
);
4622 procedure Init_Esize
(Id
: E
; V
: Int
) is
4624 Set_Uint12
(Id
, UI_From_Int
(V
));
4627 procedure Init_Normalized_First_Bit
(Id
: E
) is
4629 Set_Uint8
(Id
, No_Uint
);
4630 end Init_Normalized_First_Bit
;
4632 procedure Init_Normalized_First_Bit
(Id
: E
; V
: Int
) is
4634 Set_Uint8
(Id
, UI_From_Int
(V
));
4635 end Init_Normalized_First_Bit
;
4637 procedure Init_Normalized_Position
(Id
: E
) is
4639 Set_Uint14
(Id
, No_Uint
);
4640 end Init_Normalized_Position
;
4642 procedure Init_Normalized_Position
(Id
: E
; V
: Int
) is
4644 Set_Uint14
(Id
, UI_From_Int
(V
));
4645 end Init_Normalized_Position
;
4647 procedure Init_Normalized_Position_Max
(Id
: E
) is
4649 Set_Uint10
(Id
, No_Uint
);
4650 end Init_Normalized_Position_Max
;
4652 procedure Init_Normalized_Position_Max
(Id
: E
; V
: Int
) is
4654 Set_Uint10
(Id
, UI_From_Int
(V
));
4655 end Init_Normalized_Position_Max
;
4657 procedure Init_RM_Size
(Id
: E
) is
4659 Set_Uint13
(Id
, Uint_0
);
4662 procedure Init_RM_Size
(Id
: E
; V
: Int
) is
4664 Set_Uint13
(Id
, UI_From_Int
(V
));
4667 -----------------------------
4668 -- Init_Component_Location --
4669 -----------------------------
4671 procedure Init_Component_Location
(Id
: E
) is
4673 Set_Uint8
(Id
, No_Uint
); -- Normalized_First_Bit
4674 Set_Uint10
(Id
, No_Uint
); -- Normalized_Position_Max
4675 Set_Uint11
(Id
, No_Uint
); -- Component_First_Bit
4676 Set_Uint12
(Id
, Uint_0
); -- Esize
4677 Set_Uint14
(Id
, No_Uint
); -- Normalized_Position
4678 end Init_Component_Location
;
4684 procedure Init_Size
(Id
: E
; V
: Int
) is
4686 Set_Uint12
(Id
, UI_From_Int
(V
)); -- Esize
4687 Set_Uint13
(Id
, UI_From_Int
(V
)); -- RM_Size
4690 ---------------------
4691 -- Init_Size_Align --
4692 ---------------------
4694 procedure Init_Size_Align
(Id
: E
) is
4696 Set_Uint12
(Id
, Uint_0
); -- Esize
4697 Set_Uint13
(Id
, Uint_0
); -- RM_Size
4698 Set_Uint14
(Id
, Uint_0
); -- Alignment
4699 end Init_Size_Align
;
4701 ----------------------------------------------
4702 -- Type Representation Attribute Predicates --
4703 ----------------------------------------------
4705 function Known_Alignment
(E
: Entity_Id
) return B
is
4707 return Uint14
(E
) /= Uint_0
4708 and then Uint14
(E
) /= No_Uint
;
4709 end Known_Alignment
;
4711 function Known_Component_Bit_Offset
(E
: Entity_Id
) return B
is
4713 return Uint11
(E
) /= No_Uint
;
4714 end Known_Component_Bit_Offset
;
4716 function Known_Component_Size
(E
: Entity_Id
) return B
is
4718 return Uint22
(Base_Type
(E
)) /= Uint_0
4719 and then Uint22
(Base_Type
(E
)) /= No_Uint
;
4720 end Known_Component_Size
;
4722 function Known_Esize
(E
: Entity_Id
) return B
is
4724 return Uint12
(E
) /= Uint_0
4725 and then Uint12
(E
) /= No_Uint
;
4728 function Known_Normalized_First_Bit
(E
: Entity_Id
) return B
is
4730 return Uint8
(E
) /= No_Uint
;
4731 end Known_Normalized_First_Bit
;
4733 function Known_Normalized_Position
(E
: Entity_Id
) return B
is
4735 return Uint14
(E
) /= No_Uint
;
4736 end Known_Normalized_Position
;
4738 function Known_Normalized_Position_Max
(E
: Entity_Id
) return B
is
4740 return Uint10
(E
) /= No_Uint
;
4741 end Known_Normalized_Position_Max
;
4743 function Known_RM_Size
(E
: Entity_Id
) return B
is
4745 return Uint13
(E
) /= No_Uint
4746 and then (Uint13
(E
) /= Uint_0
4747 or else Is_Discrete_Type
(E
)
4748 or else Is_Fixed_Point_Type
(E
));
4751 function Known_Static_Component_Bit_Offset
(E
: Entity_Id
) return B
is
4753 return Uint11
(E
) /= No_Uint
4754 and then Uint11
(E
) >= Uint_0
;
4755 end Known_Static_Component_Bit_Offset
;
4757 function Known_Static_Component_Size
(E
: Entity_Id
) return B
is
4759 return Uint22
(Base_Type
(E
)) > Uint_0
;
4760 end Known_Static_Component_Size
;
4762 function Known_Static_Esize
(E
: Entity_Id
) return B
is
4764 return Uint12
(E
) > Uint_0
;
4765 end Known_Static_Esize
;
4767 function Known_Static_Normalized_First_Bit
(E
: Entity_Id
) return B
is
4769 return Uint8
(E
) /= No_Uint
4770 and then Uint8
(E
) >= Uint_0
;
4771 end Known_Static_Normalized_First_Bit
;
4773 function Known_Static_Normalized_Position
(E
: Entity_Id
) return B
is
4775 return Uint14
(E
) /= No_Uint
4776 and then Uint14
(E
) >= Uint_0
;
4777 end Known_Static_Normalized_Position
;
4779 function Known_Static_Normalized_Position_Max
(E
: Entity_Id
) return B
is
4781 return Uint10
(E
) /= No_Uint
4782 and then Uint10
(E
) >= Uint_0
;
4783 end Known_Static_Normalized_Position_Max
;
4785 function Known_Static_RM_Size
(E
: Entity_Id
) return B
is
4787 return Uint13
(E
) > Uint_0
4788 or else Is_Discrete_Type
(E
)
4789 or else Is_Fixed_Point_Type
(E
);
4790 end Known_Static_RM_Size
;
4792 function Unknown_Alignment
(E
: Entity_Id
) return B
is
4794 return Uint14
(E
) = Uint_0
4795 or else Uint14
(E
) = No_Uint
;
4796 end Unknown_Alignment
;
4798 function Unknown_Component_Bit_Offset
(E
: Entity_Id
) return B
is
4800 return Uint11
(E
) = No_Uint
;
4801 end Unknown_Component_Bit_Offset
;
4803 function Unknown_Component_Size
(E
: Entity_Id
) return B
is
4805 return Uint22
(Base_Type
(E
)) = Uint_0
4807 Uint22
(Base_Type
(E
)) = No_Uint
;
4808 end Unknown_Component_Size
;
4810 function Unknown_Esize
(E
: Entity_Id
) return B
is
4812 return Uint12
(E
) = No_Uint
4814 Uint12
(E
) = Uint_0
;
4817 function Unknown_Normalized_First_Bit
(E
: Entity_Id
) return B
is
4819 return Uint8
(E
) = No_Uint
;
4820 end Unknown_Normalized_First_Bit
;
4822 function Unknown_Normalized_Position
(E
: Entity_Id
) return B
is
4824 return Uint14
(E
) = No_Uint
;
4825 end Unknown_Normalized_Position
;
4827 function Unknown_Normalized_Position_Max
(E
: Entity_Id
) return B
is
4829 return Uint10
(E
) = No_Uint
;
4830 end Unknown_Normalized_Position_Max
;
4832 function Unknown_RM_Size
(E
: Entity_Id
) return B
is
4834 return (Uint13
(E
) = Uint_0
4835 and then not Is_Discrete_Type
(E
)
4836 and then not Is_Fixed_Point_Type
(E
))
4837 or else Uint13
(E
) = No_Uint
;
4838 end Unknown_RM_Size
;
4840 --------------------
4841 -- Address_Clause --
4842 --------------------
4844 function Address_Clause
(Id
: E
) return N
is
4846 return Rep_Clause
(Id
, Name_Address
);
4849 ----------------------
4850 -- Alignment_Clause --
4851 ----------------------
4853 function Alignment_Clause
(Id
: E
) return N
is
4855 return Rep_Clause
(Id
, Name_Alignment
);
4856 end Alignment_Clause
;
4858 ----------------------
4859 -- Ancestor_Subtype --
4860 ----------------------
4862 function Ancestor_Subtype
(Id
: E
) return E
is
4864 -- If this is first subtype, or is a base type, then there is no
4865 -- ancestor subtype, so we return Empty to indicate this fact.
4867 if Is_First_Subtype
(Id
) or else Id
= Base_Type
(Id
) then
4872 D
: constant Node_Id
:= Declaration_Node
(Id
);
4875 -- If we have a subtype declaration, get the ancestor subtype
4877 if Nkind
(D
) = N_Subtype_Declaration
then
4878 if Nkind
(Subtype_Indication
(D
)) = N_Subtype_Indication
then
4879 return Entity
(Subtype_Mark
(Subtype_Indication
(D
)));
4881 return Entity
(Subtype_Indication
(D
));
4884 -- If not, then no subtype indication is available
4890 end Ancestor_Subtype
;
4896 procedure Append_Entity
(Id
: Entity_Id
; V
: Entity_Id
) is
4898 if Last_Entity
(V
) = Empty
then
4899 Set_First_Entity
(V
, Id
);
4901 Set_Next_Entity
(Last_Entity
(V
), Id
);
4904 Set_Next_Entity
(Id
, Empty
);
4906 Set_Last_Entity
(V
, Id
);
4913 function Base_Type
(Id
: E
) return E
is
4916 when E_Enumeration_Subtype |
4918 E_Signed_Integer_Subtype |
4919 E_Modular_Integer_Subtype |
4920 E_Floating_Point_Subtype |
4921 E_Ordinary_Fixed_Point_Subtype |
4922 E_Decimal_Fixed_Point_Subtype |
4927 E_Record_Subtype_With_Private |
4928 E_Limited_Private_Subtype |
4930 E_Protected_Subtype |
4932 E_String_Literal_Subtype |
4933 E_Class_Wide_Subtype
=>
4941 -------------------------
4942 -- Component_Alignment --
4943 -------------------------
4945 -- Component Alignment is encoded using two flags, Flag128/129 as
4946 -- follows. Note that both flags False = Align_Default, so that the
4947 -- default initialization of flags to False initializes component
4948 -- alignment to the default value as required.
4950 -- Flag128 Flag129 Value
4951 -- ------- ------- -----
4952 -- False False Calign_Default
4953 -- False True Calign_Component_Size
4954 -- True False Calign_Component_Size_4
4955 -- True True Calign_Storage_Unit
4957 function Component_Alignment
(Id
: E
) return C
is
4958 BT
: constant Node_Id
:= Base_Type
(Id
);
4961 pragma Assert
(Is_Array_Type
(Id
) or else Is_Record_Type
(Id
));
4963 if Flag128
(BT
) then
4964 if Flag129
(BT
) then
4965 return Calign_Storage_Unit
;
4967 return Calign_Component_Size_4
;
4971 if Flag129
(BT
) then
4972 return Calign_Component_Size
;
4974 return Calign_Default
;
4977 end Component_Alignment
;
4979 --------------------
4980 -- Constant_Value --
4981 --------------------
4983 function Constant_Value
(Id
: E
) return N
is
4984 D
: constant Node_Id
:= Declaration_Node
(Id
);
4988 -- If we have no declaration node, then return no constant value.
4989 -- Not clear how this can happen, but it does sometimes ???
4990 -- To investigate, remove this check and compile discrim_po.adb.
4995 -- Normal case where a declaration node is present
4997 elsif Nkind
(D
) = N_Object_Renaming_Declaration
then
4998 return Renamed_Object
(Id
);
5000 -- If this is a component declaration whose entity is constant, it
5001 -- is a prival within a protected function. It does not have
5002 -- a constant value.
5004 elsif Nkind
(D
) = N_Component_Declaration
then
5007 -- If there is an expression, return it
5009 elsif Present
(Expression
(D
)) then
5010 return (Expression
(D
));
5012 -- For a constant, see if we have a full view
5014 elsif Ekind
(Id
) = E_Constant
5015 and then Present
(Full_View
(Id
))
5017 Full_D
:= Parent
(Full_View
(Id
));
5019 -- The full view may have been rewritten as an object renaming
5021 if Nkind
(Full_D
) = N_Object_Renaming_Declaration
then
5022 return Name
(Full_D
);
5024 return Expression
(Full_D
);
5027 -- Otherwise we have no expression to return
5034 ----------------------
5035 -- Declaration_Node --
5036 ----------------------
5038 function Declaration_Node
(Id
: E
) return N
is
5042 if Ekind
(Id
) = E_Incomplete_Type
5043 and then Present
(Full_View
(Id
))
5045 P
:= Parent
(Full_View
(Id
));
5051 if Nkind
(P
) /= N_Selected_Component
5052 and then Nkind
(P
) /= N_Expanded_Name
5054 not (Nkind
(P
) = N_Defining_Program_Unit_Name
5055 and then Is_Child_Unit
(Id
))
5063 end Declaration_Node
;
5065 ---------------------
5066 -- Designated_Type --
5067 ---------------------
5069 function Designated_Type
(Id
: E
) return E
is
5073 Desig_Type
:= Directly_Designated_Type
(Id
);
5075 if Ekind
(Desig_Type
) = E_Incomplete_Type
5076 and then Present
(Full_View
(Desig_Type
))
5078 return Full_View
(Desig_Type
);
5080 elsif Is_Class_Wide_Type
(Desig_Type
)
5081 and then Ekind
(Etype
(Desig_Type
)) = E_Incomplete_Type
5082 and then Present
(Full_View
(Etype
(Desig_Type
)))
5083 and then Present
(Class_Wide_Type
(Full_View
(Etype
(Desig_Type
))))
5085 return Class_Wide_Type
(Full_View
(Etype
(Desig_Type
)));
5090 end Designated_Type
;
5092 -----------------------------
5093 -- Enclosing_Dynamic_Scope --
5094 -----------------------------
5096 function Enclosing_Dynamic_Scope
(Id
: E
) return E
is
5100 -- The following test is an error defense against some syntax
5101 -- errors that can leave scopes very messed up.
5103 if Id
= Standard_Standard
then
5107 -- Normal case, search enclosing scopes
5110 while S
/= Standard_Standard
5111 and then not Is_Dynamic_Scope
(S
)
5117 end Enclosing_Dynamic_Scope
;
5119 ----------------------
5120 -- Entry_Index_Type --
5121 ----------------------
5123 function Entry_Index_Type
(Id
: E
) return N
is
5125 pragma Assert
(Ekind
(Id
) = E_Entry_Family
);
5126 return Etype
(Discrete_Subtype_Definition
(Parent
(Id
)));
5127 end Entry_Index_Type
;
5129 ---------------------
5131 ---------------------
5133 function First_Component
(Id
: E
) return E
is
5138 (Is_Record_Type
(Id
) or else Is_Incomplete_Or_Private_Type
(Id
));
5140 Comp_Id
:= First_Entity
(Id
);
5141 while Present
(Comp_Id
) loop
5142 exit when Ekind
(Comp_Id
) = E_Component
;
5143 Comp_Id
:= Next_Entity
(Comp_Id
);
5147 end First_Component
;
5149 ------------------------
5150 -- First_Discriminant --
5151 ------------------------
5153 function First_Discriminant
(Id
: E
) return E
is
5158 (Has_Discriminants
(Id
)
5159 or else Has_Unknown_Discriminants
(Id
));
5161 Ent
:= First_Entity
(Id
);
5163 -- The discriminants are not necessarily contiguous, because access
5164 -- discriminants will generate itypes. They are not the first entities
5165 -- either, because tag and controller record must be ahead of them.
5167 if Chars
(Ent
) = Name_uTag
then
5168 Ent
:= Next_Entity
(Ent
);
5171 if Chars
(Ent
) = Name_uController
then
5172 Ent
:= Next_Entity
(Ent
);
5175 -- Skip all hidden stored discriminants if any
5177 while Present
(Ent
) loop
5178 exit when Ekind
(Ent
) = E_Discriminant
5179 and then not Is_Completely_Hidden
(Ent
);
5181 Ent
:= Next_Entity
(Ent
);
5184 pragma Assert
(Ekind
(Ent
) = E_Discriminant
);
5187 end First_Discriminant
;
5193 function First_Formal
(Id
: E
) return E
is
5198 (Is_Overloadable
(Id
)
5199 or else Ekind
(Id
) = E_Entry_Family
5200 or else Ekind
(Id
) = E_Subprogram_Body
5201 or else Ekind
(Id
) = E_Subprogram_Type
);
5203 if Ekind
(Id
) = E_Enumeration_Literal
then
5207 Formal
:= First_Entity
(Id
);
5209 if Present
(Formal
) and then Is_Formal
(Formal
) then
5217 -------------------------------
5218 -- First_Stored_Discriminant --
5219 -------------------------------
5221 function First_Stored_Discriminant
(Id
: E
) return E
is
5224 function Has_Completely_Hidden_Discriminant
(Id
: E
) return Boolean;
5225 -- Scans the Discriminants to see whether any are Completely_Hidden
5226 -- (the mechanism for describing non-specified stored discriminants)
5228 ----------------------------------------
5229 -- Has_Completely_Hidden_Discriminant --
5230 ----------------------------------------
5232 function Has_Completely_Hidden_Discriminant
(Id
: E
) return Boolean is
5233 Ent
: Entity_Id
:= Id
;
5236 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
5238 while Present
(Ent
) and then Ekind
(Ent
) = E_Discriminant
loop
5239 if Is_Completely_Hidden
(Ent
) then
5243 Ent
:= Next_Entity
(Ent
);
5247 end Has_Completely_Hidden_Discriminant
;
5249 -- Start of processing for First_Stored_Discriminant
5253 (Has_Discriminants
(Id
)
5254 or else Has_Unknown_Discriminants
(Id
));
5256 Ent
:= First_Entity
(Id
);
5258 if Chars
(Ent
) = Name_uTag
then
5259 Ent
:= Next_Entity
(Ent
);
5262 if Chars
(Ent
) = Name_uController
then
5263 Ent
:= Next_Entity
(Ent
);
5266 if Has_Completely_Hidden_Discriminant
(Ent
) then
5268 while Present
(Ent
) loop
5269 exit when Is_Completely_Hidden
(Ent
);
5270 Ent
:= Next_Entity
(Ent
);
5275 pragma Assert
(Ekind
(Ent
) = E_Discriminant
);
5278 end First_Stored_Discriminant
;
5284 function First_Subtype
(Id
: E
) return E
is
5285 B
: constant Entity_Id
:= Base_Type
(Id
);
5286 F
: constant Node_Id
:= Freeze_Node
(B
);
5290 -- If the base type has no freeze node, it is a type in standard,
5291 -- and always acts as its own first subtype unless it is one of
5292 -- the predefined integer types. If the type is formal, it is also
5293 -- a first subtype, and its base type has no freeze node. On the other
5294 -- hand, a subtype of a generic formal is not its own first_subtype.
5295 -- Its base type, if anonymous, is attached to the formal type decl.
5296 -- from which the first subtype is obtained.
5300 if B
= Base_Type
(Standard_Integer
) then
5301 return Standard_Integer
;
5303 elsif B
= Base_Type
(Standard_Long_Integer
) then
5304 return Standard_Long_Integer
;
5306 elsif B
= Base_Type
(Standard_Short_Short_Integer
) then
5307 return Standard_Short_Short_Integer
;
5309 elsif B
= Base_Type
(Standard_Short_Integer
) then
5310 return Standard_Short_Integer
;
5312 elsif B
= Base_Type
(Standard_Long_Long_Integer
) then
5313 return Standard_Long_Long_Integer
;
5315 elsif Is_Generic_Type
(Id
) then
5316 if Present
(Parent
(B
)) then
5317 return Defining_Identifier
(Parent
(B
));
5319 return Defining_Identifier
(Associated_Node_For_Itype
(B
));
5326 -- Otherwise we check the freeze node, if it has a First_Subtype_Link
5327 -- then we use that link, otherwise (happens with some Itypes), we use
5328 -- the base type itself.
5331 Ent
:= First_Subtype_Link
(F
);
5333 if Present
(Ent
) then
5341 -------------------------------------
5342 -- Get_Attribute_Definition_Clause --
5343 -------------------------------------
5345 function Get_Attribute_Definition_Clause
5347 Id
: Attribute_Id
) return Node_Id
5352 N
:= First_Rep_Item
(E
);
5353 while Present
(N
) loop
5354 if Nkind
(N
) = N_Attribute_Definition_Clause
5355 and then Get_Attribute_Id
(Chars
(N
)) = Id
5364 end Get_Attribute_Definition_Clause
;
5366 --------------------
5367 -- Get_Rep_Pragma --
5368 --------------------
5370 function Get_Rep_Pragma
(E
: Entity_Id
; Nam
: Name_Id
) return Node_Id
is
5374 N
:= First_Rep_Item
(E
);
5375 while Present
(N
) loop
5376 if Nkind
(N
) = N_Pragma
and then Chars
(N
) = Nam
then
5386 ------------------------
5387 -- Has_Attach_Handler --
5388 ------------------------
5390 function Has_Attach_Handler
(Id
: E
) return B
is
5394 pragma Assert
(Is_Protected_Type
(Id
));
5396 Ritem
:= First_Rep_Item
(Id
);
5397 while Present
(Ritem
) loop
5398 if Nkind
(Ritem
) = N_Pragma
5399 and then Chars
(Ritem
) = Name_Attach_Handler
5403 Ritem
:= Next_Rep_Item
(Ritem
);
5408 end Has_Attach_Handler
;
5410 -------------------------------------
5411 -- Has_Attribute_Definition_Clause --
5412 -------------------------------------
5414 function Has_Attribute_Definition_Clause
5416 Id
: Attribute_Id
) return Boolean
5419 return Present
(Get_Attribute_Definition_Clause
(E
, Id
));
5420 end Has_Attribute_Definition_Clause
;
5426 function Has_Entries
(Id
: E
) return B
is
5427 Result
: Boolean := False;
5431 pragma Assert
(Is_Concurrent_Type
(Id
));
5433 Ent
:= First_Entity
(Id
);
5434 while Present
(Ent
) loop
5435 if Is_Entry
(Ent
) then
5440 Ent
:= Next_Entity
(Ent
);
5446 ----------------------------
5447 -- Has_Foreign_Convention --
5448 ----------------------------
5450 function Has_Foreign_Convention
(Id
: E
) return B
is
5452 return Convention
(Id
) >= Foreign_Convention
'First;
5453 end Has_Foreign_Convention
;
5455 ---------------------------
5456 -- Has_Interrupt_Handler --
5457 ---------------------------
5459 function Has_Interrupt_Handler
(Id
: E
) return B
is
5463 pragma Assert
(Is_Protected_Type
(Id
));
5465 Ritem
:= First_Rep_Item
(Id
);
5466 while Present
(Ritem
) loop
5467 if Nkind
(Ritem
) = N_Pragma
5468 and then Chars
(Ritem
) = Name_Interrupt_Handler
5472 Ritem
:= Next_Rep_Item
(Ritem
);
5477 end Has_Interrupt_Handler
;
5479 --------------------------
5480 -- Has_Private_Ancestor --
5481 --------------------------
5483 function Has_Private_Ancestor
(Id
: E
) return B
is
5484 R
: constant Entity_Id
:= Root_Type
(Id
);
5485 T1
: Entity_Id
:= Id
;
5489 if Is_Private_Type
(T1
) then
5499 end Has_Private_Ancestor
;
5501 --------------------
5502 -- Has_Rep_Pragma --
5503 --------------------
5505 function Has_Rep_Pragma
(E
: Entity_Id
; Nam
: Name_Id
) return Boolean is
5507 return Present
(Get_Rep_Pragma
(E
, Nam
));
5510 ------------------------------
5511 -- Implementation_Base_Type --
5512 ------------------------------
5514 function Implementation_Base_Type
(Id
: E
) return E
is
5519 Bastyp
:= Base_Type
(Id
);
5521 if Is_Incomplete_Or_Private_Type
(Bastyp
) then
5522 Imptyp
:= Underlying_Type
(Bastyp
);
5524 -- If we have an implementation type, then just return it,
5525 -- otherwise we return the Base_Type anyway. This can only
5526 -- happen in error situations and should avoid some error bombs.
5528 if Present
(Imptyp
) then
5529 return Base_Type
(Imptyp
);
5537 end Implementation_Base_Type
;
5539 -----------------------
5540 -- Is_Always_Inlined --
5541 -----------------------
5543 function Is_Always_Inlined
(Id
: E
) return B
is
5547 Item
:= First_Rep_Item
(Id
);
5548 while Present
(Item
) loop
5549 if Nkind
(Item
) = N_Pragma
5550 and then Get_Pragma_Id
(Chars
(Item
)) = Pragma_Inline_Always
5555 Next_Rep_Item
(Item
);
5559 end Is_Always_Inlined
;
5561 ---------------------
5562 -- Is_Boolean_Type --
5563 ---------------------
5565 function Is_Boolean_Type
(Id
: E
) return B
is
5567 return Root_Type
(Id
) = Standard_Boolean
;
5568 end Is_Boolean_Type
;
5570 ---------------------
5571 -- Is_By_Copy_Type --
5572 ---------------------
5574 function Is_By_Copy_Type
(Id
: E
) return B
is
5576 -- If Id is a private type whose full declaration has not been seen,
5577 -- we assume for now that it is not a By_Copy type. Clearly this
5578 -- attribute should not be used before the type is frozen, but it is
5579 -- needed to build the associated record of a protected type. Another
5580 -- place where some lookahead for a full view is needed ???
5583 Is_Elementary_Type
(Id
)
5584 or else (Is_Private_Type
(Id
)
5585 and then Present
(Underlying_Type
(Id
))
5586 and then Is_Elementary_Type
(Underlying_Type
(Id
)));
5587 end Is_By_Copy_Type
;
5589 --------------------------
5590 -- Is_By_Reference_Type --
5591 --------------------------
5593 function Is_By_Reference_Type
(Id
: E
) return B
is
5594 Btype
: constant Entity_Id
:= Base_Type
(Id
);
5597 if Error_Posted
(Id
)
5598 or else Error_Posted
(Btype
)
5602 elsif Is_Private_Type
(Btype
) then
5604 Utyp
: constant Entity_Id
:= Underlying_Type
(Btype
);
5610 return Is_By_Reference_Type
(Utyp
);
5614 elsif Is_Concurrent_Type
(Btype
) then
5617 elsif Is_Record_Type
(Btype
) then
5618 if Is_Limited_Record
(Btype
)
5619 or else Is_Tagged_Type
(Btype
)
5620 or else Is_Volatile
(Btype
)
5629 C
:= First_Component
(Btype
);
5630 while Present
(C
) loop
5631 if Is_By_Reference_Type
(Etype
(C
))
5632 or else Is_Volatile
(Etype
(C
))
5637 C
:= Next_Component
(C
);
5644 elsif Is_Array_Type
(Btype
) then
5647 or else Is_By_Reference_Type
(Component_Type
(Btype
))
5648 or else Is_Volatile
(Component_Type
(Btype
))
5649 or else Has_Volatile_Components
(Btype
);
5654 end Is_By_Reference_Type
;
5656 ---------------------
5657 -- Is_Derived_Type --
5658 ---------------------
5660 function Is_Derived_Type
(Id
: E
) return B
is
5664 if Base_Type
(Id
) /= Root_Type
(Id
)
5665 and then not Is_Generic_Type
(Id
)
5666 and then not Is_Class_Wide_Type
(Id
)
5668 if not Is_Numeric_Type
(Root_Type
(Id
)) then
5672 Par
:= Parent
(First_Subtype
(Id
));
5674 return Present
(Par
)
5675 and then Nkind
(Par
) = N_Full_Type_Declaration
5676 and then Nkind
(Type_Definition
(Par
))
5677 = N_Derived_Type_Definition
;
5683 end Is_Derived_Type
;
5685 ----------------------
5686 -- Is_Dynamic_Scope --
5687 ----------------------
5689 function Is_Dynamic_Scope
(Id
: E
) return B
is
5692 Ekind
(Id
) = E_Block
5694 Ekind
(Id
) = E_Function
5696 Ekind
(Id
) = E_Procedure
5698 Ekind
(Id
) = E_Subprogram_Body
5700 Ekind
(Id
) = E_Task_Type
5702 Ekind
(Id
) = E_Entry
5704 Ekind
(Id
) = E_Entry_Family
;
5705 end Is_Dynamic_Scope
;
5707 --------------------
5708 -- Is_Entity_Name --
5709 --------------------
5711 function Is_Entity_Name
(N
: Node_Id
) return Boolean is
5712 Kind
: constant Node_Kind
:= Nkind
(N
);
5715 -- Identifiers, operator symbols, expanded names are entity names
5717 return Kind
= N_Identifier
5718 or else Kind
= N_Operator_Symbol
5719 or else Kind
= N_Expanded_Name
5721 -- Attribute references are entity names if they refer to an entity.
5722 -- Note that we don't do this by testing for the presence of the
5723 -- Entity field in the N_Attribute_Reference node, since it may not
5724 -- have been set yet.
5726 or else (Kind
= N_Attribute_Reference
5727 and then Is_Entity_Attribute_Name
(Attribute_Name
(N
)));
5730 ---------------------------
5731 -- Is_Indefinite_Subtype --
5732 ---------------------------
5734 function Is_Indefinite_Subtype
(Id
: Entity_Id
) return B
is
5735 K
: constant Entity_Kind
:= Ekind
(Id
);
5738 if Is_Constrained
(Id
) then
5741 elsif K
in Array_Kind
5742 or else K
in Class_Wide_Kind
5743 or else Has_Unknown_Discriminants
(Id
)
5747 -- Known discriminants: indefinite if there are no default values
5749 elsif K
in Record_Kind
5750 or else Is_Incomplete_Or_Private_Type
(Id
)
5751 or else Is_Concurrent_Type
(Id
)
5753 return (Has_Discriminants
(Id
)
5754 and then No
(Discriminant_Default_Value
(First_Discriminant
(Id
))));
5759 end Is_Indefinite_Subtype
;
5761 ---------------------
5762 -- Is_Limited_Type --
5763 ---------------------
5765 function Is_Limited_Type
(Id
: E
) return B
is
5766 Btype
: constant E
:= Base_Type
(Id
);
5767 Rtype
: constant E
:= Root_Type
(Btype
);
5770 if not Is_Type
(Id
) then
5773 elsif Ekind
(Btype
) = E_Limited_Private_Type
5774 or else Is_Limited_Composite
(Btype
)
5778 elsif Is_Concurrent_Type
(Btype
) then
5781 -- The Is_Limited_Record flag normally indicates that the type is
5782 -- limited. The exception is that a type does not inherit limitedness
5783 -- from its interface ancestor. So the type may be derived from a
5784 -- limited interface, but is not limited.
5786 elsif Is_Limited_Record
(Id
)
5787 and then not Is_Interface
(Id
)
5791 -- Otherwise we will look around to see if there is some other reason
5792 -- for it to be limited, except that if an error was posted on the
5793 -- entity, then just assume it is non-limited, because it can cause
5794 -- trouble to recurse into a murky erroneous entity!
5796 elsif Error_Posted
(Id
) then
5799 elsif Is_Record_Type
(Btype
) then
5801 -- AI-419: limitedness is not inherited from a limited interface
5803 if Is_Limited_Record
(Rtype
) then
5804 return not Is_Interface
(Rtype
)
5805 or else Is_Protected_Interface
(Rtype
)
5806 or else Is_Synchronized_Interface
(Rtype
)
5807 or else Is_Task_Interface
(Rtype
);
5809 elsif Is_Class_Wide_Type
(Btype
) then
5810 return Is_Limited_Type
(Rtype
);
5817 C
:= First_Component
(Btype
);
5818 while Present
(C
) loop
5819 if Is_Limited_Type
(Etype
(C
)) then
5823 C
:= Next_Component
(C
);
5830 elsif Is_Array_Type
(Btype
) then
5831 return Is_Limited_Type
(Component_Type
(Btype
));
5836 end Is_Limited_Type
;
5838 -----------------------------------
5839 -- Is_Package_Or_Generic_Package --
5840 -----------------------------------
5842 function Is_Package_Or_Generic_Package
(Id
: E
) return B
is
5845 Ekind
(Id
) = E_Package
5847 Ekind
(Id
) = E_Generic_Package
;
5848 end Is_Package_Or_Generic_Package
;
5850 --------------------------
5851 -- Is_Protected_Private --
5852 --------------------------
5854 function Is_Protected_Private
(Id
: E
) return B
is
5856 pragma Assert
(Ekind
(Id
) = E_Component
);
5857 return Is_Protected_Type
(Scope
(Id
));
5858 end Is_Protected_Private
;
5860 ------------------------------
5861 -- Is_Protected_Record_Type --
5862 ------------------------------
5864 function Is_Protected_Record_Type
(Id
: E
) return B
is
5867 Is_Concurrent_Record_Type
(Id
)
5868 and then Is_Protected_Type
(Corresponding_Concurrent_Type
(Id
));
5869 end Is_Protected_Record_Type
;
5871 ---------------------------------
5872 -- Is_Return_By_Reference_Type --
5873 ---------------------------------
5875 -- Note: this predicate has disappeared from Ada 2005: see AI-318-2
5877 function Is_Return_By_Reference_Type
(Id
: E
) return B
is
5878 Btype
: constant Entity_Id
:= Base_Type
(Id
);
5881 if Is_Private_Type
(Btype
) then
5883 Utyp
: constant Entity_Id
:= Underlying_Type
(Btype
);
5888 return Is_Return_By_Reference_Type
(Utyp
);
5892 elsif Is_Concurrent_Type
(Btype
) then
5895 elsif Is_Record_Type
(Btype
) then
5896 if Is_Limited_Record
(Btype
) then
5897 return not Is_Interface
(Btype
)
5898 or else Is_Protected_Interface
(Btype
)
5899 or else Is_Synchronized_Interface
(Btype
)
5900 or else Is_Task_Interface
(Btype
);
5902 elsif Is_Class_Wide_Type
(Btype
) then
5903 return Is_Return_By_Reference_Type
(Root_Type
(Btype
));
5910 C
:= First_Component
(Btype
);
5911 while Present
(C
) loop
5912 if Is_Return_By_Reference_Type
(Etype
(C
)) then
5916 C
:= Next_Component
(C
);
5923 elsif Is_Array_Type
(Btype
) then
5924 return Is_Return_By_Reference_Type
(Component_Type
(Btype
));
5929 end Is_Return_By_Reference_Type
;
5931 --------------------
5932 -- Is_String_Type --
5933 --------------------
5935 function Is_String_Type
(Id
: E
) return B
is
5937 return Ekind
(Id
) in String_Kind
5938 or else (Is_Array_Type
(Id
)
5939 and then Number_Dimensions
(Id
) = 1
5940 and then Is_Character_Type
(Component_Type
(Id
)));
5943 -------------------------
5944 -- Is_Task_Record_Type --
5945 -------------------------
5947 function Is_Task_Record_Type
(Id
: E
) return B
is
5950 Is_Concurrent_Record_Type
(Id
)
5951 and then Is_Task_Type
(Corresponding_Concurrent_Type
(Id
));
5952 end Is_Task_Record_Type
;
5954 ------------------------
5955 -- Is_Wrapper_Package --
5956 ------------------------
5958 function Is_Wrapper_Package
(Id
: E
) return B
is
5960 return (Ekind
(Id
) = E_Package
5961 and then Present
(Related_Instance
(Id
)));
5962 end Is_Wrapper_Package
;
5964 --------------------
5965 -- Next_Component --
5966 --------------------
5968 function Next_Component
(Id
: E
) return E
is
5972 Comp_Id
:= Next_Entity
(Id
);
5973 while Present
(Comp_Id
) loop
5974 exit when Ekind
(Comp_Id
) = E_Component
;
5975 Comp_Id
:= Next_Entity
(Comp_Id
);
5981 -----------------------
5982 -- Next_Discriminant --
5983 -----------------------
5985 -- This function actually implements both Next_Discriminant and
5986 -- Next_Stored_Discriminant by making sure that the Discriminant
5987 -- returned is of the same variety as Id.
5989 function Next_Discriminant
(Id
: E
) return E
is
5991 -- Derived Tagged types with private extensions look like this...
5993 -- E_Discriminant d1
5994 -- E_Discriminant d2
5996 -- E_Discriminant d1
5997 -- E_Discriminant d2
6000 -- so it is critical not to go past the leading discriminants
6005 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
6008 D
:= Next_Entity
(D
);
6010 or else (Ekind
(D
) /= E_Discriminant
6011 and then not Is_Itype
(D
))
6016 exit when Ekind
(D
) = E_Discriminant
6017 and then (Is_Completely_Hidden
(D
) = Is_Completely_Hidden
(Id
));
6021 end Next_Discriminant
;
6027 function Next_Formal
(Id
: E
) return E
is
6031 -- Follow the chain of declared entities as long as the kind of
6032 -- the entity corresponds to a formal parameter. Skip internal
6033 -- entities that may have been created for implicit subtypes,
6034 -- in the process of analyzing default expressions.
6039 P
:= Next_Entity
(P
);
6041 if No
(P
) or else Is_Formal
(P
) then
6043 elsif not Is_Internal
(P
) then
6049 -----------------------------
6050 -- Next_Formal_With_Extras --
6051 -----------------------------
6053 function Next_Formal_With_Extras
(Id
: E
) return E
is
6055 if Present
(Extra_Formal
(Id
)) then
6056 return Extra_Formal
(Id
);
6058 return Next_Formal
(Id
);
6060 end Next_Formal_With_Extras
;
6066 function Next_Index
(Id
: Node_Id
) return Node_Id
is
6075 function Next_Literal
(Id
: E
) return E
is
6077 pragma Assert
(Nkind
(Id
) in N_Entity
);
6081 ------------------------------
6082 -- Next_Stored_Discriminant --
6083 ------------------------------
6085 function Next_Stored_Discriminant
(Id
: E
) return E
is
6087 -- See comment in Next_Discriminant
6089 return Next_Discriminant
(Id
);
6090 end Next_Stored_Discriminant
;
6092 -----------------------
6093 -- Number_Dimensions --
6094 -----------------------
6096 function Number_Dimensions
(Id
: E
) return Pos
is
6101 if Ekind
(Id
) in String_Kind
then
6106 T
:= First_Index
(Id
);
6107 while Present
(T
) loop
6114 end Number_Dimensions
;
6116 --------------------------
6117 -- Number_Discriminants --
6118 --------------------------
6120 function Number_Discriminants
(Id
: E
) return Pos
is
6126 Discr
:= First_Discriminant
(Id
);
6127 while Present
(Discr
) loop
6129 Discr
:= Next_Discriminant
(Discr
);
6133 end Number_Discriminants
;
6135 --------------------
6136 -- Number_Entries --
6137 --------------------
6139 function Number_Entries
(Id
: E
) return Nat
is
6144 pragma Assert
(Is_Concurrent_Type
(Id
));
6147 Ent
:= First_Entity
(Id
);
6148 while Present
(Ent
) loop
6149 if Is_Entry
(Ent
) then
6153 Ent
:= Next_Entity
(Ent
);
6159 --------------------
6160 -- Number_Formals --
6161 --------------------
6163 function Number_Formals
(Id
: E
) return Pos
is
6169 Formal
:= First_Formal
(Id
);
6170 while Present
(Formal
) loop
6172 Formal
:= Next_Formal
(Formal
);
6178 --------------------
6179 -- Parameter_Mode --
6180 --------------------
6182 function Parameter_Mode
(Id
: E
) return Formal_Kind
is
6187 ---------------------
6188 -- Record_Rep_Item --
6189 ---------------------
6191 procedure Record_Rep_Item
(E
: Entity_Id
; N
: Node_Id
) is
6193 Set_Next_Rep_Item
(N
, First_Rep_Item
(E
));
6194 Set_First_Rep_Item
(E
, N
);
6195 end Record_Rep_Item
;
6201 function Root_Type
(Id
: E
) return E
is
6205 pragma Assert
(Nkind
(Id
) in N_Entity
);
6207 T
:= Base_Type
(Id
);
6209 if Ekind
(T
) = E_Class_Wide_Type
then
6221 -- Following test catches some error cases resulting from
6224 elsif No
(Etyp
) then
6227 elsif Is_Private_Type
(T
) and then Etyp
= Full_View
(T
) then
6230 elsif Is_Private_Type
(Etyp
) and then Full_View
(Etyp
) = T
then
6236 -- Return if there is a circularity in the inheritance chain.
6237 -- This happens in some error situations and we do not want
6238 -- to get stuck in this loop.
6240 if T
= Base_Type
(Id
) then
6246 raise Program_Error
;
6253 function Scope_Depth
(Id
: E
) return Uint
is
6258 while Is_Record_Type
(Scop
) loop
6259 Scop
:= Scope
(Scop
);
6262 return Scope_Depth_Value
(Scop
);
6265 ---------------------
6266 -- Scope_Depth_Set --
6267 ---------------------
6269 function Scope_Depth_Set
(Id
: E
) return B
is
6271 return not Is_Record_Type
(Id
)
6272 and then Field22
(Id
) /= Union_Id
(Empty
);
6273 end Scope_Depth_Set
;
6275 -----------------------------
6276 -- Set_Component_Alignment --
6277 -----------------------------
6279 -- Component Alignment is encoded using two flags, Flag128/129 as
6280 -- follows. Note that both flags False = Align_Default, so that the
6281 -- default initialization of flags to False initializes component
6282 -- alignment to the default value as required.
6284 -- Flag128 Flag129 Value
6285 -- ------- ------- -----
6286 -- False False Calign_Default
6287 -- False True Calign_Component_Size
6288 -- True False Calign_Component_Size_4
6289 -- True True Calign_Storage_Unit
6291 procedure Set_Component_Alignment
(Id
: E
; V
: C
) is
6293 pragma Assert
((Is_Array_Type
(Id
) or else Is_Record_Type
(Id
))
6294 and then Id
= Base_Type
(Id
));
6297 when Calign_Default
=>
6298 Set_Flag128
(Id
, False);
6299 Set_Flag129
(Id
, False);
6301 when Calign_Component_Size
=>
6302 Set_Flag128
(Id
, False);
6303 Set_Flag129
(Id
, True);
6305 when Calign_Component_Size_4
=>
6306 Set_Flag128
(Id
, True);
6307 Set_Flag129
(Id
, False);
6309 when Calign_Storage_Unit
=>
6310 Set_Flag128
(Id
, True);
6311 Set_Flag129
(Id
, True);
6313 end Set_Component_Alignment
;
6319 function Size_Clause
(Id
: E
) return N
is
6321 return Rep_Clause
(Id
, Name_Size
);
6324 ------------------------
6325 -- Stream_Size_Clause --
6326 ------------------------
6328 function Stream_Size_Clause
(Id
: E
) return N
is
6330 return Rep_Clause
(Id
, Name_Stream_Size
);
6331 end Stream_Size_Clause
;
6337 function Subtype_Kind
(K
: Entity_Kind
) return Entity_Kind
is
6343 Kind
:= E_Access_Subtype
;
6347 Kind
:= E_Array_Subtype
;
6349 when E_Class_Wide_Type |
6350 E_Class_Wide_Subtype
=>
6351 Kind
:= E_Class_Wide_Subtype
;
6353 when E_Decimal_Fixed_Point_Type |
6354 E_Decimal_Fixed_Point_Subtype
=>
6355 Kind
:= E_Decimal_Fixed_Point_Subtype
;
6357 when E_Ordinary_Fixed_Point_Type |
6358 E_Ordinary_Fixed_Point_Subtype
=>
6359 Kind
:= E_Ordinary_Fixed_Point_Subtype
;
6361 when E_Private_Type |
6362 E_Private_Subtype
=>
6363 Kind
:= E_Private_Subtype
;
6365 when E_Limited_Private_Type |
6366 E_Limited_Private_Subtype
=>
6367 Kind
:= E_Limited_Private_Subtype
;
6369 when E_Record_Type_With_Private |
6370 E_Record_Subtype_With_Private
=>
6371 Kind
:= E_Record_Subtype_With_Private
;
6373 when E_Record_Type |
6375 Kind
:= E_Record_Subtype
;
6377 when E_String_Type |
6379 Kind
:= E_String_Subtype
;
6381 when Enumeration_Kind
=>
6382 Kind
:= E_Enumeration_Subtype
;
6385 Kind
:= E_Floating_Point_Subtype
;
6387 when Signed_Integer_Kind
=>
6388 Kind
:= E_Signed_Integer_Subtype
;
6390 when Modular_Integer_Kind
=>
6391 Kind
:= E_Modular_Integer_Subtype
;
6393 when Protected_Kind
=>
6394 Kind
:= E_Protected_Subtype
;
6397 Kind
:= E_Task_Subtype
;
6401 raise Program_Error
;
6407 -------------------------
6408 -- First_Tag_Component --
6409 -------------------------
6411 function First_Tag_Component
(Id
: E
) return E
is
6413 Typ
: Entity_Id
:= Id
;
6416 pragma Assert
(Is_Tagged_Type
(Typ
));
6418 if Is_Class_Wide_Type
(Typ
) then
6419 Typ
:= Root_Type
(Typ
);
6422 if Is_Private_Type
(Typ
) then
6423 Typ
:= Underlying_Type
(Typ
);
6425 -- If the underlying type is missing then the source program has
6426 -- errors and there is nothing else to do (the full-type declaration
6427 -- associated with the private type declaration is missing).
6434 Comp
:= First_Entity
(Typ
);
6435 while Present
(Comp
) loop
6436 if Is_Tag
(Comp
) then
6440 Comp
:= Next_Entity
(Comp
);
6443 -- No tag component found
6446 end First_Tag_Component
;
6448 ------------------------
6449 -- Next_Tag_Component --
6450 ------------------------
6452 function Next_Tag_Component
(Id
: E
) return E
is
6454 Typ
: constant Entity_Id
:= Scope
(Id
);
6457 pragma Assert
(Ekind
(Id
) = E_Component
6458 and then Is_Tagged_Type
(Typ
));
6460 Comp
:= Next_Entity
(Id
);
6461 while Present
(Comp
) loop
6462 if Is_Tag
(Comp
) then
6463 pragma Assert
(Chars
(Comp
) /= Name_uTag
);
6467 Comp
:= Next_Entity
(Comp
);
6470 -- No tag component found
6473 end Next_Tag_Component
;
6475 ---------------------
6476 -- Type_High_Bound --
6477 ---------------------
6479 function Type_High_Bound
(Id
: E
) return Node_Id
is
6481 if Nkind
(Scalar_Range
(Id
)) = N_Subtype_Indication
then
6482 return High_Bound
(Range_Expression
(Constraint
(Scalar_Range
(Id
))));
6484 return High_Bound
(Scalar_Range
(Id
));
6486 end Type_High_Bound
;
6488 --------------------
6489 -- Type_Low_Bound --
6490 --------------------
6492 function Type_Low_Bound
(Id
: E
) return Node_Id
is
6494 if Nkind
(Scalar_Range
(Id
)) = N_Subtype_Indication
then
6495 return Low_Bound
(Range_Expression
(Constraint
(Scalar_Range
(Id
))));
6497 return Low_Bound
(Scalar_Range
(Id
));
6501 ---------------------
6502 -- Underlying_Type --
6503 ---------------------
6505 function Underlying_Type
(Id
: E
) return E
is
6507 -- For record_with_private the underlying type is always the direct
6508 -- full view. Never try to take the full view of the parent it
6509 -- doesn't make sense.
6511 if Ekind
(Id
) = E_Record_Type_With_Private
then
6512 return Full_View
(Id
);
6514 elsif Ekind
(Id
) in Incomplete_Or_Private_Kind
then
6516 -- If we have an incomplete or private type with a full view,
6517 -- then we return the Underlying_Type of this full view
6519 if Present
(Full_View
(Id
)) then
6520 if Id
= Full_View
(Id
) then
6522 -- Previous error in declaration
6527 return Underlying_Type
(Full_View
(Id
));
6530 -- If we have an incomplete entity that comes from the limited
6531 -- view then we return the Underlying_Type of its non-limited
6534 elsif From_With_Type
(Id
)
6535 and then Present
(Non_Limited_View
(Id
))
6537 return Underlying_Type
(Non_Limited_View
(Id
));
6539 -- Otherwise check for the case where we have a derived type or
6540 -- subtype, and if so get the Underlying_Type of the parent type.
6542 elsif Etype
(Id
) /= Id
then
6543 return Underlying_Type
(Etype
(Id
));
6545 -- Otherwise we have an incomplete or private type that has
6546 -- no full view, which means that we have not encountered the
6547 -- completion, so return Empty to indicate the underlying type
6548 -- is not yet known.
6554 -- For non-incomplete, non-private types, return the type itself
6555 -- Also for entities that are not types at all return the entity
6561 end Underlying_Type
;
6563 ------------------------
6564 -- Write_Entity_Flags --
6565 ------------------------
6567 procedure Write_Entity_Flags
(Id
: Entity_Id
; Prefix
: String) is
6569 procedure W
(Flag_Name
: String; Flag
: Boolean);
6570 -- Write out given flag if it is set
6576 procedure W
(Flag_Name
: String; Flag
: Boolean) is
6580 Write_Str
(Flag_Name
);
6581 Write_Str
(" = True");
6586 -- Start of processing for Write_Entity_Flags
6589 if (Is_Array_Type
(Id
) or else Is_Record_Type
(Id
))
6590 and then Base_Type
(Id
) = Id
6593 Write_Str
("Component_Alignment = ");
6595 case Component_Alignment
(Id
) is
6596 when Calign_Default
=>
6597 Write_Str
("Calign_Default");
6599 when Calign_Component_Size
=>
6600 Write_Str
("Calign_Component_Size");
6602 when Calign_Component_Size_4
=>
6603 Write_Str
("Calign_Component_Size_4");
6605 when Calign_Storage_Unit
=>
6606 Write_Str
("Calign_Storage_Unit");
6612 W
("Address_Taken", Flag104
(Id
));
6613 W
("Body_Needed_For_SAL", Flag40
(Id
));
6614 W
("C_Pass_By_Copy", Flag125
(Id
));
6615 W
("Can_Never_Be_Null", Flag38
(Id
));
6616 W
("Checks_May_Be_Suppressed", Flag31
(Id
));
6617 W
("Debug_Info_Off", Flag166
(Id
));
6618 W
("Default_Expressions_Processed", Flag108
(Id
));
6619 W
("Delay_Cleanups", Flag114
(Id
));
6620 W
("Delay_Subprogram_Descriptors", Flag50
(Id
));
6621 W
("Depends_On_Private", Flag14
(Id
));
6622 W
("Discard_Names", Flag88
(Id
));
6623 W
("Elaboration_Entity_Required", Flag174
(Id
));
6624 W
("Entry_Accepted", Flag152
(Id
));
6625 W
("Finalize_Storage_Only", Flag158
(Id
));
6626 W
("From_With_Type", Flag159
(Id
));
6627 W
("Function_Returns_With_DSP", Flag169
(Id
));
6628 W
("Has_Aliased_Components", Flag135
(Id
));
6629 W
("Has_Alignment_Clause", Flag46
(Id
));
6630 W
("Has_All_Calls_Remote", Flag79
(Id
));
6631 W
("Has_Anon_Block_Suffix", Flag201
(Id
));
6632 W
("Has_Atomic_Components", Flag86
(Id
));
6633 W
("Has_Biased_Representation", Flag139
(Id
));
6634 W
("Has_Completion", Flag26
(Id
));
6635 W
("Has_Completion_In_Body", Flag71
(Id
));
6636 W
("Has_Complex_Representation", Flag140
(Id
));
6637 W
("Has_Component_Size_Clause", Flag68
(Id
));
6638 W
("Has_Contiguous_Rep", Flag181
(Id
));
6639 W
("Has_Controlled_Component", Flag43
(Id
));
6640 W
("Has_Controlling_Result", Flag98
(Id
));
6641 W
("Has_Convention_Pragma", Flag119
(Id
));
6642 W
("Has_Delayed_Freeze", Flag18
(Id
));
6643 W
("Has_Discriminants", Flag5
(Id
));
6644 W
("Has_Enumeration_Rep_Clause", Flag66
(Id
));
6645 W
("Has_Exit", Flag47
(Id
));
6646 W
("Has_External_Tag_Rep_Clause", Flag110
(Id
));
6647 W
("Has_Forward_Instantiation", Flag175
(Id
));
6648 W
("Has_Fully_Qualified_Name", Flag173
(Id
));
6649 W
("Has_Gigi_Rep_Item", Flag82
(Id
));
6650 W
("Has_Homonym", Flag56
(Id
));
6651 W
("Has_Machine_Radix_Clause", Flag83
(Id
));
6652 W
("Has_Master_Entity", Flag21
(Id
));
6653 W
("Has_Missing_Return", Flag142
(Id
));
6654 W
("Has_Nested_Block_With_Handler", Flag101
(Id
));
6655 W
("Has_Non_Standard_Rep", Flag75
(Id
));
6656 W
("Has_Object_Size_Clause", Flag172
(Id
));
6657 W
("Has_Per_Object_Constraint", Flag154
(Id
));
6658 W
("Has_Persistent_BSS", Flag188
(Id
));
6659 W
("Has_Pragma_Controlled", Flag27
(Id
));
6660 W
("Has_Pragma_Elaborate_Body", Flag150
(Id
));
6661 W
("Has_Pragma_Inline", Flag157
(Id
));
6662 W
("Has_Pragma_Pack", Flag121
(Id
));
6663 W
("Has_Pragma_Pure", Flag203
(Id
));
6664 W
("Has_Pragma_Pure_Function", Flag179
(Id
));
6665 W
("Has_Pragma_Unreferenced", Flag180
(Id
));
6666 W
("Has_Primitive_Operations", Flag120
(Id
));
6667 W
("Has_Private_Declaration", Flag155
(Id
));
6668 W
("Has_Qualified_Name", Flag161
(Id
));
6669 W
("Has_Record_Rep_Clause", Flag65
(Id
));
6670 W
("Has_Recursive_Call", Flag143
(Id
));
6671 W
("Has_Size_Clause", Flag29
(Id
));
6672 W
("Has_Small_Clause", Flag67
(Id
));
6673 W
("Has_Specified_Layout", Flag100
(Id
));
6674 W
("Has_Specified_Stream_Input", Flag190
(Id
));
6675 W
("Has_Specified_Stream_Output", Flag191
(Id
));
6676 W
("Has_Specified_Stream_Read", Flag192
(Id
));
6677 W
("Has_Specified_Stream_Write", Flag193
(Id
));
6678 W
("Has_Storage_Size_Clause", Flag23
(Id
));
6679 W
("Has_Stream_Size_Clause", Flag184
(Id
));
6680 W
("Has_Subprogram_Descriptor", Flag93
(Id
));
6681 W
("Has_Task", Flag30
(Id
));
6682 W
("Has_Unchecked_Union", Flag123
(Id
));
6683 W
("Has_Unknown_Discriminants", Flag72
(Id
));
6684 W
("Has_Volatile_Components", Flag87
(Id
));
6685 W
("Has_Xref_Entry", Flag182
(Id
));
6686 W
("In_Package_Body", Flag48
(Id
));
6687 W
("In_Private_Part", Flag45
(Id
));
6688 W
("In_Use", Flag8
(Id
));
6689 W
("Is_AST_Entry", Flag132
(Id
));
6690 W
("Is_Abstract", Flag19
(Id
));
6691 W
("Is_Local_Anonymous_Access", Flag194
(Id
));
6692 W
("Is_Access_Constant", Flag69
(Id
));
6693 W
("Is_Ada_2005", Flag185
(Id
));
6694 W
("Is_Aliased", Flag15
(Id
));
6695 W
("Is_Asynchronous", Flag81
(Id
));
6696 W
("Is_Atomic", Flag85
(Id
));
6697 W
("Is_Bit_Packed_Array", Flag122
(Id
));
6698 W
("Is_CPP_Class", Flag74
(Id
));
6699 W
("Is_Called", Flag102
(Id
));
6700 W
("Is_Character_Type", Flag63
(Id
));
6701 W
("Is_Child_Unit", Flag73
(Id
));
6702 W
("Is_Class_Wide_Equivalent_Type", Flag35
(Id
));
6703 W
("Is_Compilation_Unit", Flag149
(Id
));
6704 W
("Is_Completely_Hidden", Flag103
(Id
));
6705 W
("Is_Concurrent_Record_Type", Flag20
(Id
));
6706 W
("Is_Constr_Subt_For_UN_Aliased", Flag141
(Id
));
6707 W
("Is_Constr_Subt_For_U_Nominal", Flag80
(Id
));
6708 W
("Is_Constrained", Flag12
(Id
));
6709 W
("Is_Constructor", Flag76
(Id
));
6710 W
("Is_Controlled", Flag42
(Id
));
6711 W
("Is_Controlling_Formal", Flag97
(Id
));
6712 W
("Is_Discrim_SO_Function", Flag176
(Id
));
6713 W
("Is_Dispatching_Operation", Flag6
(Id
));
6714 W
("Is_Eliminated", Flag124
(Id
));
6715 W
("Is_Entry_Formal", Flag52
(Id
));
6716 W
("Is_Exported", Flag99
(Id
));
6717 W
("Is_First_Subtype", Flag70
(Id
));
6718 W
("Is_For_Access_Subtype", Flag118
(Id
));
6719 W
("Is_Formal_Subprogram", Flag111
(Id
));
6720 W
("Is_Frozen", Flag4
(Id
));
6721 W
("Is_Generic_Actual_Type", Flag94
(Id
));
6722 W
("Is_Generic_Instance", Flag130
(Id
));
6723 W
("Is_Generic_Type", Flag13
(Id
));
6724 W
("Is_Hidden", Flag57
(Id
));
6725 W
("Is_Hidden_Open_Scope", Flag171
(Id
));
6726 W
("Is_Immediately_Visible", Flag7
(Id
));
6727 W
("Is_Imported", Flag24
(Id
));
6728 W
("Is_Inlined", Flag11
(Id
));
6729 W
("Is_Instantiated", Flag126
(Id
));
6730 W
("Is_Interface", Flag186
(Id
));
6731 W
("Is_Internal", Flag17
(Id
));
6732 W
("Is_Interrupt_Handler", Flag89
(Id
));
6733 W
("Is_Intrinsic_Subprogram", Flag64
(Id
));
6734 W
("Is_Itype", Flag91
(Id
));
6735 W
("Is_Known_Non_Null", Flag37
(Id
));
6736 W
("Is_Known_Null", Flag204
(Id
));
6737 W
("Is_Known_Valid", Flag170
(Id
));
6738 W
("Is_Limited_Composite", Flag106
(Id
));
6739 W
("Is_Limited_Interface", Flag197
(Id
));
6740 W
("Is_Limited_Record", Flag25
(Id
));
6741 W
("Is_Machine_Code_Subprogram", Flag137
(Id
));
6742 W
("Is_Non_Static_Subtype", Flag109
(Id
));
6743 W
("Is_Null_Init_Proc", Flag178
(Id
));
6744 W
("Is_Obsolescent", Flag153
(Id
));
6745 W
("Is_Optional_Parameter", Flag134
(Id
));
6746 W
("Is_Overriding_Operation", Flag39
(Id
));
6747 W
("Is_Package_Body_Entity", Flag160
(Id
));
6748 W
("Is_Packed", Flag51
(Id
));
6749 W
("Is_Packed_Array_Type", Flag138
(Id
));
6750 W
("Is_Potentially_Use_Visible", Flag9
(Id
));
6751 W
("Is_Preelaborated", Flag59
(Id
));
6752 W
("Is_Primitive_Wrapper", Flag195
(Id
));
6753 W
("Is_Private_Composite", Flag107
(Id
));
6754 W
("Is_Private_Descendant", Flag53
(Id
));
6755 W
("Is_Protected_Interface", Flag198
(Id
));
6756 W
("Is_Public", Flag10
(Id
));
6757 W
("Is_Pure", Flag44
(Id
));
6758 W
("Is_Pure_Unit_Access_Type", Flag189
(Id
));
6759 W
("Is_Remote_Call_Interface", Flag62
(Id
));
6760 W
("Is_Remote_Types", Flag61
(Id
));
6761 W
("Is_Renaming_Of_Object", Flag112
(Id
));
6762 W
("Is_Shared_Passive", Flag60
(Id
));
6763 W
("Is_Synchronized_Interface", Flag199
(Id
));
6764 W
("Is_Statically_Allocated", Flag28
(Id
));
6765 W
("Is_Tag", Flag78
(Id
));
6766 W
("Is_Tagged_Type", Flag55
(Id
));
6767 W
("Is_Task_Interface", Flag200
(Id
));
6768 W
("Is_Thread_Body", Flag77
(Id
));
6769 W
("Is_True_Constant", Flag163
(Id
));
6770 W
("Is_Unchecked_Union", Flag117
(Id
));
6771 W
("Is_Unsigned_Type", Flag144
(Id
));
6772 W
("Is_VMS_Exception", Flag133
(Id
));
6773 W
("Is_Valued_Procedure", Flag127
(Id
));
6774 W
("Is_Visible_Child_Unit", Flag116
(Id
));
6775 W
("Is_Volatile", Flag16
(Id
));
6776 W
("Itype_Printed", Flag202
(Id
));
6777 W
("Kill_Elaboration_Checks", Flag32
(Id
));
6778 W
("Kill_Range_Checks", Flag33
(Id
));
6779 W
("Kill_Tag_Checks", Flag34
(Id
));
6780 W
("Machine_Radix_10", Flag84
(Id
));
6781 W
("Materialize_Entity", Flag168
(Id
));
6782 W
("Must_Be_On_Byte_Boundary", Flag183
(Id
));
6783 W
("Needs_Debug_Info", Flag147
(Id
));
6784 W
("Needs_No_Actuals", Flag22
(Id
));
6785 W
("Never_Set_In_Source", Flag115
(Id
));
6786 W
("No_Pool_Assigned", Flag131
(Id
));
6787 W
("No_Return", Flag113
(Id
));
6788 W
("No_Strict_Aliasing", Flag136
(Id
));
6789 W
("Non_Binary_Modulus", Flag58
(Id
));
6790 W
("Nonzero_Is_True", Flag162
(Id
));
6791 W
("Reachable", Flag49
(Id
));
6792 W
("Referenced", Flag156
(Id
));
6793 W
("Referenced_As_LHS", Flag36
(Id
));
6794 W
("Return_Present", Flag54
(Id
));
6795 W
("Returns_By_Ref", Flag90
(Id
));
6796 W
("Reverse_Bit_Order", Flag164
(Id
));
6797 W
("Sec_Stack_Needed_For_Return", Flag167
(Id
));
6798 W
("Size_Depends_On_Discriminant", Flag177
(Id
));
6799 W
("Size_Known_At_Compile_Time", Flag92
(Id
));
6800 W
("Strict_Alignment", Flag145
(Id
));
6801 W
("Suppress_Elaboration_Warnings", Flag148
(Id
));
6802 W
("Suppress_Init_Proc", Flag105
(Id
));
6803 W
("Suppress_Style_Checks", Flag165
(Id
));
6804 W
("Treat_As_Volatile", Flag41
(Id
));
6805 W
("Uses_Sec_Stack", Flag95
(Id
));
6806 W
("Vax_Float", Flag151
(Id
));
6807 W
("Warnings_Off", Flag96
(Id
));
6808 W
("Was_Hidden", Flag196
(Id
));
6809 end Write_Entity_Flags
;
6811 -----------------------
6812 -- Write_Entity_Info --
6813 -----------------------
6815 procedure Write_Entity_Info
(Id
: Entity_Id
; Prefix
: String) is
6817 procedure Write_Attribute
(Which
: String; Nam
: E
);
6818 -- Write attribute value with given string name
6820 procedure Write_Kind
(Id
: Entity_Id
);
6821 -- Write Ekind field of entity
6823 procedure Write_Attribute
(Which
: String; Nam
: E
) is
6827 Write_Int
(Int
(Nam
));
6829 Write_Name
(Chars
(Nam
));
6831 end Write_Attribute
;
6833 procedure Write_Kind
(Id
: Entity_Id
) is
6834 K
: constant String := Entity_Kind
'Image (Ekind
(Id
));
6838 Write_Str
(" Kind ");
6840 if Is_Type
(Id
) and then Is_Tagged_Type
(Id
) then
6841 Write_Str
("TAGGED ");
6844 Write_Str
(K
(3 .. K
'Length));
6847 if Is_Type
(Id
) and then Depends_On_Private
(Id
) then
6848 Write_Str
("Depends_On_Private ");
6852 -- Start of processing for Write_Entity_Info
6856 Write_Attribute
("Name ", Id
);
6857 Write_Int
(Int
(Id
));
6861 Write_Attribute
(" Type ", Etype
(Id
));
6863 Write_Attribute
(" Scope ", Scope
(Id
));
6868 when Discrete_Kind
=>
6869 Write_Str
("Bounds: Id = ");
6871 if Present
(Scalar_Range
(Id
)) then
6872 Write_Int
(Int
(Type_Low_Bound
(Id
)));
6873 Write_Str
(" .. Id = ");
6874 Write_Int
(Int
(Type_High_Bound
(Id
)));
6876 Write_Str
("Empty");
6887 (" Component Type ", Component_Type
(Id
));
6890 Write_Str
(" Indices ");
6892 Index
:= First_Index
(Id
);
6893 while Present
(Index
) loop
6894 Write_Attribute
(" ", Etype
(Index
));
6895 Index
:= Next_Index
(Index
);
6903 (" Directly Designated Type ",
6904 Directly_Designated_Type
(Id
));
6907 when Overloadable_Kind
=>
6908 if Present
(Homonym
(Id
)) then
6909 Write_Str
(" Homonym ");
6910 Write_Name
(Chars
(Homonym
(Id
)));
6912 Write_Int
(Int
(Homonym
(Id
)));
6919 if Ekind
(Scope
(Id
)) in Record_Kind
then
6921 " Original_Record_Component ",
6922 Original_Record_Component
(Id
));
6923 Write_Int
(Int
(Original_Record_Component
(Id
)));
6927 when others => null;
6929 end Write_Entity_Info
;
6931 -----------------------
6932 -- Write_Field6_Name --
6933 -----------------------
6935 procedure Write_Field6_Name
(Id
: Entity_Id
) is
6936 pragma Warnings
(Off
, Id
);
6939 Write_Str
("First_Rep_Item");
6940 end Write_Field6_Name
;
6942 -----------------------
6943 -- Write_Field7_Name --
6944 -----------------------
6946 procedure Write_Field7_Name
(Id
: Entity_Id
) is
6947 pragma Warnings
(Off
, Id
);
6950 Write_Str
("Freeze_Node");
6951 end Write_Field7_Name
;
6953 -----------------------
6954 -- Write_Field8_Name --
6955 -----------------------
6957 procedure Write_Field8_Name
(Id
: Entity_Id
) is
6962 Write_Str
("Normalized_First_Bit");
6966 E_Subprogram_Body
=>
6967 Write_Str
("Mechanism");
6970 Write_Str
("Associated_Node_For_Itype");
6973 Write_Str
("Dependent_Instances");
6976 Write_Str
("Hiding_Loop_Variable");
6979 Write_Str
("Field8??");
6981 end Write_Field8_Name
;
6983 -----------------------
6984 -- Write_Field9_Name --
6985 -----------------------
6987 procedure Write_Field9_Name
(Id
: Entity_Id
) is
6991 Write_Str
("Class_Wide_Type");
6994 E_Generic_Function |
6996 E_Generic_Procedure |
6999 Write_Str
("Renaming_Map");
7002 Write_Str
("Current_Value");
7005 Write_Str
("Field9??");
7007 end Write_Field9_Name
;
7009 ------------------------
7010 -- Write_Field10_Name --
7011 ------------------------
7013 procedure Write_Field10_Name
(Id
: Entity_Id
) is
7017 Write_Str
("Referenced_Object");
7019 when E_In_Parameter |
7021 Write_Str
("Discriminal_Link");
7027 Write_Str
("Handler_Records");
7031 Write_Str
("Normalized_Position_Max");
7034 Write_Str
("Field10??");
7036 end Write_Field10_Name
;
7038 ------------------------
7039 -- Write_Field11_Name --
7040 ------------------------
7042 procedure Write_Field11_Name
(Id
: Entity_Id
) is
7046 Write_Str
("Entry_Component");
7050 Write_Str
("Component_Bit_Offset");
7053 Write_Str
("Full_View");
7055 when E_Enumeration_Literal
=>
7056 Write_Str
("Enumeration_Pos");
7059 Write_Str
("Block_Node");
7065 Write_Str
("Protected_Body_Subprogram");
7067 when E_Generic_Package
=>
7068 Write_Str
("Generic_Homonym");
7071 Write_Str
("Full_View");
7074 Write_Str
("Field11??");
7076 end Write_Field11_Name
;
7078 ------------------------
7079 -- Write_Field12_Name --
7080 ------------------------
7082 procedure Write_Field12_Name
(Id
: Entity_Id
) is
7086 Write_Str
("Barrier_Function");
7088 when E_Enumeration_Literal
=>
7089 Write_Str
("Enumeration_Rep");
7096 E_In_Out_Parameter |
7100 Write_Str
("Esize");
7104 Write_Str
("Next_Inlined_Subprogram");
7107 Write_Str
("Associated_Formal_Package");
7110 Write_Str
("Field12??");
7112 end Write_Field12_Name
;
7114 ------------------------
7115 -- Write_Field13_Name --
7116 ------------------------
7118 procedure Write_Field13_Name
(Id
: Entity_Id
) is
7122 Write_Str
("RM_Size");
7126 Write_Str
("Component_Clause");
7128 when E_Enumeration_Literal
=>
7129 Write_Str
("Debug_Renaming_Link");
7132 if not Comes_From_Source
(Id
)
7134 Chars
(Id
) = Name_Op_Ne
7136 Write_Str
("Corresponding_Equality");
7138 elsif Comes_From_Source
(Id
) then
7139 Write_Str
("Elaboration_Entity");
7142 Write_Str
("Field13??");
7147 Write_Str
("Extra_Accessibility");
7151 Generic_Unit_Kind
=>
7152 Write_Str
("Elaboration_Entity");
7155 Write_Str
("Field13??");
7157 end Write_Field13_Name
;
7159 -----------------------
7160 -- Write_Field14_Name --
7161 -----------------------
7163 procedure Write_Field14_Name
(Id
: Entity_Id
) is
7171 Write_Str
("Alignment");
7175 Write_Str
("Normalized_Position");
7179 Write_Str
("First_Optional_Parameter");
7182 E_Generic_Package
=>
7183 Write_Str
("Shadow_Entities");
7186 Write_Str
("Field14??");
7188 end Write_Field14_Name
;
7190 ------------------------
7191 -- Write_Field15_Name --
7192 ------------------------
7194 procedure Write_Field15_Name
(Id
: Entity_Id
) is
7199 Write_Str
("Storage_Size_Variable");
7201 when Class_Wide_Kind |
7205 Write_Str
("Primitive_Operations");
7208 Write_Str
("DT_Entry_Count");
7210 when Decimal_Fixed_Point_Kind
=>
7211 Write_Str
("Scale_Value");
7213 when E_Discriminant
=>
7214 Write_Str
("Discriminant_Number");
7217 Write_Str
("Extra_Formal");
7221 Write_Str
("DT_Position");
7224 Write_Str
("Entry_Parameters_Type");
7226 when Enumeration_Kind
=>
7227 Write_Str
("Lit_Indexes");
7231 Write_Str
("Related_Instance");
7233 when E_Protected_Type
=>
7234 Write_Str
("Entry_Bodies_Array");
7236 when E_String_Literal_Subtype
=>
7237 Write_Str
("String_Literal_Low_Bound");
7240 Write_Str
("Shared_Var_Read_Proc");
7243 Write_Str
("Field15??");
7245 end Write_Field15_Name
;
7247 ------------------------
7248 -- Write_Field16_Name --
7249 ------------------------
7251 procedure Write_Field16_Name
(Id
: Entity_Id
) is
7255 Write_Str
("Entry_Formal");
7259 Write_Str
("DTC_Entity");
7264 Write_Str
("First_Private_Entity");
7266 when E_Record_Type |
7267 E_Record_Type_With_Private
=>
7268 Write_Str
("Access_Disp_Table");
7270 when E_String_Literal_Subtype
=>
7271 Write_Str
("String_Literal_Length");
7273 when Enumeration_Kind
=>
7274 Write_Str
("Lit_Strings");
7278 Write_Str
("Unset_Reference");
7280 when E_Record_Subtype |
7281 E_Class_Wide_Subtype
=>
7282 Write_Str
("Cloned_Subtype");
7285 Write_Str
("Field16??");
7287 end Write_Field16_Name
;
7289 ------------------------
7290 -- Write_Field17_Name --
7291 ------------------------
7293 procedure Write_Field17_Name
(Id
: Entity_Id
) is
7297 Write_Str
("Digits_Value");
7300 Write_Str
("Prival");
7302 when E_Discriminant
=>
7303 Write_Str
("Discriminal");
7312 E_Generic_Function |
7314 E_Generic_Procedure |
7323 E_Subprogram_Type
=>
7324 Write_Str
("First_Entity");
7327 Write_Str
("First_Index");
7329 when E_Protected_Body
=>
7330 Write_Str
("Object_Ref");
7332 when Enumeration_Kind
=>
7333 Write_Str
("First_Literal");
7336 Write_Str
("Master_Id");
7338 when Modular_Integer_Kind
=>
7339 Write_Str
("Modulus");
7343 E_Generic_In_Out_Parameter |
7345 Write_Str
("Actual_Subtype");
7347 when E_Incomplete_Type
=>
7348 Write_Str
("Non-limited view");
7351 Write_Str
("Field17??");
7353 end Write_Field17_Name
;
7355 -----------------------
7356 -- Write_Field18_Name --
7357 -----------------------
7359 procedure Write_Field18_Name
(Id
: Entity_Id
) is
7362 when E_Enumeration_Literal |
7366 Write_Str
("Alias");
7368 when E_Record_Type
=>
7369 Write_Str
("Corresponding_Concurrent_Type");
7371 when E_Entry_Index_Parameter
=>
7372 Write_Str
("Entry_Index_Constant");
7374 when E_Class_Wide_Subtype |
7375 E_Access_Protected_Subprogram_Type |
7376 E_Access_Subprogram_Type |
7378 Write_Str
("Equivalent_Type");
7380 when Fixed_Point_Kind
=>
7381 Write_Str
("Delta_Value");
7385 Write_Str
("Renamed_Object");
7389 E_Generic_Function |
7390 E_Generic_Procedure |
7391 E_Generic_Package
=>
7392 Write_Str
("Renamed_Entity");
7394 when Incomplete_Or_Private_Kind
=>
7395 Write_Str
("Private_Dependents");
7397 when Concurrent_Kind
=>
7398 Write_Str
("Corresponding_Record_Type");
7403 Write_Str
("Enclosing_Scope");
7406 Write_Str
("Field18??");
7408 end Write_Field18_Name
;
7410 -----------------------
7411 -- Write_Field19_Name --
7412 -----------------------
7414 procedure Write_Field19_Name
(Id
: Entity_Id
) is
7419 Write_Str
("Related_Array_Object");
7426 Write_Str
("Finalization_Chain_Entity");
7428 when E_Constant | E_Variable
=>
7429 Write_Str
("Size_Check_Code");
7431 when E_Discriminant
=>
7432 Write_Str
("Corresponding_Discriminant");
7435 E_Generic_Package
=>
7436 Write_Str
("Body_Entity");
7438 when E_Package_Body |
7440 Write_Str
("Spec_Entity");
7442 when Private_Kind
=>
7443 Write_Str
("Underlying_Full_View");
7445 when E_Record_Type
=>
7446 Write_Str
("Parent_Subtype");
7449 Write_Str
("Field19??");
7451 end Write_Field19_Name
;
7453 -----------------------
7454 -- Write_Field20_Name --
7455 -----------------------
7457 procedure Write_Field20_Name
(Id
: Entity_Id
) is
7461 Write_Str
("Component_Type");
7463 when E_In_Parameter |
7464 E_Generic_In_Parameter
=>
7465 Write_Str
("Default_Value");
7468 Write_Str
("Directly_Designated_Type");
7471 Write_Str
("Discriminant_Checking_Func");
7473 when E_Discriminant
=>
7474 Write_Str
("Discriminant_Default_Value");
7483 E_Generic_Function |
7485 E_Generic_Procedure |
7494 E_Subprogram_Type
=>
7496 Write_Str
("Last_Entity");
7499 Write_Str
("Scalar_Range");
7502 Write_Str
("Register_Exception_Call");
7505 Write_Str
("Field20??");
7507 end Write_Field20_Name
;
7509 -----------------------
7510 -- Write_Field21_Name --
7511 -----------------------
7513 procedure Write_Field21_Name
(Id
: Entity_Id
) is
7519 E_Generic_Function |
7521 E_Generic_Procedure |
7523 Write_Str
("Interface_Name");
7525 when Concurrent_Kind |
7526 Incomplete_Or_Private_Kind |
7530 Write_Str
("Discriminant_Constraint");
7533 Write_Str
("Accept_Address");
7535 when Fixed_Point_Kind
=>
7536 Write_Str
("Small_Value");
7538 when E_In_Parameter
=>
7539 Write_Str
("Default_Expr_Function");
7542 Modular_Integer_Kind
=>
7543 Write_Str
("Original_Array_Type");
7545 when E_Access_Subprogram_Type |
7546 E_Access_Protected_Subprogram_Type
=>
7547 Write_Str
("Original_Access_Type");
7550 Write_Str
("Field21??");
7552 end Write_Field21_Name
;
7554 -----------------------
7555 -- Write_Field22_Name --
7556 -----------------------
7558 procedure Write_Field22_Name
(Id
: Entity_Id
) is
7562 Write_Str
("Associated_Storage_Pool");
7565 Write_Str
("Component_Size");
7569 Write_Str
("Original_Record_Component");
7571 when E_Enumeration_Literal
=>
7572 Write_Str
("Enumeration_Rep_Expr");
7575 Write_Str
("Exception_Code");
7578 Write_Str
("Protected_Formal");
7580 when E_Record_Type
=>
7581 Write_Str
("Corresponding_Remote_Type");
7591 E_Generic_Function |
7592 E_Generic_Procedure |
7597 Write_Str
("Scope_Depth_Value");
7599 when E_Record_Type_With_Private |
7600 E_Record_Subtype_With_Private |
7603 E_Limited_Private_Type |
7604 E_Limited_Private_Subtype
=>
7605 Write_Str
("Private_View");
7608 Write_Str
("Shared_Var_Assign_Proc");
7611 Write_Str
("Field22??");
7613 end Write_Field22_Name
;
7615 ------------------------
7616 -- Write_Field23_Name --
7617 ------------------------
7619 procedure Write_Field23_Name
(Id
: Entity_Id
) is
7623 Write_Str
("Associated_Final_Chain");
7626 Write_Str
("Packed_Array_Type");
7629 Write_Str
("Entry_Cancel_Parameter");
7632 Write_Str
("Protected_Operation");
7634 when E_Discriminant
=>
7635 Write_Str
("CR_Discriminant");
7637 when E_Enumeration_Type
=>
7638 Write_Str
("Enum_Pos_To_Rep");
7642 Write_Str
("Extra_Constrained");
7644 when E_Generic_Function |
7646 E_Generic_Procedure
=>
7647 Write_Str
("Inner_Instances");
7649 when Concurrent_Kind |
7650 Incomplete_Or_Private_Kind |
7654 Write_Str
("Stored_Constraint");
7658 Write_Str
("Generic_Renamings");
7661 if Is_Generic_Instance
(Id
) then
7662 Write_Str
("Generic_Renamings");
7664 Write_Str
("Limited Views");
7667 -- What about Privals_Chain for protected operations ???
7670 Write_Str
("Privals_Chain");
7673 Write_Str
("Field23??");
7675 end Write_Field23_Name
;
7677 ------------------------
7678 -- Write_Field24_Name --
7679 ------------------------
7681 procedure Write_Field24_Name
(Id
: Entity_Id
) is
7684 when E_Record_Type |
7686 E_Record_Type_With_Private |
7687 E_Record_Subtype_With_Private
=>
7688 Write_Str
("Abstract_Interfaces");
7691 Write_Str
("DT_Offset_To_Top_Func");
7693 when Subprogram_Kind |
7695 E_Generic_Package
=>
7696 Write_Str
("Obsolescent_Warning");
7699 Write_Str
("Task_Body_Procedure");
7702 Write_Str
("Field24??");
7704 end Write_Field24_Name
;
7706 ------------------------
7707 -- Write_Field25_Name --
7708 ------------------------
7710 procedure Write_Field25_Name
(Id
: Entity_Id
) is
7715 Write_Str
("Abstract_Interface_Alias");
7718 Write_Str
("Current_Use_Clause");
7721 Write_Str
("Field25??");
7723 end Write_Field25_Name
;
7725 ------------------------
7726 -- Write_Field26_Name --
7727 ------------------------
7729 procedure Write_Field26_Name
(Id
: Entity_Id
) is
7732 when E_Generic_Package |
7734 Write_Str
("Package_Instantiation");
7738 Write_Str
("Overridden_Operation");
7741 Write_Str
("Field26??");
7743 end Write_Field26_Name
;
7745 ------------------------
7746 -- Write_Field27_Name --
7747 ------------------------
7749 procedure Write_Field27_Name
(Id
: Entity_Id
) is
7753 Write_Str
("Wrapped_Entity");
7756 Write_Str
("Field27??");
7758 end Write_Field27_Name
;
7760 -------------------------
7761 -- Iterator Procedures --
7762 -------------------------
7764 procedure Proc_Next_Component
(N
: in out Node_Id
) is
7766 N
:= Next_Component
(N
);
7767 end Proc_Next_Component
;
7769 procedure Proc_Next_Discriminant
(N
: in out Node_Id
) is
7771 N
:= Next_Discriminant
(N
);
7772 end Proc_Next_Discriminant
;
7774 procedure Proc_Next_Formal
(N
: in out Node_Id
) is
7776 N
:= Next_Formal
(N
);
7777 end Proc_Next_Formal
;
7779 procedure Proc_Next_Formal_With_Extras
(N
: in out Node_Id
) is
7781 N
:= Next_Formal_With_Extras
(N
);
7782 end Proc_Next_Formal_With_Extras
;
7784 procedure Proc_Next_Index
(N
: in out Node_Id
) is
7786 N
:= Next_Index
(N
);
7787 end Proc_Next_Index
;
7789 procedure Proc_Next_Inlined_Subprogram
(N
: in out Node_Id
) is
7791 N
:= Next_Inlined_Subprogram
(N
);
7792 end Proc_Next_Inlined_Subprogram
;
7794 procedure Proc_Next_Literal
(N
: in out Node_Id
) is
7796 N
:= Next_Literal
(N
);
7797 end Proc_Next_Literal
;
7799 procedure Proc_Next_Stored_Discriminant
(N
: in out Node_Id
) is
7801 N
:= Next_Stored_Discriminant
(N
);
7802 end Proc_Next_Stored_Discriminant
;