1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2008, 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 Nlists
; use Nlists
;
39 with Output
; use Output
;
40 with Sinfo
; use Sinfo
;
41 with Stand
; use Stand
;
45 use Atree
.Unchecked_Access
;
46 -- This is one of the packages that is allowed direct untyped access to
47 -- the fields in a node, since it provides the next level abstraction
48 -- which incorporates appropriate checks.
50 ----------------------------------------------
51 -- Usage of Fields in Defining Entity Nodes --
52 ----------------------------------------------
54 -- Four of these fields are defined in Sinfo, since they in are the
55 -- base part of the node. The access routines for these fields and
56 -- the corresponding set procedures are defined in Sinfo. These fields
57 -- are present in all entities. Note that Homonym is also in the base
58 -- part of the node, but has access routines that are more properly
59 -- part of Einfo, which is why they are defined here.
66 -- Remaining fields are present only in extended nodes (i.e. entities)
68 -- The following fields are present in all entities
71 -- First_Rep_Item Node6
74 -- The usage of other fields (and the entity kinds to which it applies)
75 -- depends on the particular field (see Einfo spec for details).
77 -- Associated_Node_For_Itype Node8
78 -- Dependent_Instances Elist8
79 -- Hiding_Loop_Variable Node8
80 -- Mechanism Uint8 (but returns Mechanism_Type)
81 -- Normalized_First_Bit Uint8
82 -- Return_Applies_To Node8
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 -- Elaboration_Entity Node13
109 -- Extra_Accessibility Node13
113 -- First_Optional_Parameter Node14
114 -- Normalized_Position Uint14
115 -- Shadow_Entities List14
117 -- Discriminant_Number Uint15
118 -- DT_Position Uint15
119 -- DT_Entry_Count Uint15
120 -- Entry_Bodies_Array Node15
121 -- Entry_Parameters_Type Node15
122 -- Extra_Formal Node15
123 -- Lit_Indexes Node15
124 -- Primitive_Operations Elist15
125 -- Related_Instance Node15
126 -- Scale_Value Uint15
127 -- Storage_Size_Variable Node15
128 -- String_Literal_Low_Bound Node15
130 -- Access_Disp_Table Elist16
131 -- Cloned_Subtype Node16
133 -- Entry_Formal Node16
134 -- First_Private_Entity Node16
135 -- Lit_Strings Node16
136 -- String_Literal_Length Uint16
137 -- Unset_Reference Node16
139 -- Actual_Subtype Node17
140 -- Digits_Value Uint17
141 -- Discriminal Node17
142 -- First_Entity Node17
143 -- First_Index Node17
144 -- First_Literal Node17
147 -- Non_Limited_View Node17
151 -- Corresponding_Concurrent_Type Node18
152 -- Corresponding_Record_Type Node18
153 -- Delta_Value Ureal18
154 -- Enclosing_Scope Node18
155 -- Equivalent_Type Node18
156 -- Private_Dependents Elist18
157 -- Renamed_Entity Node18
158 -- Renamed_Object Node18
160 -- Body_Entity Node19
161 -- Corresponding_Discriminant Node19
162 -- Finalization_Chain_Entity Node19
163 -- Parent_Subtype Node19
164 -- Related_Array_Object Node19
165 -- Size_Check_Code Node19
166 -- Spec_Entity Node19
167 -- Underlying_Full_View Node19
169 -- Component_Type Node20
170 -- Default_Value Node20
171 -- Directly_Designated_Type Node20
172 -- Discriminant_Checking_Func Node20
173 -- Discriminant_Default_Value Node20
174 -- Last_Entity Node20
175 -- Prival_Link Node20
176 -- Register_Exception_Call Node20
177 -- Scalar_Range Node20
179 -- Accept_Address Elist21
180 -- Default_Expr_Function Node21
181 -- Discriminant_Constraint Elist21
182 -- Interface_Name Node21
183 -- Original_Array_Type Node21
184 -- Small_Value Ureal21
186 -- Associated_Storage_Pool Node22
187 -- Component_Size Uint22
188 -- Corresponding_Remote_Type Node22
189 -- Enumeration_Rep_Expr Node22
190 -- Exception_Code Uint22
191 -- Original_Record_Component Node22
192 -- Private_View Node22
193 -- Protected_Formal Node22
194 -- Scope_Depth_Value Uint22
195 -- Shared_Var_Procs_Instance Node22
197 -- Associated_Final_Chain Node23
198 -- CR_Discriminant Node23
199 -- Entry_Cancel_Parameter Node23
200 -- Enum_Pos_To_Rep Node23
201 -- Extra_Constrained Node23
202 -- Generic_Renamings Elist23
203 -- Inner_Instances Elist23
204 -- Limited_View Node23
205 -- Packed_Array_Type Node23
206 -- Protection_Object Node23
207 -- Stored_Constraint Elist23
209 -- Spec_PPC_List Node24
211 -- Interface_Alias Node25
212 -- Interfaces Elist25
213 -- Debug_Renaming_Link Node25
214 -- DT_Offset_To_Top_Func Node25
215 -- Task_Body_Procedure Node25
217 -- Dispatch_Table_Wrapper Node26
218 -- Last_Assignment Node26
219 -- Overridden_Operation Node26
220 -- Package_Instantiation Node26
221 -- Related_Type Node26
222 -- Relative_Deadline_Variable Node26
223 -- Static_Initialization Node26
225 -- Current_Use_Clause Node27
226 -- Wrapped_Entity Node27
228 -- Extra_Formals Node28
230 ---------------------------------------------
231 -- Usage of Flags in Defining Entity Nodes --
232 ---------------------------------------------
234 -- All flags are unique, there is no overlaying, so each flag is physically
235 -- present in every entity. However, for many of the flags, it only makes
236 -- sense for them to be set true for certain subsets of entity kinds. See
237 -- the spec of Einfo for further details.
239 -- Note: Flag1-Flag3 are absent from this list, since these flag positions
240 -- are used for the flags Analyzed, Comes_From_Source, and Error_Posted,
241 -- which are common to all nodes, including entity nodes.
244 -- Has_Discriminants Flag5
245 -- Is_Dispatching_Operation Flag6
246 -- Is_Immediately_Visible Flag7
248 -- Is_Potentially_Use_Visible Flag9
252 -- Is_Constrained Flag12
253 -- Is_Generic_Type Flag13
254 -- Depends_On_Private Flag14
256 -- Is_Volatile Flag16
257 -- Is_Internal Flag17
258 -- Has_Delayed_Freeze Flag18
259 -- Is_Abstract_Subprogram Flag19
260 -- Is_Concurrent_Record_Type Flag20
262 -- Has_Master_Entity Flag21
263 -- Needs_No_Actuals Flag22
264 -- Has_Storage_Size_Clause Flag23
265 -- Is_Imported Flag24
266 -- Is_Limited_Record Flag25
267 -- Has_Completion Flag26
268 -- Has_Pragma_Controlled Flag27
269 -- Is_Statically_Allocated Flag28
270 -- Has_Size_Clause Flag29
273 -- Checks_May_Be_Suppressed Flag31
274 -- Kill_Elaboration_Checks Flag32
275 -- Kill_Range_Checks Flag33
276 -- Kill_Tag_Checks Flag34
277 -- Is_Class_Wide_Equivalent_Type Flag35
278 -- Referenced_As_LHS Flag36
279 -- Is_Known_Non_Null Flag37
280 -- Can_Never_Be_Null Flag38
281 -- Is_Overriding_Operation Flag39
282 -- Body_Needed_For_SAL Flag40
284 -- Treat_As_Volatile Flag41
285 -- Is_Controlled Flag42
286 -- Has_Controlled_Component Flag43
288 -- In_Private_Part Flag45
289 -- Has_Alignment_Clause Flag46
291 -- In_Package_Body Flag48
293 -- Delay_Subprogram_Descriptors Flag50
296 -- Is_Entry_Formal Flag52
297 -- Is_Private_Descendant Flag53
298 -- Return_Present Flag54
299 -- Is_Tagged_Type Flag55
300 -- Has_Homonym Flag56
302 -- Non_Binary_Modulus Flag58
303 -- Is_Preelaborated Flag59
304 -- Is_Shared_Passive Flag60
306 -- Is_Remote_Types Flag61
307 -- Is_Remote_Call_Interface Flag62
308 -- Is_Character_Type Flag63
309 -- Is_Intrinsic_Subprogram Flag64
310 -- Has_Record_Rep_Clause Flag65
311 -- Has_Enumeration_Rep_Clause Flag66
312 -- Has_Small_Clause Flag67
313 -- Has_Component_Size_Clause Flag68
314 -- Is_Access_Constant Flag69
315 -- Is_First_Subtype Flag70
317 -- Has_Completion_In_Body Flag71
318 -- Has_Unknown_Discriminants Flag72
319 -- Is_Child_Unit Flag73
320 -- Is_CPP_Class Flag74
321 -- Has_Non_Standard_Rep Flag75
322 -- Is_Constructor Flag76
323 -- Static_Elaboration_Desired Flag77
325 -- Has_All_Calls_Remote Flag79
326 -- Is_Constr_Subt_For_U_Nominal Flag80
328 -- Is_Asynchronous Flag81
329 -- Has_Gigi_Rep_Item Flag82
330 -- Has_Machine_Radix_Clause Flag83
331 -- Machine_Radix_10 Flag84
333 -- Has_Atomic_Components Flag86
334 -- Has_Volatile_Components Flag87
335 -- Discard_Names Flag88
336 -- Is_Interrupt_Handler Flag89
337 -- Returns_By_Ref Flag90
340 -- Size_Known_At_Compile_Time Flag92
341 -- Has_Subprogram_Descriptor Flag93
342 -- Is_Generic_Actual_Type Flag94
343 -- Uses_Sec_Stack Flag95
344 -- Warnings_Off Flag96
345 -- Is_Controlling_Formal Flag97
346 -- Has_Controlling_Result Flag98
347 -- Is_Exported Flag99
348 -- Has_Specified_Layout Flag100
350 -- Has_Nested_Block_With_Handler Flag101
352 -- Is_Completely_Hidden Flag103
353 -- Address_Taken Flag104
354 -- Suppress_Init_Proc Flag105
355 -- Is_Limited_Composite Flag106
356 -- Is_Private_Composite Flag107
357 -- Default_Expressions_Processed Flag108
358 -- Is_Non_Static_Subtype Flag109
359 -- Has_External_Tag_Rep_Clause Flag110
361 -- Is_Formal_Subprogram Flag111
362 -- Is_Renaming_Of_Object Flag112
364 -- Delay_Cleanups Flag114
365 -- Never_Set_In_Source Flag115
366 -- Is_Visible_Child_Unit Flag116
367 -- Is_Unchecked_Union Flag117
368 -- Is_For_Access_Subtype Flag118
369 -- Has_Convention_Pragma Flag119
370 -- Has_Primitive_Operations Flag120
372 -- Has_Pragma_Pack Flag121
373 -- Is_Bit_Packed_Array Flag122
374 -- Has_Unchecked_Union Flag123
375 -- Is_Eliminated Flag124
376 -- C_Pass_By_Copy Flag125
377 -- Is_Instantiated Flag126
378 -- Is_Valued_Procedure Flag127
379 -- (used for Component_Alignment) Flag128
380 -- (used for Component_Alignment) Flag129
381 -- Is_Generic_Instance Flag130
383 -- No_Pool_Assigned Flag131
384 -- Is_AST_Entry Flag132
385 -- Is_VMS_Exception Flag133
386 -- Is_Optional_Parameter Flag134
387 -- Has_Aliased_Components Flag135
388 -- No_Strict_Aliasing Flag136
389 -- Is_Machine_Code_Subprogram Flag137
390 -- Is_Packed_Array_Type Flag138
391 -- Has_Biased_Representation Flag139
392 -- Has_Complex_Representation Flag140
394 -- Is_Constr_Subt_For_UN_Aliased Flag141
395 -- Has_Missing_Return Flag142
396 -- Has_Recursive_Call Flag143
397 -- Is_Unsigned_Type Flag144
398 -- Strict_Alignment Flag145
399 -- Is_Abstract_Type Flag146
400 -- Needs_Debug_Info Flag147
401 -- Suppress_Elaboration_Warnings Flag148
402 -- Is_Compilation_Unit Flag149
403 -- Has_Pragma_Elaborate_Body Flag150
406 -- Entry_Accepted Flag152
407 -- Is_Obsolescent Flag153
408 -- Has_Per_Object_Constraint Flag154
409 -- Has_Private_Declaration Flag155
410 -- Referenced Flag156
411 -- Has_Pragma_Inline Flag157
412 -- Finalize_Storage_Only Flag158
413 -- From_With_Type Flag159
414 -- Is_Package_Body_Entity Flag160
416 -- Has_Qualified_Name Flag161
417 -- Nonzero_Is_True Flag162
418 -- Is_True_Constant Flag163
419 -- Reverse_Bit_Order Flag164
420 -- Suppress_Style_Checks Flag165
421 -- Debug_Info_Off Flag166
422 -- Sec_Stack_Needed_For_Return Flag167
423 -- Materialize_Entity Flag168
424 -- Is_Known_Valid Flag170
426 -- Is_Hidden_Open_Scope Flag171
427 -- Has_Object_Size_Clause Flag172
428 -- Has_Fully_Qualified_Name Flag173
429 -- Elaboration_Entity_Required Flag174
430 -- Has_Forward_Instantiation Flag175
431 -- Is_Discrim_SO_Function Flag176
432 -- Size_Depends_On_Discriminant Flag177
433 -- Is_Null_Init_Proc Flag178
434 -- Has_Pragma_Pure_Function Flag179
435 -- Has_Pragma_Unreferenced Flag180
437 -- Has_Contiguous_Rep Flag181
438 -- Has_Xref_Entry Flag182
439 -- Must_Be_On_Byte_Boundary Flag183
440 -- Has_Stream_Size_Clause Flag184
441 -- Is_Ada_2005_Only Flag185
442 -- Is_Interface Flag186
443 -- Has_Constrained_Partial_View Flag187
444 -- Has_Persistent_BSS Flag188
445 -- Is_Pure_Unit_Access_Type Flag189
446 -- Has_Specified_Stream_Input Flag190
448 -- Has_Specified_Stream_Output Flag191
449 -- Has_Specified_Stream_Read Flag192
450 -- Has_Specified_Stream_Write Flag193
451 -- Is_Local_Anonymous_Access Flag194
452 -- Is_Primitive_Wrapper Flag195
453 -- Was_Hidden Flag196
454 -- Is_Limited_Interface Flag197
455 -- Is_Protected_Interface Flag198
456 -- Is_Synchronized_Interface Flag199
457 -- Is_Task_Interface Flag200
459 -- Has_Anon_Block_Suffix Flag201
460 -- Itype_Printed Flag202
461 -- Has_Pragma_Pure Flag203
462 -- Is_Known_Null Flag204
463 -- Low_Bound_Known Flag205
464 -- Is_Visible_Formal Flag206
465 -- Known_To_Have_Preelab_Init Flag207
466 -- Must_Have_Preelab_Init Flag208
467 -- Is_Return_Object Flag209
468 -- Elaborate_Body_Desirable Flag210
470 -- Has_Static_Discriminants Flag211
471 -- Has_Pragma_Unreferenced_Objects Flag212
472 -- Requires_Overriding Flag213
474 -- Has_Up_Level_Access Flag215
475 -- Universal_Aliasing Flag216
476 -- Suppress_Value_Tracking_On_Call Flag217
477 -- Is_Primitive Flag218
478 -- Has_Initial_Value Flag219
479 -- Has_Dispatch_Table Flag220
481 -- Has_Pragma_Preelab_Init Flag221
482 -- Used_As_Generic_Actual Flag222
483 -- Is_Descendent_Of_Address Flag223
486 -- Is_Only_Out_Parameter Flag226
487 -- Referenced_As_Out_Parameter Flag227
488 -- Has_Thunks Flag228
489 -- Can_Use_Internal_Rep Flag229
490 -- Has_Pragma_Inline_Always Flag230
492 -- Renamed_In_Spec Flag231
493 -- Implemented_By_Entry Flag232
494 -- Has_Pragma_Unmodified Flag233
495 -- Is_Dispatch_Table_Entity Flag234
496 -- Is_Trivial_Subprogram Flag235
497 -- Warnings_Off_Used Flag236
498 -- Warnings_Off_Used_Unmodified Flag237
499 -- Warnings_Off_Used_Unreferenced Flag238
500 -- OK_To_Reorder_Components Flag239
501 -- Has_Postconditions Flag240
503 -- Optimize_Alignment_Space Flag241
504 -- Optimize_Alignment_Time Flag242
505 -- Overlays_Constant Flag243
506 -- Is_RACW_Stub_Type Flag244
513 -----------------------
514 -- Local subprograms --
515 -----------------------
517 function Rep_Clause
(Id
: E
; Rep_Name
: Name_Id
) return N
;
518 -- Returns the attribute definition clause for Id whose name is Rep_Name.
519 -- Returns Empty if no matching attribute definition clause found for Id.
525 function Rep_Clause
(Id
: E
; Rep_Name
: Name_Id
) return N
is
529 Ritem
:= First_Rep_Item
(Id
);
530 while Present
(Ritem
) loop
531 if Nkind
(Ritem
) = N_Attribute_Definition_Clause
532 and then Chars
(Ritem
) = Rep_Name
536 Ritem
:= Next_Rep_Item
(Ritem
);
543 --------------------------------
544 -- Attribute Access Functions --
545 --------------------------------
547 function Accept_Address
(Id
: E
) return L
is
552 function Access_Disp_Table
(Id
: E
) return L
is
554 pragma Assert
(Is_Tagged_Type
(Id
));
555 return Elist16
(Implementation_Base_Type
(Id
));
556 end Access_Disp_Table
;
558 function Actual_Subtype
(Id
: E
) return E
is
561 (Ekind
(Id
) = E_Constant
562 or else Ekind
(Id
) = E_Variable
563 or else Ekind
(Id
) = E_Generic_In_Out_Parameter
564 or else Is_Formal
(Id
));
568 function Address_Taken
(Id
: E
) return B
is
573 function Alias
(Id
: E
) return E
is
576 (Is_Overloadable
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
580 function Alignment
(Id
: E
) return U
is
582 pragma Assert
(Is_Type
(Id
)
583 or else Is_Formal
(Id
)
584 or else Ekind
(Id
) = E_Loop_Parameter
585 or else Ekind
(Id
) = E_Constant
586 or else Ekind
(Id
) = E_Exception
587 or else Ekind
(Id
) = E_Variable
);
591 function Associated_Final_Chain
(Id
: E
) return E
is
593 pragma Assert
(Is_Access_Type
(Id
));
595 end Associated_Final_Chain
;
597 function Associated_Formal_Package
(Id
: E
) return E
is
599 pragma Assert
(Ekind
(Id
) = E_Package
);
601 end Associated_Formal_Package
;
603 function Associated_Node_For_Itype
(Id
: E
) return N
is
606 end Associated_Node_For_Itype
;
608 function Associated_Storage_Pool
(Id
: E
) return E
is
610 pragma Assert
(Is_Access_Type
(Id
));
611 return Node22
(Root_Type
(Id
));
612 end Associated_Storage_Pool
;
614 function Barrier_Function
(Id
: E
) return N
is
616 pragma Assert
(Is_Entry
(Id
));
618 end Barrier_Function
;
620 function Block_Node
(Id
: E
) return N
is
622 pragma Assert
(Ekind
(Id
) = E_Block
);
626 function Body_Entity
(Id
: E
) return E
is
629 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
633 function Body_Needed_For_SAL
(Id
: E
) return B
is
636 (Ekind
(Id
) = E_Package
637 or else Is_Subprogram
(Id
)
638 or else Is_Generic_Unit
(Id
));
640 end Body_Needed_For_SAL
;
642 function C_Pass_By_Copy
(Id
: E
) return B
is
644 pragma Assert
(Is_Record_Type
(Id
));
645 return Flag125
(Implementation_Base_Type
(Id
));
648 function Can_Never_Be_Null
(Id
: E
) return B
is
651 end Can_Never_Be_Null
;
653 function Checks_May_Be_Suppressed
(Id
: E
) return B
is
656 end Checks_May_Be_Suppressed
;
658 function Class_Wide_Type
(Id
: E
) return E
is
660 pragma Assert
(Is_Type
(Id
));
664 function Cloned_Subtype
(Id
: E
) return E
is
667 (Ekind
(Id
) = E_Record_Subtype
668 or else Ekind
(Id
) = E_Class_Wide_Subtype
);
672 function Component_Bit_Offset
(Id
: E
) return U
is
675 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
677 end Component_Bit_Offset
;
679 function Component_Clause
(Id
: E
) return N
is
682 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
684 end Component_Clause
;
686 function Component_Size
(Id
: E
) return U
is
688 pragma Assert
(Is_Array_Type
(Id
));
689 return Uint22
(Implementation_Base_Type
(Id
));
692 function Component_Type
(Id
: E
) return E
is
694 return Node20
(Implementation_Base_Type
(Id
));
697 function Corresponding_Concurrent_Type
(Id
: E
) return E
is
699 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
701 end Corresponding_Concurrent_Type
;
703 function Corresponding_Discriminant
(Id
: E
) return E
is
705 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
707 end Corresponding_Discriminant
;
709 function Corresponding_Equality
(Id
: E
) return E
is
712 (Ekind
(Id
) = E_Function
713 and then not Comes_From_Source
(Id
)
714 and then Chars
(Id
) = Name_Op_Ne
);
716 end Corresponding_Equality
;
718 function Corresponding_Record_Type
(Id
: E
) return E
is
720 pragma Assert
(Is_Concurrent_Type
(Id
));
722 end Corresponding_Record_Type
;
724 function Corresponding_Remote_Type
(Id
: E
) return E
is
727 end Corresponding_Remote_Type
;
729 function Current_Use_Clause
(Id
: E
) return E
is
731 pragma Assert
(Ekind
(Id
) = E_Package
or else Is_Type
(Id
));
733 end Current_Use_Clause
;
735 function Current_Value
(Id
: E
) return N
is
737 pragma Assert
(Ekind
(Id
) in Object_Kind
);
741 function CR_Discriminant
(Id
: E
) return E
is
746 function Debug_Info_Off
(Id
: E
) return B
is
751 function Debug_Renaming_Link
(Id
: E
) return E
is
754 end Debug_Renaming_Link
;
756 function Default_Expr_Function
(Id
: E
) return E
is
758 pragma Assert
(Is_Formal
(Id
));
760 end Default_Expr_Function
;
762 function Default_Expressions_Processed
(Id
: E
) return B
is
765 end Default_Expressions_Processed
;
767 function Default_Value
(Id
: E
) return N
is
769 pragma Assert
(Is_Formal
(Id
));
773 function Delay_Cleanups
(Id
: E
) return B
is
778 function Delay_Subprogram_Descriptors
(Id
: E
) return B
is
781 end Delay_Subprogram_Descriptors
;
783 function Delta_Value
(Id
: E
) return R
is
785 pragma Assert
(Is_Fixed_Point_Type
(Id
));
789 function Dependent_Instances
(Id
: E
) return L
is
791 pragma Assert
(Is_Generic_Instance
(Id
));
793 end Dependent_Instances
;
795 function Depends_On_Private
(Id
: E
) return B
is
797 pragma Assert
(Nkind
(Id
) in N_Entity
);
799 end Depends_On_Private
;
801 function Digits_Value
(Id
: E
) return U
is
804 (Is_Floating_Point_Type
(Id
)
805 or else Is_Decimal_Fixed_Point_Type
(Id
));
809 function Directly_Designated_Type
(Id
: E
) return E
is
812 end Directly_Designated_Type
;
814 function Discard_Names
(Id
: E
) return B
is
819 function Discriminal
(Id
: E
) return E
is
821 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
825 function Discriminal_Link
(Id
: E
) return N
is
828 end Discriminal_Link
;
830 function Discriminant_Checking_Func
(Id
: E
) return E
is
832 pragma Assert
(Ekind
(Id
) = E_Component
);
834 end Discriminant_Checking_Func
;
836 function Discriminant_Constraint
(Id
: E
) return L
is
838 pragma Assert
(Is_Composite_Type
(Id
) and then Has_Discriminants
(Id
));
840 end Discriminant_Constraint
;
842 function Discriminant_Default_Value
(Id
: E
) return N
is
844 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
846 end Discriminant_Default_Value
;
848 function Discriminant_Number
(Id
: E
) return U
is
850 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
852 end Discriminant_Number
;
854 function Dispatch_Table_Wrapper
(Id
: E
) return E
is
856 pragma Assert
(Is_Tagged_Type
(Id
));
857 return Node26
(Implementation_Base_Type
(Id
));
858 end Dispatch_Table_Wrapper
;
860 function DT_Entry_Count
(Id
: E
) return U
is
862 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
866 function DT_Offset_To_Top_Func
(Id
: E
) return E
is
868 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
870 end DT_Offset_To_Top_Func
;
872 function DT_Position
(Id
: E
) return U
is
875 ((Ekind
(Id
) = E_Function
876 or else Ekind
(Id
) = E_Procedure
)
877 and then Present
(DTC_Entity
(Id
)));
881 function DTC_Entity
(Id
: E
) return E
is
884 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
888 function Elaborate_Body_Desirable
(Id
: E
) return B
is
890 pragma Assert
(Ekind
(Id
) = E_Package
);
892 end Elaborate_Body_Desirable
;
894 function Elaboration_Entity
(Id
: E
) return E
is
899 Ekind
(Id
) = E_Package
901 Is_Generic_Unit
(Id
));
903 end Elaboration_Entity
;
905 function Elaboration_Entity_Required
(Id
: E
) return B
is
910 Ekind
(Id
) = E_Package
912 Is_Generic_Unit
(Id
));
914 end Elaboration_Entity_Required
;
916 function Enclosing_Scope
(Id
: E
) return E
is
921 function Entry_Accepted
(Id
: E
) return B
is
923 pragma Assert
(Is_Entry
(Id
));
927 function Entry_Bodies_Array
(Id
: E
) return E
is
930 end Entry_Bodies_Array
;
932 function Entry_Cancel_Parameter
(Id
: E
) return E
is
935 end Entry_Cancel_Parameter
;
937 function Entry_Component
(Id
: E
) return E
is
942 function Entry_Formal
(Id
: E
) return E
is
947 function Entry_Index_Constant
(Id
: E
) return N
is
949 pragma Assert
(Ekind
(Id
) = E_Entry_Index_Parameter
);
951 end Entry_Index_Constant
;
953 function Entry_Parameters_Type
(Id
: E
) return E
is
956 end Entry_Parameters_Type
;
958 function Enum_Pos_To_Rep
(Id
: E
) return E
is
960 pragma Assert
(Ekind
(Id
) = E_Enumeration_Type
);
964 function Enumeration_Pos
(Id
: E
) return Uint
is
966 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
970 function Enumeration_Rep
(Id
: E
) return U
is
972 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
976 function Enumeration_Rep_Expr
(Id
: E
) return N
is
978 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
980 end Enumeration_Rep_Expr
;
982 function Equivalent_Type
(Id
: E
) return E
is
985 (Ekind
(Id
) = E_Class_Wide_Subtype
or else
986 Ekind
(Id
) = E_Access_Protected_Subprogram_Type
or else
987 Ekind
(Id
) = E_Anonymous_Access_Protected_Subprogram_Type
or else
988 Ekind
(Id
) = E_Access_Subprogram_Type
or else
989 Ekind
(Id
) = E_Exception_Type
);
993 function Esize
(Id
: E
) return Uint
is
998 function Exception_Code
(Id
: E
) return Uint
is
1000 pragma Assert
(Ekind
(Id
) = E_Exception
);
1004 function Extra_Accessibility
(Id
: E
) return E
is
1006 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
1008 end Extra_Accessibility
;
1010 function Extra_Constrained
(Id
: E
) return E
is
1012 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
1014 end Extra_Constrained
;
1016 function Extra_Formal
(Id
: E
) return E
is
1021 function Extra_Formals
(Id
: E
) return E
is
1024 (Is_Overloadable
(Id
)
1025 or else Ekind
(Id
) = E_Entry_Family
1026 or else Ekind
(Id
) = E_Subprogram_Body
1027 or else Ekind
(Id
) = E_Subprogram_Type
);
1031 function Can_Use_Internal_Rep
(Id
: E
) return B
is
1033 pragma Assert
(Is_Access_Subprogram_Type
(Base_Type
(Id
)));
1034 return Flag229
(Base_Type
(Id
));
1035 end Can_Use_Internal_Rep
;
1037 function Finalization_Chain_Entity
(Id
: E
) return E
is
1040 end Finalization_Chain_Entity
;
1042 function Finalize_Storage_Only
(Id
: E
) return B
is
1044 pragma Assert
(Is_Type
(Id
));
1045 return Flag158
(Base_Type
(Id
));
1046 end Finalize_Storage_Only
;
1048 function First_Entity
(Id
: E
) return E
is
1053 function First_Index
(Id
: E
) return N
is
1055 pragma Assert
(Is_Array_Type
(Id
) or else Is_String_Type
(Id
));
1059 function First_Literal
(Id
: E
) return E
is
1061 pragma Assert
(Is_Enumeration_Type
(Id
));
1065 function First_Optional_Parameter
(Id
: E
) return E
is
1068 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
1070 end First_Optional_Parameter
;
1072 function First_Private_Entity
(Id
: E
) return E
is
1074 pragma Assert
(Ekind
(Id
) = E_Package
1075 or else Ekind
(Id
) = E_Generic_Package
1076 or else Ekind
(Id
) in Concurrent_Kind
);
1078 end First_Private_Entity
;
1080 function First_Rep_Item
(Id
: E
) return E
is
1085 function Freeze_Node
(Id
: E
) return N
is
1090 function From_With_Type
(Id
: E
) return B
is
1092 return Flag159
(Id
);
1095 function Full_View
(Id
: E
) return E
is
1097 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Constant
);
1101 function Generic_Homonym
(Id
: E
) return E
is
1103 pragma Assert
(Ekind
(Id
) = E_Generic_Package
);
1105 end Generic_Homonym
;
1107 function Generic_Renamings
(Id
: E
) return L
is
1109 return Elist23
(Id
);
1110 end Generic_Renamings
;
1112 function Handler_Records
(Id
: E
) return S
is
1115 end Handler_Records
;
1117 function Has_Aliased_Components
(Id
: E
) return B
is
1119 return Flag135
(Implementation_Base_Type
(Id
));
1120 end Has_Aliased_Components
;
1122 function Has_Alignment_Clause
(Id
: E
) return B
is
1125 end Has_Alignment_Clause
;
1127 function Has_All_Calls_Remote
(Id
: E
) return B
is
1130 end Has_All_Calls_Remote
;
1132 function Has_Anon_Block_Suffix
(Id
: E
) return B
is
1134 return Flag201
(Id
);
1135 end Has_Anon_Block_Suffix
;
1137 function Has_Atomic_Components
(Id
: E
) return B
is
1139 return Flag86
(Implementation_Base_Type
(Id
));
1140 end Has_Atomic_Components
;
1142 function Has_Biased_Representation
(Id
: E
) return B
is
1144 return Flag139
(Id
);
1145 end Has_Biased_Representation
;
1147 function Has_Completion
(Id
: E
) return B
is
1152 function Has_Completion_In_Body
(Id
: E
) return B
is
1154 pragma Assert
(Is_Type
(Id
));
1156 end Has_Completion_In_Body
;
1158 function Has_Complex_Representation
(Id
: E
) return B
is
1160 pragma Assert
(Is_Type
(Id
));
1161 return Flag140
(Implementation_Base_Type
(Id
));
1162 end Has_Complex_Representation
;
1164 function Has_Component_Size_Clause
(Id
: E
) return B
is
1166 pragma Assert
(Is_Array_Type
(Id
));
1167 return Flag68
(Implementation_Base_Type
(Id
));
1168 end Has_Component_Size_Clause
;
1170 function Has_Constrained_Partial_View
(Id
: E
) return B
is
1172 pragma Assert
(Is_Type
(Id
));
1173 return Flag187
(Id
);
1174 end Has_Constrained_Partial_View
;
1176 function Has_Controlled_Component
(Id
: E
) return B
is
1178 return Flag43
(Base_Type
(Id
));
1179 end Has_Controlled_Component
;
1181 function Has_Contiguous_Rep
(Id
: E
) return B
is
1183 return Flag181
(Id
);
1184 end Has_Contiguous_Rep
;
1186 function Has_Controlling_Result
(Id
: E
) return B
is
1189 end Has_Controlling_Result
;
1191 function Has_Convention_Pragma
(Id
: E
) return B
is
1193 return Flag119
(Id
);
1194 end Has_Convention_Pragma
;
1196 function Has_Delayed_Freeze
(Id
: E
) return B
is
1198 pragma Assert
(Nkind
(Id
) in N_Entity
);
1200 end Has_Delayed_Freeze
;
1202 function Has_Discriminants
(Id
: E
) return B
is
1204 pragma Assert
(Nkind
(Id
) in N_Entity
);
1206 end Has_Discriminants
;
1208 function Has_Dispatch_Table
(Id
: E
) return B
is
1210 pragma Assert
(Is_Tagged_Type
(Id
));
1211 return Flag220
(Id
);
1212 end Has_Dispatch_Table
;
1214 function Has_Enumeration_Rep_Clause
(Id
: E
) return B
is
1216 pragma Assert
(Is_Enumeration_Type
(Id
));
1218 end Has_Enumeration_Rep_Clause
;
1220 function Has_Exit
(Id
: E
) return B
is
1225 function Has_External_Tag_Rep_Clause
(Id
: E
) return B
is
1227 pragma Assert
(Is_Tagged_Type
(Id
));
1228 return Flag110
(Id
);
1229 end Has_External_Tag_Rep_Clause
;
1231 function Has_Forward_Instantiation
(Id
: E
) return B
is
1233 return Flag175
(Id
);
1234 end Has_Forward_Instantiation
;
1236 function Has_Fully_Qualified_Name
(Id
: E
) return B
is
1238 return Flag173
(Id
);
1239 end Has_Fully_Qualified_Name
;
1241 function Has_Gigi_Rep_Item
(Id
: E
) return B
is
1244 end Has_Gigi_Rep_Item
;
1246 function Has_Homonym
(Id
: E
) return B
is
1251 function Has_Initial_Value
(Id
: E
) return B
is
1254 (Ekind
(Id
) = E_Variable
or else Is_Formal
(Id
));
1255 return Flag219
(Id
);
1256 end Has_Initial_Value
;
1258 function Has_Machine_Radix_Clause
(Id
: E
) return B
is
1260 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
1262 end Has_Machine_Radix_Clause
;
1264 function Has_Master_Entity
(Id
: E
) return B
is
1267 end Has_Master_Entity
;
1269 function Has_Missing_Return
(Id
: E
) return B
is
1272 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Generic_Function
);
1273 return Flag142
(Id
);
1274 end Has_Missing_Return
;
1276 function Has_Nested_Block_With_Handler
(Id
: E
) return B
is
1278 return Flag101
(Id
);
1279 end Has_Nested_Block_With_Handler
;
1281 function Has_Non_Standard_Rep
(Id
: E
) return B
is
1283 return Flag75
(Implementation_Base_Type
(Id
));
1284 end Has_Non_Standard_Rep
;
1286 function Has_Object_Size_Clause
(Id
: E
) return B
is
1288 pragma Assert
(Is_Type
(Id
));
1289 return Flag172
(Id
);
1290 end Has_Object_Size_Clause
;
1292 function Has_Per_Object_Constraint
(Id
: E
) return B
is
1294 return Flag154
(Id
);
1295 end Has_Per_Object_Constraint
;
1297 function Has_Persistent_BSS
(Id
: E
) return B
is
1299 return Flag188
(Id
);
1300 end Has_Persistent_BSS
;
1302 function Has_Postconditions
(Id
: E
) return B
is
1304 pragma Assert
(Is_Subprogram
(Id
));
1305 return Flag240
(Id
);
1306 end Has_Postconditions
;
1308 function Has_Pragma_Controlled
(Id
: E
) return B
is
1310 pragma Assert
(Is_Access_Type
(Id
));
1311 return Flag27
(Implementation_Base_Type
(Id
));
1312 end Has_Pragma_Controlled
;
1314 function Has_Pragma_Elaborate_Body
(Id
: E
) return B
is
1316 return Flag150
(Id
);
1317 end Has_Pragma_Elaborate_Body
;
1319 function Has_Pragma_Inline
(Id
: E
) return B
is
1321 return Flag157
(Id
);
1322 end Has_Pragma_Inline
;
1324 function Has_Pragma_Inline_Always
(Id
: E
) return B
is
1326 return Flag230
(Id
);
1327 end Has_Pragma_Inline_Always
;
1329 function Has_Pragma_Pack
(Id
: E
) return B
is
1331 pragma Assert
(Is_Record_Type
(Id
) or else Is_Array_Type
(Id
));
1332 return Flag121
(Implementation_Base_Type
(Id
));
1333 end Has_Pragma_Pack
;
1335 function Has_Pragma_Preelab_Init
(Id
: E
) return B
is
1337 return Flag221
(Id
);
1338 end Has_Pragma_Preelab_Init
;
1340 function Has_Pragma_Pure
(Id
: E
) return B
is
1342 return Flag203
(Id
);
1343 end Has_Pragma_Pure
;
1345 function Has_Pragma_Pure_Function
(Id
: E
) return B
is
1347 return Flag179
(Id
);
1348 end Has_Pragma_Pure_Function
;
1350 function Has_Pragma_Unmodified
(Id
: E
) return B
is
1352 return Flag233
(Id
);
1353 end Has_Pragma_Unmodified
;
1355 function Has_Pragma_Unreferenced
(Id
: E
) return B
is
1357 return Flag180
(Id
);
1358 end Has_Pragma_Unreferenced
;
1360 function Has_Pragma_Unreferenced_Objects
(Id
: E
) return B
is
1362 pragma Assert
(Is_Type
(Id
));
1363 return Flag212
(Id
);
1364 end Has_Pragma_Unreferenced_Objects
;
1366 function Has_Primitive_Operations
(Id
: E
) return B
is
1368 pragma Assert
(Is_Type
(Id
));
1369 return Flag120
(Base_Type
(Id
));
1370 end Has_Primitive_Operations
;
1372 function Has_Private_Declaration
(Id
: E
) return B
is
1374 return Flag155
(Id
);
1375 end Has_Private_Declaration
;
1377 function Has_Qualified_Name
(Id
: E
) return B
is
1379 return Flag161
(Id
);
1380 end Has_Qualified_Name
;
1382 function Has_RACW
(Id
: E
) return B
is
1384 pragma Assert
(Ekind
(Id
) = E_Package
);
1385 return Flag214
(Id
);
1388 function Has_Record_Rep_Clause
(Id
: E
) return B
is
1390 pragma Assert
(Is_Record_Type
(Id
));
1391 return Flag65
(Implementation_Base_Type
(Id
));
1392 end Has_Record_Rep_Clause
;
1394 function Has_Recursive_Call
(Id
: E
) return B
is
1396 pragma Assert
(Is_Subprogram
(Id
));
1397 return Flag143
(Id
);
1398 end Has_Recursive_Call
;
1400 function Has_Size_Clause
(Id
: E
) return B
is
1403 end Has_Size_Clause
;
1405 function Has_Small_Clause
(Id
: E
) return B
is
1408 end Has_Small_Clause
;
1410 function Has_Specified_Layout
(Id
: E
) return B
is
1412 pragma Assert
(Is_Type
(Id
));
1413 return Flag100
(Implementation_Base_Type
(Id
));
1414 end Has_Specified_Layout
;
1416 function Has_Specified_Stream_Input
(Id
: E
) return B
is
1418 pragma Assert
(Is_Type
(Id
));
1419 return Flag190
(Id
);
1420 end Has_Specified_Stream_Input
;
1422 function Has_Specified_Stream_Output
(Id
: E
) return B
is
1424 pragma Assert
(Is_Type
(Id
));
1425 return Flag191
(Id
);
1426 end Has_Specified_Stream_Output
;
1428 function Has_Specified_Stream_Read
(Id
: E
) return B
is
1430 pragma Assert
(Is_Type
(Id
));
1431 return Flag192
(Id
);
1432 end Has_Specified_Stream_Read
;
1434 function Has_Specified_Stream_Write
(Id
: E
) return B
is
1436 pragma Assert
(Is_Type
(Id
));
1437 return Flag193
(Id
);
1438 end Has_Specified_Stream_Write
;
1440 function Has_Static_Discriminants
(Id
: E
) return B
is
1442 pragma Assert
(Is_Type
(Id
));
1443 return Flag211
(Id
);
1444 end Has_Static_Discriminants
;
1446 function Has_Storage_Size_Clause
(Id
: E
) return B
is
1448 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
1449 return Flag23
(Implementation_Base_Type
(Id
));
1450 end Has_Storage_Size_Clause
;
1452 function Has_Stream_Size_Clause
(Id
: E
) return B
is
1454 return Flag184
(Id
);
1455 end Has_Stream_Size_Clause
;
1457 function Has_Subprogram_Descriptor
(Id
: E
) return B
is
1460 end Has_Subprogram_Descriptor
;
1462 function Has_Task
(Id
: E
) return B
is
1464 return Flag30
(Base_Type
(Id
));
1467 function Has_Thunks
(Id
: E
) return B
is
1469 pragma Assert
(Ekind
(Id
) = E_Constant
);
1470 return Flag228
(Id
);
1473 function Has_Unchecked_Union
(Id
: E
) return B
is
1475 return Flag123
(Base_Type
(Id
));
1476 end Has_Unchecked_Union
;
1478 function Has_Unknown_Discriminants
(Id
: E
) return B
is
1480 pragma Assert
(Is_Type
(Id
));
1482 end Has_Unknown_Discriminants
;
1484 function Has_Up_Level_Access
(Id
: E
) return B
is
1487 (Ekind
(Id
) = E_Variable
1488 or else Ekind
(Id
) = E_Constant
1489 or else Ekind
(Id
) = E_Loop_Parameter
);
1490 return Flag215
(Id
);
1491 end Has_Up_Level_Access
;
1493 function Has_Volatile_Components
(Id
: E
) return B
is
1495 return Flag87
(Implementation_Base_Type
(Id
));
1496 end Has_Volatile_Components
;
1498 function Has_Xref_Entry
(Id
: E
) return B
is
1500 return Flag182
(Implementation_Base_Type
(Id
));
1503 function Hiding_Loop_Variable
(Id
: E
) return E
is
1505 pragma Assert
(Ekind
(Id
) = E_Variable
);
1507 end Hiding_Loop_Variable
;
1509 function Homonym
(Id
: E
) return E
is
1514 function Implemented_By_Entry
(Id
: E
) return B
is
1517 (Ekind
(Id
) = E_Function
1518 or else Ekind
(Id
) = E_Procedure
);
1519 return Flag232
(Id
);
1520 end Implemented_By_Entry
;
1522 function Interfaces
(Id
: E
) return L
is
1524 pragma Assert
(Is_Record_Type
(Id
));
1525 return Elist25
(Id
);
1528 function Interface_Alias
(Id
: E
) return E
is
1530 pragma Assert
(Is_Subprogram
(Id
));
1532 end Interface_Alias
;
1534 function In_Package_Body
(Id
: E
) return B
is
1537 end In_Package_Body
;
1539 function In_Private_Part
(Id
: E
) return B
is
1542 end In_Private_Part
;
1544 function In_Use
(Id
: E
) return B
is
1546 pragma Assert
(Nkind
(Id
) in N_Entity
);
1550 function Inner_Instances
(Id
: E
) return L
is
1552 return Elist23
(Id
);
1553 end Inner_Instances
;
1555 function Interface_Name
(Id
: E
) return N
is
1560 function Is_Abstract_Subprogram
(Id
: E
) return B
is
1562 pragma Assert
(Is_Overloadable
(Id
));
1564 end Is_Abstract_Subprogram
;
1566 function Is_Abstract_Type
(Id
: E
) return B
is
1568 pragma Assert
(Is_Type
(Id
));
1569 return Flag146
(Id
);
1570 end Is_Abstract_Type
;
1572 function Is_Local_Anonymous_Access
(Id
: E
) return B
is
1574 pragma Assert
(Is_Access_Type
(Id
));
1575 return Flag194
(Id
);
1576 end Is_Local_Anonymous_Access
;
1578 function Is_Access_Constant
(Id
: E
) return B
is
1580 pragma Assert
(Is_Access_Type
(Id
));
1582 end Is_Access_Constant
;
1584 function Is_Ada_2005_Only
(Id
: E
) return B
is
1586 return Flag185
(Id
);
1587 end Is_Ada_2005_Only
;
1589 function Is_Aliased
(Id
: E
) return B
is
1591 pragma Assert
(Nkind
(Id
) in N_Entity
);
1595 function Is_AST_Entry
(Id
: E
) return B
is
1597 pragma Assert
(Is_Entry
(Id
));
1598 return Flag132
(Id
);
1601 function Is_Asynchronous
(Id
: E
) return B
is
1604 (Ekind
(Id
) = E_Procedure
or else Is_Type
(Id
));
1606 end Is_Asynchronous
;
1608 function Is_Atomic
(Id
: E
) return B
is
1613 function Is_Bit_Packed_Array
(Id
: E
) return B
is
1615 return Flag122
(Implementation_Base_Type
(Id
));
1616 end Is_Bit_Packed_Array
;
1618 function Is_Called
(Id
: E
) return B
is
1621 (Ekind
(Id
) = E_Procedure
or else Ekind
(Id
) = E_Function
);
1622 return Flag102
(Id
);
1625 function Is_Character_Type
(Id
: E
) return B
is
1628 end Is_Character_Type
;
1630 function Is_Child_Unit
(Id
: E
) return B
is
1635 function Is_Class_Wide_Equivalent_Type
(Id
: E
) return B
is
1638 end Is_Class_Wide_Equivalent_Type
;
1640 function Is_Compilation_Unit
(Id
: E
) return B
is
1642 return Flag149
(Id
);
1643 end Is_Compilation_Unit
;
1645 function Is_Completely_Hidden
(Id
: E
) return B
is
1647 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
1648 return Flag103
(Id
);
1649 end Is_Completely_Hidden
;
1651 function Is_Constr_Subt_For_U_Nominal
(Id
: E
) return B
is
1654 end Is_Constr_Subt_For_U_Nominal
;
1656 function Is_Constr_Subt_For_UN_Aliased
(Id
: E
) return B
is
1658 return Flag141
(Id
);
1659 end Is_Constr_Subt_For_UN_Aliased
;
1661 function Is_Constrained
(Id
: E
) return B
is
1663 pragma Assert
(Nkind
(Id
) in N_Entity
);
1667 function Is_Constructor
(Id
: E
) return B
is
1672 function Is_Controlled
(Id
: E
) return B
is
1674 return Flag42
(Base_Type
(Id
));
1677 function Is_Controlling_Formal
(Id
: E
) return B
is
1679 pragma Assert
(Is_Formal
(Id
));
1681 end Is_Controlling_Formal
;
1683 function Is_CPP_Class
(Id
: E
) return B
is
1688 function Is_Descendent_Of_Address
(Id
: E
) return B
is
1690 pragma Assert
(Is_Type
(Id
));
1691 return Flag223
(Id
);
1692 end Is_Descendent_Of_Address
;
1694 function Is_Discrim_SO_Function
(Id
: E
) return B
is
1696 return Flag176
(Id
);
1697 end Is_Discrim_SO_Function
;
1699 function Is_Dispatch_Table_Entity
(Id
: E
) return B
is
1701 return Flag234
(Id
);
1702 end Is_Dispatch_Table_Entity
;
1704 function Is_Dispatching_Operation
(Id
: E
) return B
is
1706 pragma Assert
(Nkind
(Id
) in N_Entity
);
1708 end Is_Dispatching_Operation
;
1710 function Is_Eliminated
(Id
: E
) return B
is
1712 return Flag124
(Id
);
1715 function Is_Entry_Formal
(Id
: E
) return B
is
1718 end Is_Entry_Formal
;
1720 function Is_Exported
(Id
: E
) return B
is
1725 function Is_First_Subtype
(Id
: E
) return B
is
1728 end Is_First_Subtype
;
1730 function Is_For_Access_Subtype
(Id
: E
) return B
is
1733 (Ekind
(Id
) = E_Record_Subtype
1735 Ekind
(Id
) = E_Private_Subtype
);
1736 return Flag118
(Id
);
1737 end Is_For_Access_Subtype
;
1739 function Is_Formal_Subprogram
(Id
: E
) return B
is
1741 return Flag111
(Id
);
1742 end Is_Formal_Subprogram
;
1744 function Is_Frozen
(Id
: E
) return B
is
1749 function Is_Generic_Actual_Type
(Id
: E
) return B
is
1751 pragma Assert
(Is_Type
(Id
));
1753 end Is_Generic_Actual_Type
;
1755 function Is_Generic_Instance
(Id
: E
) return B
is
1757 return Flag130
(Id
);
1758 end Is_Generic_Instance
;
1760 function Is_Generic_Type
(Id
: E
) return B
is
1762 pragma Assert
(Nkind
(Id
) in N_Entity
);
1764 end Is_Generic_Type
;
1766 function Is_Hidden
(Id
: E
) return B
is
1771 function Is_Hidden_Open_Scope
(Id
: E
) return B
is
1773 return Flag171
(Id
);
1774 end Is_Hidden_Open_Scope
;
1776 function Is_Immediately_Visible
(Id
: E
) return B
is
1778 pragma Assert
(Nkind
(Id
) in N_Entity
);
1780 end Is_Immediately_Visible
;
1782 function Is_Imported
(Id
: E
) return B
is
1787 function Is_Inlined
(Id
: E
) return B
is
1792 function Is_Interface
(Id
: E
) return B
is
1794 return Flag186
(Id
);
1797 function Is_Instantiated
(Id
: E
) return B
is
1799 return Flag126
(Id
);
1800 end Is_Instantiated
;
1802 function Is_Internal
(Id
: E
) return B
is
1804 pragma Assert
(Nkind
(Id
) in N_Entity
);
1808 function Is_Interrupt_Handler
(Id
: E
) return B
is
1810 pragma Assert
(Nkind
(Id
) in N_Entity
);
1812 end Is_Interrupt_Handler
;
1814 function Is_Intrinsic_Subprogram
(Id
: E
) return B
is
1817 end Is_Intrinsic_Subprogram
;
1819 function Is_Itype
(Id
: E
) return B
is
1824 function Is_Known_Non_Null
(Id
: E
) return B
is
1827 end Is_Known_Non_Null
;
1829 function Is_Known_Null
(Id
: E
) return B
is
1831 return Flag204
(Id
);
1834 function Is_Known_Valid
(Id
: E
) return B
is
1836 return Flag170
(Id
);
1839 function Is_Limited_Composite
(Id
: E
) return B
is
1841 return Flag106
(Id
);
1842 end Is_Limited_Composite
;
1844 function Is_Limited_Interface
(Id
: E
) return B
is
1846 return Flag197
(Id
);
1847 end Is_Limited_Interface
;
1849 function Is_Limited_Record
(Id
: E
) return B
is
1852 end Is_Limited_Record
;
1854 function Is_Machine_Code_Subprogram
(Id
: E
) return B
is
1856 pragma Assert
(Is_Subprogram
(Id
));
1857 return Flag137
(Id
);
1858 end Is_Machine_Code_Subprogram
;
1860 function Is_Non_Static_Subtype
(Id
: E
) return B
is
1862 pragma Assert
(Is_Type
(Id
));
1863 return Flag109
(Id
);
1864 end Is_Non_Static_Subtype
;
1866 function Is_Null_Init_Proc
(Id
: E
) return B
is
1868 pragma Assert
(Ekind
(Id
) = E_Procedure
);
1869 return Flag178
(Id
);
1870 end Is_Null_Init_Proc
;
1872 function Is_Obsolescent
(Id
: E
) return B
is
1874 return Flag153
(Id
);
1877 function Is_Only_Out_Parameter
(Id
: E
) return B
is
1879 pragma Assert
(Is_Formal
(Id
));
1880 return Flag226
(Id
);
1881 end Is_Only_Out_Parameter
;
1883 function Is_Optional_Parameter
(Id
: E
) return B
is
1885 pragma Assert
(Is_Formal
(Id
));
1886 return Flag134
(Id
);
1887 end Is_Optional_Parameter
;
1889 function Is_Overriding_Operation
(Id
: E
) return B
is
1891 pragma Assert
(Is_Subprogram
(Id
));
1893 end Is_Overriding_Operation
;
1895 function Is_Package_Body_Entity
(Id
: E
) return B
is
1897 return Flag160
(Id
);
1898 end Is_Package_Body_Entity
;
1900 function Is_Packed
(Id
: E
) return B
is
1902 return Flag51
(Implementation_Base_Type
(Id
));
1905 function Is_Packed_Array_Type
(Id
: E
) return B
is
1907 return Flag138
(Id
);
1908 end Is_Packed_Array_Type
;
1910 function Is_Potentially_Use_Visible
(Id
: E
) return B
is
1912 pragma Assert
(Nkind
(Id
) in N_Entity
);
1914 end Is_Potentially_Use_Visible
;
1916 function Is_Preelaborated
(Id
: E
) return B
is
1919 end Is_Preelaborated
;
1921 function Is_Primitive
(Id
: E
) return B
is
1924 (Is_Overloadable
(Id
)
1925 or else Ekind
(Id
) = E_Generic_Function
1926 or else Ekind
(Id
) = E_Generic_Procedure
);
1927 return Flag218
(Id
);
1930 function Is_Primitive_Wrapper
(Id
: E
) return B
is
1932 pragma Assert
(Ekind
(Id
) = E_Procedure
);
1933 return Flag195
(Id
);
1934 end Is_Primitive_Wrapper
;
1936 function Is_Private_Composite
(Id
: E
) return B
is
1938 pragma Assert
(Is_Type
(Id
));
1939 return Flag107
(Id
);
1940 end Is_Private_Composite
;
1942 function Is_Private_Descendant
(Id
: E
) return B
is
1945 end Is_Private_Descendant
;
1947 function Is_Protected_Interface
(Id
: E
) return B
is
1949 pragma Assert
(Is_Interface
(Id
));
1950 return Flag198
(Id
);
1951 end Is_Protected_Interface
;
1953 function Is_Public
(Id
: E
) return B
is
1955 pragma Assert
(Nkind
(Id
) in N_Entity
);
1959 function Is_Pure
(Id
: E
) return B
is
1964 function Is_Pure_Unit_Access_Type
(Id
: E
) return B
is
1966 pragma Assert
(Is_Access_Type
(Id
));
1967 return Flag189
(Id
);
1968 end Is_Pure_Unit_Access_Type
;
1970 function Is_RACW_Stub_Type
(Id
: E
) return B
is
1972 pragma Assert
(Is_Type
(Id
));
1973 return Flag244
(Id
);
1974 end Is_RACW_Stub_Type
;
1976 function Is_Raised
(Id
: E
) return B
is
1978 pragma Assert
(Ekind
(Id
) = E_Exception
);
1979 return Flag224
(Id
);
1982 function Is_Remote_Call_Interface
(Id
: E
) return B
is
1985 end Is_Remote_Call_Interface
;
1987 function Is_Remote_Types
(Id
: E
) return B
is
1990 end Is_Remote_Types
;
1992 function Is_Renaming_Of_Object
(Id
: E
) return B
is
1994 return Flag112
(Id
);
1995 end Is_Renaming_Of_Object
;
1997 function Is_Return_Object
(Id
: E
) return B
is
1999 return Flag209
(Id
);
2000 end Is_Return_Object
;
2002 function Is_Shared_Passive
(Id
: E
) return B
is
2005 end Is_Shared_Passive
;
2007 function Is_Statically_Allocated
(Id
: E
) return B
is
2010 end Is_Statically_Allocated
;
2012 function Is_Synchronized_Interface
(Id
: E
) return B
is
2014 pragma Assert
(Is_Interface
(Id
));
2015 return Flag199
(Id
);
2016 end Is_Synchronized_Interface
;
2018 function Is_Tag
(Id
: E
) return B
is
2020 pragma Assert
(Nkind
(Id
) in N_Entity
);
2024 function Is_Tagged_Type
(Id
: E
) return B
is
2029 function Is_Task_Interface
(Id
: E
) return B
is
2031 pragma Assert
(Is_Interface
(Id
));
2032 return Flag200
(Id
);
2033 end Is_Task_Interface
;
2035 function Is_Thunk
(Id
: E
) return B
is
2037 pragma Assert
(Is_Subprogram
(Id
));
2038 return Flag225
(Id
);
2041 function Is_Trivial_Subprogram
(Id
: E
) return B
is
2043 return Flag235
(Id
);
2044 end Is_Trivial_Subprogram
;
2046 function Is_True_Constant
(Id
: E
) return B
is
2048 return Flag163
(Id
);
2049 end Is_True_Constant
;
2051 function Is_Unchecked_Union
(Id
: E
) return B
is
2053 return Flag117
(Implementation_Base_Type
(Id
));
2054 end Is_Unchecked_Union
;
2056 function Is_Unsigned_Type
(Id
: E
) return B
is
2058 pragma Assert
(Is_Type
(Id
));
2059 return Flag144
(Id
);
2060 end Is_Unsigned_Type
;
2062 function Is_Valued_Procedure
(Id
: E
) return B
is
2064 pragma Assert
(Ekind
(Id
) = E_Procedure
);
2065 return Flag127
(Id
);
2066 end Is_Valued_Procedure
;
2068 function Is_Visible_Child_Unit
(Id
: E
) return B
is
2070 pragma Assert
(Is_Child_Unit
(Id
));
2071 return Flag116
(Id
);
2072 end Is_Visible_Child_Unit
;
2074 function Is_Visible_Formal
(Id
: E
) return B
is
2076 return Flag206
(Id
);
2077 end Is_Visible_Formal
;
2079 function Is_VMS_Exception
(Id
: E
) return B
is
2081 return Flag133
(Id
);
2082 end Is_VMS_Exception
;
2084 function Is_Volatile
(Id
: E
) return B
is
2086 pragma Assert
(Nkind
(Id
) in N_Entity
);
2088 if Is_Type
(Id
) then
2089 return Flag16
(Base_Type
(Id
));
2095 function Itype_Printed
(Id
: E
) return B
is
2097 pragma Assert
(Is_Itype
(Id
));
2098 return Flag202
(Id
);
2101 function Kill_Elaboration_Checks
(Id
: E
) return B
is
2104 end Kill_Elaboration_Checks
;
2106 function Kill_Range_Checks
(Id
: E
) return B
is
2109 end Kill_Range_Checks
;
2111 function Kill_Tag_Checks
(Id
: E
) return B
is
2114 end Kill_Tag_Checks
;
2116 function Known_To_Have_Preelab_Init
(Id
: E
) return B
is
2118 pragma Assert
(Is_Type
(Id
));
2119 return Flag207
(Id
);
2120 end Known_To_Have_Preelab_Init
;
2122 function Last_Assignment
(Id
: E
) return N
is
2124 pragma Assert
(Is_Assignable
(Id
));
2126 end Last_Assignment
;
2128 function Last_Entity
(Id
: E
) return E
is
2133 function Limited_View
(Id
: E
) return E
is
2135 pragma Assert
(Ekind
(Id
) = E_Package
);
2139 function Lit_Indexes
(Id
: E
) return E
is
2141 pragma Assert
(Is_Enumeration_Type
(Id
));
2145 function Lit_Strings
(Id
: E
) return E
is
2147 pragma Assert
(Is_Enumeration_Type
(Id
));
2151 function Low_Bound_Known
(Id
: E
) return B
is
2153 return Flag205
(Id
);
2154 end Low_Bound_Known
;
2156 function Machine_Radix_10
(Id
: E
) return B
is
2158 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
2160 end Machine_Radix_10
;
2162 function Master_Id
(Id
: E
) return E
is
2164 pragma Assert
(Is_Access_Type
(Id
));
2168 function Materialize_Entity
(Id
: E
) return B
is
2170 return Flag168
(Id
);
2171 end Materialize_Entity
;
2173 function Mechanism
(Id
: E
) return M
is
2175 pragma Assert
(Ekind
(Id
) = E_Function
or else Is_Formal
(Id
));
2176 return UI_To_Int
(Uint8
(Id
));
2179 function Modulus
(Id
: E
) return Uint
is
2181 pragma Assert
(Is_Modular_Integer_Type
(Id
));
2182 return Uint17
(Base_Type
(Id
));
2185 function Must_Be_On_Byte_Boundary
(Id
: E
) return B
is
2187 pragma Assert
(Is_Type
(Id
));
2188 return Flag183
(Id
);
2189 end Must_Be_On_Byte_Boundary
;
2191 function Must_Have_Preelab_Init
(Id
: E
) return B
is
2193 pragma Assert
(Is_Type
(Id
));
2194 return Flag208
(Id
);
2195 end Must_Have_Preelab_Init
;
2197 function Needs_Debug_Info
(Id
: E
) return B
is
2199 return Flag147
(Id
);
2200 end Needs_Debug_Info
;
2202 function Needs_No_Actuals
(Id
: E
) return B
is
2205 (Is_Overloadable
(Id
)
2206 or else Ekind
(Id
) = E_Subprogram_Type
2207 or else Ekind
(Id
) = E_Entry_Family
);
2209 end Needs_No_Actuals
;
2211 function Never_Set_In_Source
(Id
: E
) return B
is
2213 return Flag115
(Id
);
2214 end Never_Set_In_Source
;
2216 function Next_Inlined_Subprogram
(Id
: E
) return E
is
2219 end Next_Inlined_Subprogram
;
2221 function No_Pool_Assigned
(Id
: E
) return B
is
2223 pragma Assert
(Is_Access_Type
(Id
));
2224 return Flag131
(Root_Type
(Id
));
2225 end No_Pool_Assigned
;
2227 function No_Return
(Id
: E
) return B
is
2229 return Flag113
(Id
);
2232 function No_Strict_Aliasing
(Id
: E
) return B
is
2234 pragma Assert
(Is_Access_Type
(Id
));
2235 return Flag136
(Base_Type
(Id
));
2236 end No_Strict_Aliasing
;
2238 function Non_Binary_Modulus
(Id
: E
) return B
is
2240 pragma Assert
(Is_Type
(Id
));
2241 return Flag58
(Base_Type
(Id
));
2242 end Non_Binary_Modulus
;
2244 function Non_Limited_View
(Id
: E
) return E
is
2246 pragma Assert
(Ekind
(Id
) in Incomplete_Kind
);
2248 end Non_Limited_View
;
2250 function Nonzero_Is_True
(Id
: E
) return B
is
2252 pragma Assert
(Root_Type
(Id
) = Standard_Boolean
);
2253 return Flag162
(Base_Type
(Id
));
2254 end Nonzero_Is_True
;
2256 function Normalized_First_Bit
(Id
: E
) return U
is
2259 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2261 end Normalized_First_Bit
;
2263 function Normalized_Position
(Id
: E
) return U
is
2266 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2268 end Normalized_Position
;
2270 function Normalized_Position_Max
(Id
: E
) return U
is
2273 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2275 end Normalized_Position_Max
;
2277 function OK_To_Reorder_Components
(Id
: E
) return B
is
2279 pragma Assert
(Is_Record_Type
(Id
));
2280 return Flag239
(Base_Type
(Id
));
2281 end OK_To_Reorder_Components
;
2283 function Optimize_Alignment_Space
(Id
: E
) return B
is
2287 or else Ekind
(Id
) = E_Constant
2288 or else Ekind
(Id
) = E_Variable
);
2289 return Flag241
(Id
);
2290 end Optimize_Alignment_Space
;
2292 function Optimize_Alignment_Time
(Id
: E
) return B
is
2296 or else Ekind
(Id
) = E_Constant
2297 or else Ekind
(Id
) = E_Variable
);
2298 return Flag242
(Id
);
2299 end Optimize_Alignment_Time
;
2301 function Original_Array_Type
(Id
: E
) return E
is
2303 pragma Assert
(Is_Array_Type
(Id
) or else Is_Modular_Integer_Type
(Id
));
2305 end Original_Array_Type
;
2307 function Original_Record_Component
(Id
: E
) return E
is
2310 (Ekind
(Id
) = E_Void
2311 or else Ekind
(Id
) = E_Component
2312 or else Ekind
(Id
) = E_Discriminant
);
2314 end Original_Record_Component
;
2316 function Overlays_Constant
(Id
: E
) return B
is
2318 return Flag243
(Id
);
2319 end Overlays_Constant
;
2321 function Overridden_Operation
(Id
: E
) return E
is
2324 end Overridden_Operation
;
2326 function Package_Instantiation
(Id
: E
) return N
is
2330 or else Ekind
(Id
) = E_Generic_Package
2331 or else Ekind
(Id
) = E_Package
);
2333 end Package_Instantiation
;
2335 function Packed_Array_Type
(Id
: E
) return E
is
2337 pragma Assert
(Is_Array_Type
(Id
));
2339 end Packed_Array_Type
;
2341 function Parent_Subtype
(Id
: E
) return E
is
2343 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
2347 function Primitive_Operations
(Id
: E
) return L
is
2349 pragma Assert
(Is_Tagged_Type
(Id
));
2350 return Elist15
(Id
);
2351 end Primitive_Operations
;
2353 function Prival
(Id
: E
) return E
is
2355 pragma Assert
(Is_Protected_Component
(Id
));
2359 function Prival_Link
(Id
: E
) return E
is
2361 pragma Assert
(Ekind
(Id
) = E_Constant
2362 or else Ekind
(Id
) = E_Variable
);
2366 function Private_Dependents
(Id
: E
) return L
is
2368 pragma Assert
(Is_Incomplete_Or_Private_Type
(Id
));
2369 return Elist18
(Id
);
2370 end Private_Dependents
;
2372 function Private_View
(Id
: E
) return N
is
2374 pragma Assert
(Is_Private_Type
(Id
));
2378 function Protected_Body_Subprogram
(Id
: E
) return E
is
2380 pragma Assert
(Is_Subprogram
(Id
) or else Is_Entry
(Id
));
2382 end Protected_Body_Subprogram
;
2384 function Protected_Formal
(Id
: E
) return E
is
2386 pragma Assert
(Is_Formal
(Id
));
2388 end Protected_Formal
;
2390 function Protection_Object
(Id
: E
) return E
is
2392 pragma Assert
(Ekind
(Id
) = E_Entry
2393 or else Ekind
(Id
) = E_Entry_Family
2394 or else Ekind
(Id
) = E_Function
2395 or else Ekind
(Id
) = E_Procedure
);
2397 end Protection_Object
;
2399 function Reachable
(Id
: E
) return B
is
2404 function Referenced
(Id
: E
) return B
is
2406 return Flag156
(Id
);
2409 function Referenced_As_LHS
(Id
: E
) return B
is
2412 end Referenced_As_LHS
;
2414 function Referenced_As_Out_Parameter
(Id
: E
) return B
is
2416 return Flag227
(Id
);
2417 end Referenced_As_Out_Parameter
;
2419 function Referenced_Object
(Id
: E
) return N
is
2421 pragma Assert
(Is_Type
(Id
));
2423 end Referenced_Object
;
2425 function Register_Exception_Call
(Id
: E
) return N
is
2427 pragma Assert
(Ekind
(Id
) = E_Exception
);
2429 end Register_Exception_Call
;
2431 function Related_Array_Object
(Id
: E
) return E
is
2433 pragma Assert
(Is_Array_Type
(Id
));
2435 end Related_Array_Object
;
2437 function Related_Instance
(Id
: E
) return E
is
2440 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Package_Body
);
2442 end Related_Instance
;
2444 function Related_Type
(Id
: E
) return E
is
2447 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Constant
);
2451 function Relative_Deadline_Variable
(Id
: E
) return E
is
2453 pragma Assert
(Is_Task_Type
(Id
));
2454 return Node26
(Implementation_Base_Type
(Id
));
2455 end Relative_Deadline_Variable
;
2457 function Renamed_Entity
(Id
: E
) return N
is
2462 function Renamed_In_Spec
(Id
: E
) return B
is
2464 pragma Assert
(Ekind
(Id
) = E_Package
);
2465 return Flag231
(Id
);
2466 end Renamed_In_Spec
;
2468 function Renamed_Object
(Id
: E
) return N
is
2473 function Renaming_Map
(Id
: E
) return U
is
2478 function Requires_Overriding
(Id
: E
) return B
is
2480 pragma Assert
(Is_Overloadable
(Id
));
2481 return Flag213
(Id
);
2482 end Requires_Overriding
;
2484 function Return_Present
(Id
: E
) return B
is
2489 function Return_Applies_To
(Id
: E
) return N
is
2492 end Return_Applies_To
;
2494 function Returns_By_Ref
(Id
: E
) return B
is
2499 function Reverse_Bit_Order
(Id
: E
) return B
is
2501 pragma Assert
(Is_Record_Type
(Id
));
2502 return Flag164
(Base_Type
(Id
));
2503 end Reverse_Bit_Order
;
2505 function RM_Size
(Id
: E
) return U
is
2507 pragma Assert
(Is_Type
(Id
));
2511 function Scalar_Range
(Id
: E
) return N
is
2516 function Scale_Value
(Id
: E
) return U
is
2521 function Scope_Depth_Value
(Id
: E
) return U
is
2524 end Scope_Depth_Value
;
2526 function Sec_Stack_Needed_For_Return
(Id
: E
) return B
is
2528 return Flag167
(Id
);
2529 end Sec_Stack_Needed_For_Return
;
2531 function Shadow_Entities
(Id
: E
) return S
is
2534 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
2536 end Shadow_Entities
;
2538 function Shared_Var_Procs_Instance
(Id
: E
) return E
is
2540 pragma Assert
(Ekind
(Id
) = E_Variable
);
2542 end Shared_Var_Procs_Instance
;
2544 function Size_Check_Code
(Id
: E
) return N
is
2546 pragma Assert
(Ekind
(Id
) = E_Constant
or else Ekind
(Id
) = E_Variable
);
2548 end Size_Check_Code
;
2550 function Size_Depends_On_Discriminant
(Id
: E
) return B
is
2552 return Flag177
(Id
);
2553 end Size_Depends_On_Discriminant
;
2555 function Size_Known_At_Compile_Time
(Id
: E
) return B
is
2558 end Size_Known_At_Compile_Time
;
2560 function Small_Value
(Id
: E
) return R
is
2562 pragma Assert
(Is_Fixed_Point_Type
(Id
));
2563 return Ureal21
(Id
);
2566 function Spec_Entity
(Id
: E
) return E
is
2569 (Ekind
(Id
) = E_Package_Body
or else Is_Formal
(Id
));
2573 function Spec_PPC_List
(Id
: E
) return N
is
2575 pragma Assert
(Is_Subprogram
(Id
));
2579 function Storage_Size_Variable
(Id
: E
) return E
is
2581 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
2582 return Node15
(Implementation_Base_Type
(Id
));
2583 end Storage_Size_Variable
;
2585 function Static_Elaboration_Desired
(Id
: E
) return B
is
2587 pragma Assert
(Ekind
(Id
) = E_Package
);
2589 end Static_Elaboration_Desired
;
2591 function Static_Initialization
(Id
: E
) return N
is
2594 (Ekind
(Id
) = E_Procedure
and then not Is_Dispatching_Operation
(Id
));
2596 end Static_Initialization
;
2598 function Stored_Constraint
(Id
: E
) return L
is
2601 (Is_Composite_Type
(Id
) and then not Is_Array_Type
(Id
));
2602 return Elist23
(Id
);
2603 end Stored_Constraint
;
2605 function Strict_Alignment
(Id
: E
) return B
is
2607 return Flag145
(Implementation_Base_Type
(Id
));
2608 end Strict_Alignment
;
2610 function String_Literal_Length
(Id
: E
) return U
is
2613 end String_Literal_Length
;
2615 function String_Literal_Low_Bound
(Id
: E
) return N
is
2618 end String_Literal_Low_Bound
;
2620 function Suppress_Elaboration_Warnings
(Id
: E
) return B
is
2622 return Flag148
(Id
);
2623 end Suppress_Elaboration_Warnings
;
2625 function Suppress_Init_Proc
(Id
: E
) return B
is
2627 return Flag105
(Base_Type
(Id
));
2628 end Suppress_Init_Proc
;
2630 function Suppress_Style_Checks
(Id
: E
) return B
is
2632 return Flag165
(Id
);
2633 end Suppress_Style_Checks
;
2635 function Suppress_Value_Tracking_On_Call
(Id
: E
) return B
is
2637 return Flag217
(Id
);
2638 end Suppress_Value_Tracking_On_Call
;
2640 function Task_Body_Procedure
(Id
: E
) return N
is
2642 pragma Assert
(Ekind
(Id
) in Task_Kind
);
2644 end Task_Body_Procedure
;
2646 function Treat_As_Volatile
(Id
: E
) return B
is
2649 end Treat_As_Volatile
;
2651 function Underlying_Full_View
(Id
: E
) return E
is
2653 pragma Assert
(Ekind
(Id
) in Private_Kind
);
2655 end Underlying_Full_View
;
2657 function Universal_Aliasing
(Id
: E
) return B
is
2659 pragma Assert
(Is_Type
(Id
));
2660 return Flag216
(Base_Type
(Id
));
2661 end Universal_Aliasing
;
2663 function Unset_Reference
(Id
: E
) return N
is
2666 end Unset_Reference
;
2668 function Used_As_Generic_Actual
(Id
: E
) return B
is
2670 return Flag222
(Id
);
2671 end Used_As_Generic_Actual
;
2673 function Uses_Sec_Stack
(Id
: E
) return B
is
2678 function Vax_Float
(Id
: E
) return B
is
2680 return Flag151
(Base_Type
(Id
));
2683 function Warnings_Off
(Id
: E
) return B
is
2688 function Warnings_Off_Used
(Id
: E
) return B
is
2690 return Flag236
(Id
);
2691 end Warnings_Off_Used
;
2693 function Warnings_Off_Used_Unmodified
(Id
: E
) return B
is
2695 return Flag237
(Id
);
2696 end Warnings_Off_Used_Unmodified
;
2698 function Warnings_Off_Used_Unreferenced
(Id
: E
) return B
is
2700 return Flag238
(Id
);
2701 end Warnings_Off_Used_Unreferenced
;
2703 function Wrapped_Entity
(Id
: E
) return E
is
2705 pragma Assert
(Ekind
(Id
) = E_Procedure
2706 and then Is_Primitive_Wrapper
(Id
));
2710 function Was_Hidden
(Id
: E
) return B
is
2712 return Flag196
(Id
);
2715 ------------------------------
2716 -- Classification Functions --
2717 ------------------------------
2719 function Is_Access_Type
(Id
: E
) return B
is
2721 return Ekind
(Id
) in Access_Kind
;
2724 function Is_Access_Protected_Subprogram_Type
(Id
: E
) return B
is
2726 return Ekind
(Id
) in Access_Protected_Kind
;
2727 end Is_Access_Protected_Subprogram_Type
;
2729 function Is_Access_Subprogram_Type
(Id
: E
) return B
is
2731 return Ekind
(Id
) in Access_Subprogram_Kind
;
2732 end Is_Access_Subprogram_Type
;
2734 function Is_Array_Type
(Id
: E
) return B
is
2736 return Ekind
(Id
) in Array_Kind
;
2739 function Is_Assignable
(Id
: E
) return B
is
2741 return Ekind
(Id
) in Assignable_Kind
;
2744 function Is_Class_Wide_Type
(Id
: E
) return B
is
2746 return Ekind
(Id
) in Class_Wide_Kind
;
2747 end Is_Class_Wide_Type
;
2749 function Is_Composite_Type
(Id
: E
) return B
is
2751 return Ekind
(Id
) in Composite_Kind
;
2752 end Is_Composite_Type
;
2754 function Is_Concurrent_Body
(Id
: E
) return B
is
2756 return Ekind
(Id
) in
2757 Concurrent_Body_Kind
;
2758 end Is_Concurrent_Body
;
2760 function Is_Concurrent_Record_Type
(Id
: E
) return B
is
2763 end Is_Concurrent_Record_Type
;
2765 function Is_Concurrent_Type
(Id
: E
) return B
is
2767 return Ekind
(Id
) in Concurrent_Kind
;
2768 end Is_Concurrent_Type
;
2770 function Is_Decimal_Fixed_Point_Type
(Id
: E
) return B
is
2772 return Ekind
(Id
) in
2773 Decimal_Fixed_Point_Kind
;
2774 end Is_Decimal_Fixed_Point_Type
;
2776 function Is_Digits_Type
(Id
: E
) return B
is
2778 return Ekind
(Id
) in Digits_Kind
;
2781 function Is_Discrete_Or_Fixed_Point_Type
(Id
: E
) return B
is
2783 return Ekind
(Id
) in Discrete_Or_Fixed_Point_Kind
;
2784 end Is_Discrete_Or_Fixed_Point_Type
;
2786 function Is_Discrete_Type
(Id
: E
) return B
is
2788 return Ekind
(Id
) in Discrete_Kind
;
2789 end Is_Discrete_Type
;
2791 function Is_Elementary_Type
(Id
: E
) return B
is
2793 return Ekind
(Id
) in Elementary_Kind
;
2794 end Is_Elementary_Type
;
2796 function Is_Entry
(Id
: E
) return B
is
2798 return Ekind
(Id
) in Entry_Kind
;
2801 function Is_Enumeration_Type
(Id
: E
) return B
is
2803 return Ekind
(Id
) in
2805 end Is_Enumeration_Type
;
2807 function Is_Fixed_Point_Type
(Id
: E
) return B
is
2809 return Ekind
(Id
) in
2811 end Is_Fixed_Point_Type
;
2813 function Is_Floating_Point_Type
(Id
: E
) return B
is
2815 return Ekind
(Id
) in Float_Kind
;
2816 end Is_Floating_Point_Type
;
2818 function Is_Formal
(Id
: E
) return B
is
2820 return Ekind
(Id
) in Formal_Kind
;
2823 function Is_Formal_Object
(Id
: E
) return B
is
2825 return Ekind
(Id
) in Formal_Object_Kind
;
2826 end Is_Formal_Object
;
2828 function Is_Generic_Subprogram
(Id
: E
) return B
is
2830 return Ekind
(Id
) in Generic_Subprogram_Kind
;
2831 end Is_Generic_Subprogram
;
2833 function Is_Generic_Unit
(Id
: E
) return B
is
2835 return Ekind
(Id
) in Generic_Unit_Kind
;
2836 end Is_Generic_Unit
;
2838 function Is_Incomplete_Or_Private_Type
(Id
: E
) return B
is
2840 return Ekind
(Id
) in
2841 Incomplete_Or_Private_Kind
;
2842 end Is_Incomplete_Or_Private_Type
;
2844 function Is_Incomplete_Type
(Id
: E
) return B
is
2846 return Ekind
(Id
) in
2848 end Is_Incomplete_Type
;
2850 function Is_Integer_Type
(Id
: E
) return B
is
2852 return Ekind
(Id
) in Integer_Kind
;
2853 end Is_Integer_Type
;
2855 function Is_Modular_Integer_Type
(Id
: E
) return B
is
2857 return Ekind
(Id
) in
2858 Modular_Integer_Kind
;
2859 end Is_Modular_Integer_Type
;
2861 function Is_Named_Number
(Id
: E
) return B
is
2863 return Ekind
(Id
) in Named_Kind
;
2864 end Is_Named_Number
;
2866 function Is_Numeric_Type
(Id
: E
) return B
is
2868 return Ekind
(Id
) in Numeric_Kind
;
2869 end Is_Numeric_Type
;
2871 function Is_Object
(Id
: E
) return B
is
2873 return Ekind
(Id
) in Object_Kind
;
2876 function Is_Ordinary_Fixed_Point_Type
(Id
: E
) return B
is
2878 return Ekind
(Id
) in
2879 Ordinary_Fixed_Point_Kind
;
2880 end Is_Ordinary_Fixed_Point_Type
;
2882 function Is_Overloadable
(Id
: E
) return B
is
2884 return Ekind
(Id
) in Overloadable_Kind
;
2885 end Is_Overloadable
;
2887 function Is_Private_Type
(Id
: E
) return B
is
2889 return Ekind
(Id
) in Private_Kind
;
2890 end Is_Private_Type
;
2892 function Is_Protected_Type
(Id
: E
) return B
is
2894 return Ekind
(Id
) in Protected_Kind
;
2895 end Is_Protected_Type
;
2897 function Is_Real_Type
(Id
: E
) return B
is
2899 return Ekind
(Id
) in Real_Kind
;
2902 function Is_Record_Type
(Id
: E
) return B
is
2904 return Ekind
(Id
) in Record_Kind
;
2907 function Is_Scalar_Type
(Id
: E
) return B
is
2909 return Ekind
(Id
) in Scalar_Kind
;
2912 function Is_Signed_Integer_Type
(Id
: E
) return B
is
2914 return Ekind
(Id
) in
2915 Signed_Integer_Kind
;
2916 end Is_Signed_Integer_Type
;
2918 function Is_Subprogram
(Id
: E
) return B
is
2920 return Ekind
(Id
) in Subprogram_Kind
;
2923 function Is_Task_Type
(Id
: E
) return B
is
2925 return Ekind
(Id
) in Task_Kind
;
2928 function Is_Type
(Id
: E
) return B
is
2930 return Ekind
(Id
) in Type_Kind
;
2933 ------------------------------
2934 -- Attribute Set Procedures --
2935 ------------------------------
2937 procedure Set_Accept_Address
(Id
: E
; V
: L
) is
2939 Set_Elist21
(Id
, V
);
2940 end Set_Accept_Address
;
2942 procedure Set_Access_Disp_Table
(Id
: E
; V
: L
) is
2944 pragma Assert
(Is_Tagged_Type
(Id
) and then Id
= Base_Type
(Id
));
2945 Set_Elist16
(Id
, V
);
2946 end Set_Access_Disp_Table
;
2948 procedure Set_Associated_Final_Chain
(Id
: E
; V
: E
) is
2950 pragma Assert
(Is_Access_Type
(Id
));
2952 end Set_Associated_Final_Chain
;
2954 procedure Set_Associated_Formal_Package
(Id
: E
; V
: E
) is
2957 end Set_Associated_Formal_Package
;
2959 procedure Set_Associated_Node_For_Itype
(Id
: E
; V
: E
) is
2962 end Set_Associated_Node_For_Itype
;
2964 procedure Set_Associated_Storage_Pool
(Id
: E
; V
: E
) is
2966 pragma Assert
(Is_Access_Type
(Id
) and then Id
= Base_Type
(Id
));
2968 end Set_Associated_Storage_Pool
;
2970 procedure Set_Actual_Subtype
(Id
: E
; V
: E
) is
2973 (Ekind
(Id
) = E_Constant
2974 or else Ekind
(Id
) = E_Variable
2975 or else Ekind
(Id
) = E_Generic_In_Out_Parameter
2976 or else Is_Formal
(Id
));
2978 end Set_Actual_Subtype
;
2980 procedure Set_Address_Taken
(Id
: E
; V
: B
:= True) is
2982 Set_Flag104
(Id
, V
);
2983 end Set_Address_Taken
;
2985 procedure Set_Alias
(Id
: E
; V
: E
) is
2988 (Is_Overloadable
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
2992 procedure Set_Alignment
(Id
: E
; V
: U
) is
2994 pragma Assert
(Is_Type
(Id
)
2995 or else Is_Formal
(Id
)
2996 or else Ekind
(Id
) = E_Loop_Parameter
2997 or else Ekind
(Id
) = E_Constant
2998 or else Ekind
(Id
) = E_Exception
2999 or else Ekind
(Id
) = E_Variable
);
3003 procedure Set_Barrier_Function
(Id
: E
; V
: N
) is
3005 pragma Assert
(Is_Entry
(Id
));
3007 end Set_Barrier_Function
;
3009 procedure Set_Block_Node
(Id
: E
; V
: N
) is
3011 pragma Assert
(Ekind
(Id
) = E_Block
);
3015 procedure Set_Body_Entity
(Id
: E
; V
: E
) is
3018 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
3020 end Set_Body_Entity
;
3022 procedure Set_Body_Needed_For_SAL
(Id
: E
; V
: B
:= True) is
3025 (Ekind
(Id
) = E_Package
3026 or else Is_Subprogram
(Id
)
3027 or else Is_Generic_Unit
(Id
));
3029 end Set_Body_Needed_For_SAL
;
3031 procedure Set_C_Pass_By_Copy
(Id
: E
; V
: B
:= True) is
3033 pragma Assert
(Is_Record_Type
(Id
) and then Id
= Base_Type
(Id
));
3034 Set_Flag125
(Id
, V
);
3035 end Set_C_Pass_By_Copy
;
3037 procedure Set_Can_Never_Be_Null
(Id
: E
; V
: B
:= True) is
3040 end Set_Can_Never_Be_Null
;
3042 procedure Set_Checks_May_Be_Suppressed
(Id
: E
; V
: B
:= True) is
3045 end Set_Checks_May_Be_Suppressed
;
3047 procedure Set_Class_Wide_Type
(Id
: E
; V
: E
) is
3049 pragma Assert
(Is_Type
(Id
));
3051 end Set_Class_Wide_Type
;
3053 procedure Set_Cloned_Subtype
(Id
: E
; V
: E
) is
3056 (Ekind
(Id
) = E_Record_Subtype
3057 or else Ekind
(Id
) = E_Class_Wide_Subtype
);
3059 end Set_Cloned_Subtype
;
3061 procedure Set_Component_Bit_Offset
(Id
: E
; V
: U
) is
3064 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
3066 end Set_Component_Bit_Offset
;
3068 procedure Set_Component_Clause
(Id
: E
; V
: N
) is
3071 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
3073 end Set_Component_Clause
;
3075 procedure Set_Component_Size
(Id
: E
; V
: U
) is
3077 pragma Assert
(Is_Array_Type
(Id
) and then Id
= Base_Type
(Id
));
3079 end Set_Component_Size
;
3081 procedure Set_Component_Type
(Id
: E
; V
: E
) is
3083 pragma Assert
(Is_Array_Type
(Id
) and then Id
= Base_Type
(Id
));
3085 end Set_Component_Type
;
3087 procedure Set_Corresponding_Concurrent_Type
(Id
: E
; V
: E
) is
3090 (Ekind
(Id
) = E_Record_Type
and then Is_Concurrent_Type
(V
));
3092 end Set_Corresponding_Concurrent_Type
;
3094 procedure Set_Corresponding_Discriminant
(Id
: E
; V
: E
) is
3096 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
3098 end Set_Corresponding_Discriminant
;
3100 procedure Set_Corresponding_Equality
(Id
: E
; V
: E
) is
3103 (Ekind
(Id
) = E_Function
3104 and then not Comes_From_Source
(Id
)
3105 and then Chars
(Id
) = Name_Op_Ne
);
3107 end Set_Corresponding_Equality
;
3109 procedure Set_Corresponding_Record_Type
(Id
: E
; V
: E
) is
3111 pragma Assert
(Is_Concurrent_Type
(Id
));
3113 end Set_Corresponding_Record_Type
;
3115 procedure Set_Corresponding_Remote_Type
(Id
: E
; V
: E
) is
3118 end Set_Corresponding_Remote_Type
;
3120 procedure Set_Current_Use_Clause
(Id
: E
; V
: E
) is
3122 pragma Assert
(Ekind
(Id
) = E_Package
or else Is_Type
(Id
));
3124 end Set_Current_Use_Clause
;
3126 procedure Set_Current_Value
(Id
: E
; V
: N
) is
3128 pragma Assert
(Ekind
(Id
) in Object_Kind
or else Ekind
(Id
) = E_Void
);
3130 end Set_Current_Value
;
3132 procedure Set_CR_Discriminant
(Id
: E
; V
: E
) is
3135 end Set_CR_Discriminant
;
3137 procedure Set_Debug_Info_Off
(Id
: E
; V
: B
:= True) is
3139 Set_Flag166
(Id
, V
);
3140 end Set_Debug_Info_Off
;
3142 procedure Set_Debug_Renaming_Link
(Id
: E
; V
: E
) is
3145 end Set_Debug_Renaming_Link
;
3147 procedure Set_Default_Expr_Function
(Id
: E
; V
: E
) is
3149 pragma Assert
(Is_Formal
(Id
));
3151 end Set_Default_Expr_Function
;
3153 procedure Set_Default_Expressions_Processed
(Id
: E
; V
: B
:= True) is
3155 Set_Flag108
(Id
, V
);
3156 end Set_Default_Expressions_Processed
;
3158 procedure Set_Default_Value
(Id
: E
; V
: N
) is
3160 pragma Assert
(Is_Formal
(Id
));
3162 end Set_Default_Value
;
3164 procedure Set_Delay_Cleanups
(Id
: E
; V
: B
:= True) is
3168 or else Is_Task_Type
(Id
)
3169 or else Ekind
(Id
) = E_Block
);
3170 Set_Flag114
(Id
, V
);
3171 end Set_Delay_Cleanups
;
3173 procedure Set_Delay_Subprogram_Descriptors
(Id
: E
; V
: B
:= True) is
3177 or else Ekind
(Id
) = E_Package
3178 or else Ekind
(Id
) = E_Package_Body
);
3180 end Set_Delay_Subprogram_Descriptors
;
3182 procedure Set_Delta_Value
(Id
: E
; V
: R
) is
3184 pragma Assert
(Is_Fixed_Point_Type
(Id
));
3185 Set_Ureal18
(Id
, V
);
3186 end Set_Delta_Value
;
3188 procedure Set_Dependent_Instances
(Id
: E
; V
: L
) is
3190 pragma Assert
(Is_Generic_Instance
(Id
));
3192 end Set_Dependent_Instances
;
3194 procedure Set_Depends_On_Private
(Id
: E
; V
: B
:= True) is
3196 pragma Assert
(Nkind
(Id
) in N_Entity
);
3198 end Set_Depends_On_Private
;
3200 procedure Set_Digits_Value
(Id
: E
; V
: U
) is
3203 (Is_Floating_Point_Type
(Id
)
3204 or else Is_Decimal_Fixed_Point_Type
(Id
));
3206 end Set_Digits_Value
;
3208 procedure Set_Directly_Designated_Type
(Id
: E
; V
: E
) is
3211 end Set_Directly_Designated_Type
;
3213 procedure Set_Discard_Names
(Id
: E
; V
: B
:= True) is
3216 end Set_Discard_Names
;
3218 procedure Set_Discriminal
(Id
: E
; V
: E
) is
3220 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
3222 end Set_Discriminal
;
3224 procedure Set_Discriminal_Link
(Id
: E
; V
: E
) is
3227 end Set_Discriminal_Link
;
3229 procedure Set_Discriminant_Checking_Func
(Id
: E
; V
: E
) is
3231 pragma Assert
(Ekind
(Id
) = E_Component
);
3233 end Set_Discriminant_Checking_Func
;
3235 procedure Set_Discriminant_Constraint
(Id
: E
; V
: L
) is
3237 pragma Assert
(Nkind
(Id
) in N_Entity
);
3238 Set_Elist21
(Id
, V
);
3239 end Set_Discriminant_Constraint
;
3241 procedure Set_Discriminant_Default_Value
(Id
: E
; V
: N
) is
3244 end Set_Discriminant_Default_Value
;
3246 procedure Set_Discriminant_Number
(Id
: E
; V
: U
) is
3249 end Set_Discriminant_Number
;
3251 procedure Set_Dispatch_Table_Wrapper
(Id
: E
; V
: E
) is
3253 pragma Assert
(Is_Tagged_Type
(Id
) and then Id
= Base_Type
(Id
));
3255 end Set_Dispatch_Table_Wrapper
;
3257 procedure Set_DT_Entry_Count
(Id
: E
; V
: U
) is
3259 pragma Assert
(Ekind
(Id
) = E_Component
);
3261 end Set_DT_Entry_Count
;
3263 procedure Set_DT_Offset_To_Top_Func
(Id
: E
; V
: E
) is
3265 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
3267 end Set_DT_Offset_To_Top_Func
;
3269 procedure Set_DT_Position
(Id
: E
; V
: U
) is
3271 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
3273 end Set_DT_Position
;
3275 procedure Set_DTC_Entity
(Id
: E
; V
: E
) is
3278 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
3282 procedure Set_Elaborate_Body_Desirable
(Id
: E
; V
: B
:= True) is
3284 pragma Assert
(Ekind
(Id
) = E_Package
);
3285 Set_Flag210
(Id
, V
);
3286 end Set_Elaborate_Body_Desirable
;
3288 procedure Set_Elaboration_Entity
(Id
: E
; V
: E
) is
3293 Ekind
(Id
) = E_Package
3295 Is_Generic_Unit
(Id
));
3297 end Set_Elaboration_Entity
;
3299 procedure Set_Elaboration_Entity_Required
(Id
: E
; V
: B
:= True) is
3304 Ekind
(Id
) = E_Package
3306 Is_Generic_Unit
(Id
));
3307 Set_Flag174
(Id
, V
);
3308 end Set_Elaboration_Entity_Required
;
3310 procedure Set_Enclosing_Scope
(Id
: E
; V
: E
) is
3313 end Set_Enclosing_Scope
;
3315 procedure Set_Entry_Accepted
(Id
: E
; V
: B
:= True) is
3317 pragma Assert
(Is_Entry
(Id
));
3318 Set_Flag152
(Id
, V
);
3319 end Set_Entry_Accepted
;
3321 procedure Set_Entry_Bodies_Array
(Id
: E
; V
: E
) is
3324 end Set_Entry_Bodies_Array
;
3326 procedure Set_Entry_Cancel_Parameter
(Id
: E
; V
: E
) is
3329 end Set_Entry_Cancel_Parameter
;
3331 procedure Set_Entry_Component
(Id
: E
; V
: E
) is
3334 end Set_Entry_Component
;
3336 procedure Set_Entry_Formal
(Id
: E
; V
: E
) is
3339 end Set_Entry_Formal
;
3341 procedure Set_Entry_Index_Constant
(Id
: E
; V
: E
) is
3343 pragma Assert
(Ekind
(Id
) = E_Entry_Index_Parameter
);
3345 end Set_Entry_Index_Constant
;
3347 procedure Set_Entry_Parameters_Type
(Id
: E
; V
: E
) is
3350 end Set_Entry_Parameters_Type
;
3352 procedure Set_Enum_Pos_To_Rep
(Id
: E
; V
: E
) is
3354 pragma Assert
(Ekind
(Id
) = E_Enumeration_Type
);
3356 end Set_Enum_Pos_To_Rep
;
3358 procedure Set_Enumeration_Pos
(Id
: E
; V
: U
) is
3360 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3362 end Set_Enumeration_Pos
;
3364 procedure Set_Enumeration_Rep
(Id
: E
; V
: U
) is
3366 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3368 end Set_Enumeration_Rep
;
3370 procedure Set_Enumeration_Rep_Expr
(Id
: E
; V
: N
) is
3372 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3374 end Set_Enumeration_Rep_Expr
;
3376 procedure Set_Equivalent_Type
(Id
: E
; V
: E
) is
3379 (Ekind
(Id
) = E_Class_Wide_Type
or else
3380 Ekind
(Id
) = E_Class_Wide_Subtype
or else
3381 Ekind
(Id
) = E_Access_Protected_Subprogram_Type
or else
3382 Ekind
(Id
) = E_Anonymous_Access_Protected_Subprogram_Type
or else
3383 Ekind
(Id
) = E_Access_Subprogram_Type
or else
3384 Ekind
(Id
) = E_Exception_Type
);
3386 end Set_Equivalent_Type
;
3388 procedure Set_Esize
(Id
: E
; V
: U
) is
3393 procedure Set_Exception_Code
(Id
: E
; V
: U
) is
3395 pragma Assert
(Ekind
(Id
) = E_Exception
);
3397 end Set_Exception_Code
;
3399 procedure Set_Extra_Accessibility
(Id
: E
; V
: E
) is
3401 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
3403 end Set_Extra_Accessibility
;
3405 procedure Set_Extra_Constrained
(Id
: E
; V
: E
) is
3407 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
3409 end Set_Extra_Constrained
;
3411 procedure Set_Extra_Formal
(Id
: E
; V
: E
) is
3414 end Set_Extra_Formal
;
3416 procedure Set_Extra_Formals
(Id
: E
; V
: E
) is
3419 (Is_Overloadable
(Id
)
3420 or else Ekind
(Id
) = E_Entry_Family
3421 or else Ekind
(Id
) = E_Subprogram_Body
3422 or else Ekind
(Id
) = E_Subprogram_Type
);
3424 end Set_Extra_Formals
;
3426 procedure Set_Can_Use_Internal_Rep
(Id
: E
; V
: B
:= True) is
3429 (Is_Access_Subprogram_Type
(Id
)
3430 and then Id
= Base_Type
(Id
));
3431 Set_Flag229
(Id
, V
);
3432 end Set_Can_Use_Internal_Rep
;
3434 procedure Set_Finalization_Chain_Entity
(Id
: E
; V
: E
) is
3437 end Set_Finalization_Chain_Entity
;
3439 procedure Set_Finalize_Storage_Only
(Id
: E
; V
: B
:= True) is
3441 pragma Assert
(Is_Type
(Id
) and then Id
= Base_Type
(Id
));
3442 Set_Flag158
(Id
, V
);
3443 end Set_Finalize_Storage_Only
;
3445 procedure Set_First_Entity
(Id
: E
; V
: E
) is
3448 end Set_First_Entity
;
3450 procedure Set_First_Index
(Id
: E
; V
: N
) is
3452 pragma Assert
(Is_Array_Type
(Id
) or else Is_String_Type
(Id
));
3454 end Set_First_Index
;
3456 procedure Set_First_Literal
(Id
: E
; V
: E
) is
3458 pragma Assert
(Is_Enumeration_Type
(Id
));
3460 end Set_First_Literal
;
3462 procedure Set_First_Optional_Parameter
(Id
: E
; V
: E
) is
3465 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
3467 end Set_First_Optional_Parameter
;
3469 procedure Set_First_Private_Entity
(Id
: E
; V
: E
) is
3471 pragma Assert
(Ekind
(Id
) = E_Package
3472 or else Ekind
(Id
) = E_Generic_Package
3473 or else Ekind
(Id
) in Concurrent_Kind
);
3475 end Set_First_Private_Entity
;
3477 procedure Set_First_Rep_Item
(Id
: E
; V
: N
) is
3480 end Set_First_Rep_Item
;
3482 procedure Set_Freeze_Node
(Id
: E
; V
: N
) is
3485 end Set_Freeze_Node
;
3487 procedure Set_From_With_Type
(Id
: E
; V
: B
:= True) is
3491 or else Ekind
(Id
) = E_Package
);
3492 Set_Flag159
(Id
, V
);
3493 end Set_From_With_Type
;
3495 procedure Set_Full_View
(Id
: E
; V
: E
) is
3497 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Constant
);
3501 procedure Set_Generic_Homonym
(Id
: E
; V
: E
) is
3504 end Set_Generic_Homonym
;
3506 procedure Set_Generic_Renamings
(Id
: E
; V
: L
) is
3508 Set_Elist23
(Id
, V
);
3509 end Set_Generic_Renamings
;
3511 procedure Set_Handler_Records
(Id
: E
; V
: S
) is
3514 end Set_Handler_Records
;
3516 procedure Set_Has_Aliased_Components
(Id
: E
; V
: B
:= True) is
3518 pragma Assert
(Id
= Base_Type
(Id
));
3519 Set_Flag135
(Id
, V
);
3520 end Set_Has_Aliased_Components
;
3522 procedure Set_Has_Alignment_Clause
(Id
: E
; V
: B
:= True) is
3525 end Set_Has_Alignment_Clause
;
3527 procedure Set_Has_All_Calls_Remote
(Id
: E
; V
: B
:= True) is
3530 end Set_Has_All_Calls_Remote
;
3532 procedure Set_Has_Anon_Block_Suffix
(Id
: E
; V
: B
:= True) is
3534 Set_Flag201
(Id
, V
);
3535 end Set_Has_Anon_Block_Suffix
;
3537 procedure Set_Has_Atomic_Components
(Id
: E
; V
: B
:= True) is
3539 pragma Assert
(not Is_Type
(Id
) or else Id
= Base_Type
(Id
));
3541 end Set_Has_Atomic_Components
;
3543 procedure Set_Has_Biased_Representation
(Id
: E
; V
: B
:= True) is
3546 ((V
= False) or else (Is_Discrete_Type
(Id
) or else Is_Object
(Id
)));
3547 Set_Flag139
(Id
, V
);
3548 end Set_Has_Biased_Representation
;
3550 procedure Set_Has_Completion
(Id
: E
; V
: B
:= True) is
3553 end Set_Has_Completion
;
3555 procedure Set_Has_Completion_In_Body
(Id
: E
; V
: B
:= True) is
3557 pragma Assert
(Is_Type
(Id
));
3559 end Set_Has_Completion_In_Body
;
3561 procedure Set_Has_Complex_Representation
(Id
: E
; V
: B
:= True) is
3563 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
3564 Set_Flag140
(Id
, V
);
3565 end Set_Has_Complex_Representation
;
3567 procedure Set_Has_Component_Size_Clause
(Id
: E
; V
: B
:= True) is
3569 pragma Assert
(Ekind
(Id
) = E_Array_Type
);
3571 end Set_Has_Component_Size_Clause
;
3573 procedure Set_Has_Constrained_Partial_View
(Id
: E
; V
: B
:= True) is
3575 pragma Assert
(Is_Type
(Id
));
3576 Set_Flag187
(Id
, V
);
3577 end Set_Has_Constrained_Partial_View
;
3579 procedure Set_Has_Contiguous_Rep
(Id
: E
; V
: B
:= True) is
3581 Set_Flag181
(Id
, V
);
3582 end Set_Has_Contiguous_Rep
;
3584 procedure Set_Has_Controlled_Component
(Id
: E
; V
: B
:= True) is
3586 pragma Assert
(Id
= Base_Type
(Id
));
3588 end Set_Has_Controlled_Component
;
3590 procedure Set_Has_Controlling_Result
(Id
: E
; V
: B
:= True) is
3593 end Set_Has_Controlling_Result
;
3595 procedure Set_Has_Convention_Pragma
(Id
: E
; V
: B
:= True) is
3597 Set_Flag119
(Id
, V
);
3598 end Set_Has_Convention_Pragma
;
3600 procedure Set_Has_Delayed_Freeze
(Id
: E
; V
: B
:= True) is
3602 pragma Assert
(Nkind
(Id
) in N_Entity
);
3604 end Set_Has_Delayed_Freeze
;
3606 procedure Set_Has_Discriminants
(Id
: E
; V
: B
:= True) is
3608 pragma Assert
(Nkind
(Id
) in N_Entity
);
3610 end Set_Has_Discriminants
;
3612 procedure Set_Has_Dispatch_Table
(Id
: E
; V
: B
:= True) is
3614 pragma Assert
(Ekind
(Id
) = E_Record_Type
3615 and then Is_Tagged_Type
(Id
));
3616 Set_Flag220
(Id
, V
);
3617 end Set_Has_Dispatch_Table
;
3619 procedure Set_Has_Enumeration_Rep_Clause
(Id
: E
; V
: B
:= True) is
3621 pragma Assert
(Is_Enumeration_Type
(Id
));
3623 end Set_Has_Enumeration_Rep_Clause
;
3625 procedure Set_Has_Exit
(Id
: E
; V
: B
:= True) is
3630 procedure Set_Has_External_Tag_Rep_Clause
(Id
: E
; V
: B
:= True) is
3632 pragma Assert
(Is_Tagged_Type
(Id
));
3633 Set_Flag110
(Id
, V
);
3634 end Set_Has_External_Tag_Rep_Clause
;
3636 procedure Set_Has_Forward_Instantiation
(Id
: E
; V
: B
:= True) is
3638 Set_Flag175
(Id
, V
);
3639 end Set_Has_Forward_Instantiation
;
3641 procedure Set_Has_Fully_Qualified_Name
(Id
: E
; V
: B
:= True) is
3643 Set_Flag173
(Id
, V
);
3644 end Set_Has_Fully_Qualified_Name
;
3646 procedure Set_Has_Gigi_Rep_Item
(Id
: E
; V
: B
:= True) is
3649 end Set_Has_Gigi_Rep_Item
;
3651 procedure Set_Has_Homonym
(Id
: E
; V
: B
:= True) is
3654 end Set_Has_Homonym
;
3656 procedure Set_Has_Initial_Value
(Id
: E
; V
: B
:= True) is
3659 (Ekind
(Id
) = E_Variable
or else Ekind
(Id
) = E_Out_Parameter
);
3660 Set_Flag219
(Id
, V
);
3661 end Set_Has_Initial_Value
;
3663 procedure Set_Has_Machine_Radix_Clause
(Id
: E
; V
: B
:= True) is
3665 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
3667 end Set_Has_Machine_Radix_Clause
;
3669 procedure Set_Has_Master_Entity
(Id
: E
; V
: B
:= True) is
3672 end Set_Has_Master_Entity
;
3674 procedure Set_Has_Missing_Return
(Id
: E
; V
: B
:= True) is
3677 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Generic_Function
);
3678 Set_Flag142
(Id
, V
);
3679 end Set_Has_Missing_Return
;
3681 procedure Set_Has_Nested_Block_With_Handler
(Id
: E
; V
: B
:= True) is
3683 Set_Flag101
(Id
, V
);
3684 end Set_Has_Nested_Block_With_Handler
;
3686 procedure Set_Has_Up_Level_Access
(Id
: E
; V
: B
:= True) is
3689 (Ekind
(Id
) = E_Variable
3690 or else Ekind
(Id
) = E_Constant
3691 or else Ekind
(Id
) = E_Loop_Parameter
);
3692 Set_Flag215
(Id
, V
);
3693 end Set_Has_Up_Level_Access
;
3695 procedure Set_Has_Non_Standard_Rep
(Id
: E
; V
: B
:= True) is
3697 pragma Assert
(Id
= Base_Type
(Id
));
3699 end Set_Has_Non_Standard_Rep
;
3701 procedure Set_Has_Object_Size_Clause
(Id
: E
; V
: B
:= True) is
3703 pragma Assert
(Is_Type
(Id
));
3704 Set_Flag172
(Id
, V
);
3705 end Set_Has_Object_Size_Clause
;
3707 procedure Set_Has_Per_Object_Constraint
(Id
: E
; V
: B
:= True) is
3709 Set_Flag154
(Id
, V
);
3710 end Set_Has_Per_Object_Constraint
;
3712 procedure Set_Has_Persistent_BSS
(Id
: E
; V
: B
:= True) is
3714 Set_Flag188
(Id
, V
);
3715 end Set_Has_Persistent_BSS
;
3717 procedure Set_Has_Postconditions
(Id
: E
; V
: B
:= True) is
3719 pragma Assert
(Is_Subprogram
(Id
));
3720 Set_Flag240
(Id
, V
);
3721 end Set_Has_Postconditions
;
3723 procedure Set_Has_Pragma_Controlled
(Id
: E
; V
: B
:= True) is
3725 pragma Assert
(Is_Access_Type
(Id
));
3726 Set_Flag27
(Base_Type
(Id
), V
);
3727 end Set_Has_Pragma_Controlled
;
3729 procedure Set_Has_Pragma_Elaborate_Body
(Id
: E
; V
: B
:= True) is
3731 Set_Flag150
(Id
, V
);
3732 end Set_Has_Pragma_Elaborate_Body
;
3734 procedure Set_Has_Pragma_Inline
(Id
: E
; V
: B
:= True) is
3736 Set_Flag157
(Id
, V
);
3737 end Set_Has_Pragma_Inline
;
3739 procedure Set_Has_Pragma_Inline_Always
(Id
: E
; V
: B
:= True) is
3741 Set_Flag230
(Id
, V
);
3742 end Set_Has_Pragma_Inline_Always
;
3744 procedure Set_Has_Pragma_Pack
(Id
: E
; V
: B
:= True) is
3746 pragma Assert
(Is_Array_Type
(Id
) or else Is_Record_Type
(Id
));
3747 pragma Assert
(Id
= Base_Type
(Id
));
3748 Set_Flag121
(Id
, V
);
3749 end Set_Has_Pragma_Pack
;
3751 procedure Set_Has_Pragma_Preelab_Init
(Id
: E
; V
: B
:= True) is
3753 Set_Flag221
(Id
, V
);
3754 end Set_Has_Pragma_Preelab_Init
;
3756 procedure Set_Has_Pragma_Pure
(Id
: E
; V
: B
:= True) is
3758 Set_Flag203
(Id
, V
);
3759 end Set_Has_Pragma_Pure
;
3761 procedure Set_Has_Pragma_Pure_Function
(Id
: E
; V
: B
:= True) is
3763 Set_Flag179
(Id
, V
);
3764 end Set_Has_Pragma_Pure_Function
;
3766 procedure Set_Has_Pragma_Unmodified
(Id
: E
; V
: B
:= True) is
3768 Set_Flag233
(Id
, V
);
3769 end Set_Has_Pragma_Unmodified
;
3771 procedure Set_Has_Pragma_Unreferenced
(Id
: E
; V
: B
:= True) is
3773 Set_Flag180
(Id
, V
);
3774 end Set_Has_Pragma_Unreferenced
;
3776 procedure Set_Has_Pragma_Unreferenced_Objects
(Id
: E
; V
: B
:= True) is
3778 pragma Assert
(Is_Type
(Id
));
3779 Set_Flag212
(Id
, V
);
3780 end Set_Has_Pragma_Unreferenced_Objects
;
3782 procedure Set_Has_Primitive_Operations
(Id
: E
; V
: B
:= True) is
3784 pragma Assert
(Id
= Base_Type
(Id
));
3785 Set_Flag120
(Id
, V
);
3786 end Set_Has_Primitive_Operations
;
3788 procedure Set_Has_Private_Declaration
(Id
: E
; V
: B
:= True) is
3790 Set_Flag155
(Id
, V
);
3791 end Set_Has_Private_Declaration
;
3793 procedure Set_Has_Qualified_Name
(Id
: E
; V
: B
:= True) is
3795 Set_Flag161
(Id
, V
);
3796 end Set_Has_Qualified_Name
;
3798 procedure Set_Has_RACW
(Id
: E
; V
: B
:= True) is
3800 pragma Assert
(Ekind
(Id
) = E_Package
);
3801 Set_Flag214
(Id
, V
);
3804 procedure Set_Has_Record_Rep_Clause
(Id
: E
; V
: B
:= True) is
3806 pragma Assert
(Id
= Base_Type
(Id
));
3808 end Set_Has_Record_Rep_Clause
;
3810 procedure Set_Has_Recursive_Call
(Id
: E
; V
: B
:= True) is
3812 pragma Assert
(Is_Subprogram
(Id
));
3813 Set_Flag143
(Id
, V
);
3814 end Set_Has_Recursive_Call
;
3816 procedure Set_Has_Size_Clause
(Id
: E
; V
: B
:= True) is
3819 end Set_Has_Size_Clause
;
3821 procedure Set_Has_Small_Clause
(Id
: E
; V
: B
:= True) is
3824 end Set_Has_Small_Clause
;
3826 procedure Set_Has_Specified_Layout
(Id
: E
; V
: B
:= True) is
3828 pragma Assert
(Id
= Base_Type
(Id
));
3829 Set_Flag100
(Id
, V
);
3830 end Set_Has_Specified_Layout
;
3832 procedure Set_Has_Specified_Stream_Input
(Id
: E
; V
: B
:= True) is
3834 pragma Assert
(Is_Type
(Id
));
3835 Set_Flag190
(Id
, V
);
3836 end Set_Has_Specified_Stream_Input
;
3838 procedure Set_Has_Specified_Stream_Output
(Id
: E
; V
: B
:= True) is
3840 pragma Assert
(Is_Type
(Id
));
3841 Set_Flag191
(Id
, V
);
3842 end Set_Has_Specified_Stream_Output
;
3844 procedure Set_Has_Specified_Stream_Read
(Id
: E
; V
: B
:= True) is
3846 pragma Assert
(Is_Type
(Id
));
3847 Set_Flag192
(Id
, V
);
3848 end Set_Has_Specified_Stream_Read
;
3850 procedure Set_Has_Specified_Stream_Write
(Id
: E
; V
: B
:= True) is
3852 pragma Assert
(Is_Type
(Id
));
3853 Set_Flag193
(Id
, V
);
3854 end Set_Has_Specified_Stream_Write
;
3856 procedure Set_Has_Static_Discriminants
(Id
: E
; V
: B
:= True) is
3858 Set_Flag211
(Id
, V
);
3859 end Set_Has_Static_Discriminants
;
3861 procedure Set_Has_Storage_Size_Clause
(Id
: E
; V
: B
:= True) is
3863 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
3864 pragma Assert
(Id
= Base_Type
(Id
));
3866 end Set_Has_Storage_Size_Clause
;
3868 procedure Set_Has_Stream_Size_Clause
(Id
: E
; V
: B
:= True) is
3870 pragma Assert
(Is_Elementary_Type
(Id
));
3871 Set_Flag184
(Id
, V
);
3872 end Set_Has_Stream_Size_Clause
;
3874 procedure Set_Has_Subprogram_Descriptor
(Id
: E
; V
: B
:= True) is
3877 end Set_Has_Subprogram_Descriptor
;
3879 procedure Set_Has_Task
(Id
: E
; V
: B
:= True) is
3881 pragma Assert
(Id
= Base_Type
(Id
));
3885 procedure Set_Has_Thunks
(Id
: E
; V
: B
:= True) is
3887 pragma Assert
(Is_Tag
(Id
)
3888 and then Ekind
(Id
) = E_Constant
);
3889 Set_Flag228
(Id
, V
);
3892 procedure Set_Has_Unchecked_Union
(Id
: E
; V
: B
:= True) is
3894 pragma Assert
(Id
= Base_Type
(Id
));
3895 Set_Flag123
(Id
, V
);
3896 end Set_Has_Unchecked_Union
;
3898 procedure Set_Has_Unknown_Discriminants
(Id
: E
; V
: B
:= True) is
3900 pragma Assert
(Is_Type
(Id
));
3902 end Set_Has_Unknown_Discriminants
;
3904 procedure Set_Has_Volatile_Components
(Id
: E
; V
: B
:= True) is
3906 pragma Assert
(not Is_Type
(Id
) or else Id
= Base_Type
(Id
));
3908 end Set_Has_Volatile_Components
;
3910 procedure Set_Has_Xref_Entry
(Id
: E
; V
: B
:= True) is
3912 Set_Flag182
(Id
, V
);
3913 end Set_Has_Xref_Entry
;
3915 procedure Set_Hiding_Loop_Variable
(Id
: E
; V
: E
) is
3917 pragma Assert
(Ekind
(Id
) = E_Variable
);
3919 end Set_Hiding_Loop_Variable
;
3921 procedure Set_Homonym
(Id
: E
; V
: E
) is
3923 pragma Assert
(Id
/= V
);
3927 procedure Set_Implemented_By_Entry
(Id
: E
; V
: B
:= True) is
3930 (Ekind
(Id
) = E_Function
3931 or else Ekind
(Id
) = E_Procedure
);
3932 Set_Flag232
(Id
, V
);
3933 end Set_Implemented_By_Entry
;
3935 procedure Set_Interfaces
(Id
: E
; V
: L
) is
3937 pragma Assert
(Is_Record_Type
(Id
));
3938 Set_Elist25
(Id
, V
);
3941 procedure Set_Interface_Alias
(Id
: E
; V
: E
) is
3945 and then Is_Hidden
(Id
)
3946 and then (Ekind
(Id
) = E_Procedure
3947 or else Ekind
(Id
) = E_Function
));
3949 end Set_Interface_Alias
;
3951 procedure Set_In_Package_Body
(Id
: E
; V
: B
:= True) is
3954 end Set_In_Package_Body
;
3956 procedure Set_In_Private_Part
(Id
: E
; V
: B
:= True) is
3959 end Set_In_Private_Part
;
3961 procedure Set_In_Use
(Id
: E
; V
: B
:= True) is
3963 pragma Assert
(Nkind
(Id
) in N_Entity
);
3967 procedure Set_Inner_Instances
(Id
: E
; V
: L
) is
3969 Set_Elist23
(Id
, V
);
3970 end Set_Inner_Instances
;
3972 procedure Set_Interface_Name
(Id
: E
; V
: N
) is
3975 end Set_Interface_Name
;
3977 procedure Set_Is_Abstract_Subprogram
(Id
: E
; V
: B
:= True) is
3979 pragma Assert
(Is_Overloadable
(Id
));
3981 end Set_Is_Abstract_Subprogram
;
3983 procedure Set_Is_Abstract_Type
(Id
: E
; V
: B
:= True) is
3985 pragma Assert
(Is_Type
(Id
));
3986 Set_Flag146
(Id
, V
);
3987 end Set_Is_Abstract_Type
;
3989 procedure Set_Is_Local_Anonymous_Access
(Id
: E
; V
: B
:= True) is
3991 pragma Assert
(Is_Access_Type
(Id
));
3992 Set_Flag194
(Id
, V
);
3993 end Set_Is_Local_Anonymous_Access
;
3995 procedure Set_Is_Access_Constant
(Id
: E
; V
: B
:= True) is
3997 pragma Assert
(Is_Access_Type
(Id
));
3999 end Set_Is_Access_Constant
;
4001 procedure Set_Is_Ada_2005_Only
(Id
: E
; V
: B
:= True) is
4003 Set_Flag185
(Id
, V
);
4004 end Set_Is_Ada_2005_Only
;
4006 procedure Set_Is_Aliased
(Id
: E
; V
: B
:= True) is
4008 pragma Assert
(Nkind
(Id
) in N_Entity
);
4012 procedure Set_Is_AST_Entry
(Id
: E
; V
: B
:= True) is
4014 pragma Assert
(Is_Entry
(Id
));
4015 Set_Flag132
(Id
, V
);
4016 end Set_Is_AST_Entry
;
4018 procedure Set_Is_Asynchronous
(Id
: E
; V
: B
:= True) is
4021 (Ekind
(Id
) = E_Procedure
or else Is_Type
(Id
));
4023 end Set_Is_Asynchronous
;
4025 procedure Set_Is_Atomic
(Id
: E
; V
: B
:= True) is
4030 procedure Set_Is_Bit_Packed_Array
(Id
: E
; V
: B
:= True) is
4032 pragma Assert
((not V
)
4033 or else (Is_Array_Type
(Id
) and then Id
= Base_Type
(Id
)));
4035 Set_Flag122
(Id
, V
);
4036 end Set_Is_Bit_Packed_Array
;
4038 procedure Set_Is_Called
(Id
: E
; V
: B
:= True) is
4041 (Ekind
(Id
) = E_Procedure
or else Ekind
(Id
) = E_Function
);
4042 Set_Flag102
(Id
, V
);
4045 procedure Set_Is_Character_Type
(Id
: E
; V
: B
:= True) is
4048 end Set_Is_Character_Type
;
4050 procedure Set_Is_Child_Unit
(Id
: E
; V
: B
:= True) is
4053 end Set_Is_Child_Unit
;
4055 procedure Set_Is_Class_Wide_Equivalent_Type
(Id
: E
; V
: B
:= True) is
4058 end Set_Is_Class_Wide_Equivalent_Type
;
4060 procedure Set_Is_Compilation_Unit
(Id
: E
; V
: B
:= True) is
4062 Set_Flag149
(Id
, V
);
4063 end Set_Is_Compilation_Unit
;
4065 procedure Set_Is_Completely_Hidden
(Id
: E
; V
: B
:= True) is
4067 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
4068 Set_Flag103
(Id
, V
);
4069 end Set_Is_Completely_Hidden
;
4071 procedure Set_Is_Concurrent_Record_Type
(Id
: E
; V
: B
:= True) is
4074 end Set_Is_Concurrent_Record_Type
;
4076 procedure Set_Is_Constr_Subt_For_U_Nominal
(Id
: E
; V
: B
:= True) is
4079 end Set_Is_Constr_Subt_For_U_Nominal
;
4081 procedure Set_Is_Constr_Subt_For_UN_Aliased
(Id
: E
; V
: B
:= True) is
4083 Set_Flag141
(Id
, V
);
4084 end Set_Is_Constr_Subt_For_UN_Aliased
;
4086 procedure Set_Is_Constrained
(Id
: E
; V
: B
:= True) is
4088 pragma Assert
(Nkind
(Id
) in N_Entity
);
4090 end Set_Is_Constrained
;
4092 procedure Set_Is_Constructor
(Id
: E
; V
: B
:= True) is
4095 end Set_Is_Constructor
;
4097 procedure Set_Is_Controlled
(Id
: E
; V
: B
:= True) is
4099 pragma Assert
(Id
= Base_Type
(Id
));
4101 end Set_Is_Controlled
;
4103 procedure Set_Is_Controlling_Formal
(Id
: E
; V
: B
:= True) is
4105 pragma Assert
(Is_Formal
(Id
));
4107 end Set_Is_Controlling_Formal
;
4109 procedure Set_Is_CPP_Class
(Id
: E
; V
: B
:= True) is
4112 end Set_Is_CPP_Class
;
4114 procedure Set_Is_Descendent_Of_Address
(Id
: E
; V
: B
:= True) is
4116 pragma Assert
(Is_Type
(Id
));
4117 Set_Flag223
(Id
, V
);
4118 end Set_Is_Descendent_Of_Address
;
4120 procedure Set_Is_Discrim_SO_Function
(Id
: E
; V
: B
:= True) is
4122 Set_Flag176
(Id
, V
);
4123 end Set_Is_Discrim_SO_Function
;
4125 procedure Set_Is_Dispatch_Table_Entity
(Id
: E
; V
: B
:= True) is
4127 Set_Flag234
(Id
, V
);
4128 end Set_Is_Dispatch_Table_Entity
;
4130 procedure Set_Is_Dispatching_Operation
(Id
: E
; V
: B
:= True) is
4135 Is_Overloadable
(Id
)
4137 Ekind
(Id
) = E_Subprogram_Type
);
4140 end Set_Is_Dispatching_Operation
;
4142 procedure Set_Is_Eliminated
(Id
: E
; V
: B
:= True) is
4144 Set_Flag124
(Id
, V
);
4145 end Set_Is_Eliminated
;
4147 procedure Set_Is_Entry_Formal
(Id
: E
; V
: B
:= True) is
4150 end Set_Is_Entry_Formal
;
4152 procedure Set_Is_Exported
(Id
: E
; V
: B
:= True) is
4155 end Set_Is_Exported
;
4157 procedure Set_Is_First_Subtype
(Id
: E
; V
: B
:= True) is
4160 end Set_Is_First_Subtype
;
4162 procedure Set_Is_For_Access_Subtype
(Id
: E
; V
: B
:= True) is
4165 (Ekind
(Id
) = E_Record_Subtype
4167 Ekind
(Id
) = E_Private_Subtype
);
4168 Set_Flag118
(Id
, V
);
4169 end Set_Is_For_Access_Subtype
;
4171 procedure Set_Is_Formal_Subprogram
(Id
: E
; V
: B
:= True) is
4173 Set_Flag111
(Id
, V
);
4174 end Set_Is_Formal_Subprogram
;
4176 procedure Set_Is_Frozen
(Id
: E
; V
: B
:= True) is
4178 pragma Assert
(Nkind
(Id
) in N_Entity
);
4182 procedure Set_Is_Generic_Actual_Type
(Id
: E
; V
: B
:= True) is
4184 pragma Assert
(Is_Type
(Id
));
4186 end Set_Is_Generic_Actual_Type
;
4188 procedure Set_Is_Generic_Instance
(Id
: E
; V
: B
:= True) is
4190 Set_Flag130
(Id
, V
);
4191 end Set_Is_Generic_Instance
;
4193 procedure Set_Is_Generic_Type
(Id
: E
; V
: B
:= True) is
4195 pragma Assert
(Nkind
(Id
) in N_Entity
);
4197 end Set_Is_Generic_Type
;
4199 procedure Set_Is_Hidden
(Id
: E
; V
: B
:= True) is
4204 procedure Set_Is_Hidden_Open_Scope
(Id
: E
; V
: B
:= True) is
4206 Set_Flag171
(Id
, V
);
4207 end Set_Is_Hidden_Open_Scope
;
4209 procedure Set_Is_Immediately_Visible
(Id
: E
; V
: B
:= True) is
4211 pragma Assert
(Nkind
(Id
) in N_Entity
);
4213 end Set_Is_Immediately_Visible
;
4215 procedure Set_Is_Imported
(Id
: E
; V
: B
:= True) is
4218 end Set_Is_Imported
;
4220 procedure Set_Is_Inlined
(Id
: E
; V
: B
:= True) is
4225 procedure Set_Is_Interface
(Id
: E
; V
: B
:= True) is
4228 (Ekind
(Id
) = E_Record_Type
4229 or else Ekind
(Id
) = E_Record_Subtype
4230 or else Ekind
(Id
) = E_Record_Type_With_Private
4231 or else Ekind
(Id
) = E_Record_Subtype_With_Private
4232 or else Ekind
(Id
) = E_Class_Wide_Type
4233 or else Ekind
(Id
) = E_Class_Wide_Subtype
);
4234 Set_Flag186
(Id
, V
);
4235 end Set_Is_Interface
;
4237 procedure Set_Is_Instantiated
(Id
: E
; V
: B
:= True) is
4239 Set_Flag126
(Id
, V
);
4240 end Set_Is_Instantiated
;
4242 procedure Set_Is_Internal
(Id
: E
; V
: B
:= True) is
4244 pragma Assert
(Nkind
(Id
) in N_Entity
);
4246 end Set_Is_Internal
;
4248 procedure Set_Is_Interrupt_Handler
(Id
: E
; V
: B
:= True) is
4250 pragma Assert
(Nkind
(Id
) in N_Entity
);
4252 end Set_Is_Interrupt_Handler
;
4254 procedure Set_Is_Intrinsic_Subprogram
(Id
: E
; V
: B
:= True) is
4257 end Set_Is_Intrinsic_Subprogram
;
4259 procedure Set_Is_Itype
(Id
: E
; V
: B
:= True) is
4264 procedure Set_Is_Known_Non_Null
(Id
: E
; V
: B
:= True) is
4267 end Set_Is_Known_Non_Null
;
4269 procedure Set_Is_Known_Null
(Id
: E
; V
: B
:= True) is
4271 Set_Flag204
(Id
, V
);
4272 end Set_Is_Known_Null
;
4274 procedure Set_Is_Known_Valid
(Id
: E
; V
: B
:= True) is
4276 Set_Flag170
(Id
, V
);
4277 end Set_Is_Known_Valid
;
4279 procedure Set_Is_Limited_Composite
(Id
: E
; V
: B
:= True) is
4281 pragma Assert
(Is_Type
(Id
));
4282 Set_Flag106
(Id
, V
);
4283 end Set_Is_Limited_Composite
;
4285 procedure Set_Is_Limited_Interface
(Id
: E
; V
: B
:= True) is
4287 pragma Assert
(Is_Interface
(Id
));
4288 Set_Flag197
(Id
, V
);
4289 end Set_Is_Limited_Interface
;
4291 procedure Set_Is_Limited_Record
(Id
: E
; V
: B
:= True) is
4294 end Set_Is_Limited_Record
;
4296 procedure Set_Is_Machine_Code_Subprogram
(Id
: E
; V
: B
:= True) is
4298 pragma Assert
(Is_Subprogram
(Id
));
4299 Set_Flag137
(Id
, V
);
4300 end Set_Is_Machine_Code_Subprogram
;
4302 procedure Set_Is_Non_Static_Subtype
(Id
: E
; V
: B
:= True) is
4304 pragma Assert
(Is_Type
(Id
));
4305 Set_Flag109
(Id
, V
);
4306 end Set_Is_Non_Static_Subtype
;
4308 procedure Set_Is_Null_Init_Proc
(Id
: E
; V
: B
:= True) is
4310 pragma Assert
(Ekind
(Id
) = E_Procedure
);
4311 Set_Flag178
(Id
, V
);
4312 end Set_Is_Null_Init_Proc
;
4314 procedure Set_Is_Obsolescent
(Id
: E
; V
: B
:= True) is
4316 Set_Flag153
(Id
, V
);
4317 end Set_Is_Obsolescent
;
4319 procedure Set_Is_Only_Out_Parameter
(Id
: E
; V
: B
:= True) is
4321 pragma Assert
(Ekind
(Id
) = E_Out_Parameter
);
4322 Set_Flag226
(Id
, V
);
4323 end Set_Is_Only_Out_Parameter
;
4325 procedure Set_Is_Optional_Parameter
(Id
: E
; V
: B
:= True) is
4327 pragma Assert
(Is_Formal
(Id
));
4328 Set_Flag134
(Id
, V
);
4329 end Set_Is_Optional_Parameter
;
4331 procedure Set_Is_Overriding_Operation
(Id
: E
; V
: B
:= True) is
4333 pragma Assert
(Is_Subprogram
(Id
));
4335 end Set_Is_Overriding_Operation
;
4337 procedure Set_Is_Package_Body_Entity
(Id
: E
; V
: B
:= True) is
4339 Set_Flag160
(Id
, V
);
4340 end Set_Is_Package_Body_Entity
;
4342 procedure Set_Is_Packed
(Id
: E
; V
: B
:= True) is
4344 pragma Assert
(Id
= Base_Type
(Id
));
4348 procedure Set_Is_Packed_Array_Type
(Id
: E
; V
: B
:= True) is
4350 Set_Flag138
(Id
, V
);
4351 end Set_Is_Packed_Array_Type
;
4353 procedure Set_Is_Potentially_Use_Visible
(Id
: E
; V
: B
:= True) is
4355 pragma Assert
(Nkind
(Id
) in N_Entity
);
4357 end Set_Is_Potentially_Use_Visible
;
4359 procedure Set_Is_Preelaborated
(Id
: E
; V
: B
:= True) is
4362 end Set_Is_Preelaborated
;
4364 procedure Set_Is_Primitive
(Id
: E
; V
: B
:= True) is
4367 (Is_Overloadable
(Id
)
4368 or else Ekind
(Id
) = E_Generic_Function
4369 or else Ekind
(Id
) = E_Generic_Procedure
);
4370 Set_Flag218
(Id
, V
);
4371 end Set_Is_Primitive
;
4373 procedure Set_Is_Primitive_Wrapper
(Id
: E
; V
: B
:= True) is
4375 pragma Assert
(Ekind
(Id
) = E_Procedure
);
4376 Set_Flag195
(Id
, V
);
4377 end Set_Is_Primitive_Wrapper
;
4379 procedure Set_Is_Private_Composite
(Id
: E
; V
: B
:= True) is
4381 pragma Assert
(Is_Type
(Id
));
4382 Set_Flag107
(Id
, V
);
4383 end Set_Is_Private_Composite
;
4385 procedure Set_Is_Private_Descendant
(Id
: E
; V
: B
:= True) is
4388 end Set_Is_Private_Descendant
;
4390 procedure Set_Is_Protected_Interface
(Id
: E
; V
: B
:= True) is
4392 pragma Assert
(Is_Interface
(Id
));
4393 Set_Flag198
(Id
, V
);
4394 end Set_Is_Protected_Interface
;
4396 procedure Set_Is_Public
(Id
: E
; V
: B
:= True) is
4398 pragma Assert
(Nkind
(Id
) in N_Entity
);
4402 procedure Set_Is_Pure
(Id
: E
; V
: B
:= True) is
4407 procedure Set_Is_Pure_Unit_Access_Type
(Id
: E
; V
: B
:= True) is
4409 pragma Assert
(Is_Access_Type
(Id
));
4410 Set_Flag189
(Id
, V
);
4411 end Set_Is_Pure_Unit_Access_Type
;
4413 procedure Set_Is_RACW_Stub_Type
(Id
: E
; V
: B
:= True) is
4415 pragma Assert
(Is_Type
(Id
));
4416 Set_Flag244
(Id
, V
);
4417 end Set_Is_RACW_Stub_Type
;
4419 procedure Set_Is_Raised
(Id
: E
; V
: B
:= True) is
4421 pragma Assert
(Ekind
(Id
) = E_Exception
);
4422 Set_Flag224
(Id
, V
);
4425 procedure Set_Is_Remote_Call_Interface
(Id
: E
; V
: B
:= True) is
4428 end Set_Is_Remote_Call_Interface
;
4430 procedure Set_Is_Remote_Types
(Id
: E
; V
: B
:= True) is
4433 end Set_Is_Remote_Types
;
4435 procedure Set_Is_Renaming_Of_Object
(Id
: E
; V
: B
:= True) is
4437 Set_Flag112
(Id
, V
);
4438 end Set_Is_Renaming_Of_Object
;
4440 procedure Set_Is_Return_Object
(Id
: E
; V
: B
:= True) is
4442 Set_Flag209
(Id
, V
);
4443 end Set_Is_Return_Object
;
4445 procedure Set_Is_Shared_Passive
(Id
: E
; V
: B
:= True) is
4448 end Set_Is_Shared_Passive
;
4450 procedure Set_Is_Statically_Allocated
(Id
: E
; V
: B
:= True) is
4453 (Ekind
(Id
) = E_Exception
4454 or else Ekind
(Id
) = E_Variable
4455 or else Ekind
(Id
) = E_Constant
4456 or else Is_Type
(Id
)
4457 or else Ekind
(Id
) = E_Void
);
4459 end Set_Is_Statically_Allocated
;
4461 procedure Set_Is_Synchronized_Interface
(Id
: E
; V
: B
:= True) is
4463 pragma Assert
(Is_Interface
(Id
));
4464 Set_Flag199
(Id
, V
);
4465 end Set_Is_Synchronized_Interface
;
4467 procedure Set_Is_Tag
(Id
: E
; V
: B
:= True) is
4470 (Ekind
(Id
) = E_Component
4471 or else Ekind
(Id
) = E_Constant
);
4475 procedure Set_Is_Tagged_Type
(Id
: E
; V
: B
:= True) is
4478 end Set_Is_Tagged_Type
;
4480 procedure Set_Is_Task_Interface
(Id
: E
; V
: B
:= True) is
4482 pragma Assert
(Is_Interface
(Id
));
4483 Set_Flag200
(Id
, V
);
4484 end Set_Is_Task_Interface
;
4486 procedure Set_Is_Thunk
(Id
: E
; V
: B
:= True) is
4488 Set_Flag225
(Id
, V
);
4491 procedure Set_Is_Trivial_Subprogram
(Id
: E
; V
: B
:= True) is
4493 Set_Flag235
(Id
, V
);
4494 end Set_Is_Trivial_Subprogram
;
4496 procedure Set_Is_True_Constant
(Id
: E
; V
: B
:= True) is
4498 Set_Flag163
(Id
, V
);
4499 end Set_Is_True_Constant
;
4501 procedure Set_Is_Unchecked_Union
(Id
: E
; V
: B
:= True) is
4503 pragma Assert
(Id
= Base_Type
(Id
));
4504 Set_Flag117
(Id
, V
);
4505 end Set_Is_Unchecked_Union
;
4507 procedure Set_Is_Unsigned_Type
(Id
: E
; V
: B
:= True) is
4509 pragma Assert
(Is_Discrete_Or_Fixed_Point_Type
(Id
));
4510 Set_Flag144
(Id
, V
);
4511 end Set_Is_Unsigned_Type
;
4513 procedure Set_Is_Valued_Procedure
(Id
: E
; V
: B
:= True) is
4515 pragma Assert
(Ekind
(Id
) = E_Procedure
);
4516 Set_Flag127
(Id
, V
);
4517 end Set_Is_Valued_Procedure
;
4519 procedure Set_Is_Visible_Child_Unit
(Id
: E
; V
: B
:= True) is
4521 pragma Assert
(Is_Child_Unit
(Id
));
4522 Set_Flag116
(Id
, V
);
4523 end Set_Is_Visible_Child_Unit
;
4525 procedure Set_Is_Visible_Formal
(Id
: E
; V
: B
:= True) is
4527 Set_Flag206
(Id
, V
);
4528 end Set_Is_Visible_Formal
;
4530 procedure Set_Is_VMS_Exception
(Id
: E
; V
: B
:= True) is
4532 pragma Assert
(Ekind
(Id
) = E_Exception
);
4533 Set_Flag133
(Id
, V
);
4534 end Set_Is_VMS_Exception
;
4536 procedure Set_Is_Volatile
(Id
: E
; V
: B
:= True) is
4538 pragma Assert
(Nkind
(Id
) in N_Entity
);
4540 end Set_Is_Volatile
;
4542 procedure Set_Itype_Printed
(Id
: E
; V
: B
:= True) is
4544 pragma Assert
(Is_Itype
(Id
));
4545 Set_Flag202
(Id
, V
);
4546 end Set_Itype_Printed
;
4548 procedure Set_Kill_Elaboration_Checks
(Id
: E
; V
: B
:= True) is
4551 end Set_Kill_Elaboration_Checks
;
4553 procedure Set_Kill_Range_Checks
(Id
: E
; V
: B
:= True) is
4556 end Set_Kill_Range_Checks
;
4558 procedure Set_Kill_Tag_Checks
(Id
: E
; V
: B
:= True) is
4561 end Set_Kill_Tag_Checks
;
4563 procedure Set_Known_To_Have_Preelab_Init
(Id
: E
; V
: B
:= True) is
4565 pragma Assert
(Is_Type
(Id
));
4566 Set_Flag207
(Id
, V
);
4567 end Set_Known_To_Have_Preelab_Init
;
4569 procedure Set_Last_Assignment
(Id
: E
; V
: N
) is
4571 pragma Assert
(Is_Assignable
(Id
));
4573 end Set_Last_Assignment
;
4575 procedure Set_Last_Entity
(Id
: E
; V
: E
) is
4578 end Set_Last_Entity
;
4580 procedure Set_Limited_View
(Id
: E
; V
: E
) is
4582 pragma Assert
(Ekind
(Id
) = E_Package
);
4584 end Set_Limited_View
;
4586 procedure Set_Lit_Indexes
(Id
: E
; V
: E
) is
4588 pragma Assert
(Is_Enumeration_Type
(Id
) and then Root_Type
(Id
) = Id
);
4590 end Set_Lit_Indexes
;
4592 procedure Set_Lit_Strings
(Id
: E
; V
: E
) is
4594 pragma Assert
(Is_Enumeration_Type
(Id
) and then Root_Type
(Id
) = Id
);
4596 end Set_Lit_Strings
;
4598 procedure Set_Low_Bound_Known
(Id
: E
; V
: B
:= True) is
4600 pragma Assert
(Is_Formal
(Id
));
4601 Set_Flag205
(Id
, V
);
4602 end Set_Low_Bound_Known
;
4604 procedure Set_Machine_Radix_10
(Id
: E
; V
: B
:= True) is
4606 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
4608 end Set_Machine_Radix_10
;
4610 procedure Set_Master_Id
(Id
: E
; V
: E
) is
4612 pragma Assert
(Is_Access_Type
(Id
));
4616 procedure Set_Materialize_Entity
(Id
: E
; V
: B
:= True) is
4618 Set_Flag168
(Id
, V
);
4619 end Set_Materialize_Entity
;
4621 procedure Set_Mechanism
(Id
: E
; V
: M
) is
4623 pragma Assert
(Ekind
(Id
) = E_Function
or else Is_Formal
(Id
));
4624 Set_Uint8
(Id
, UI_From_Int
(V
));
4627 procedure Set_Modulus
(Id
: E
; V
: U
) is
4629 pragma Assert
(Ekind
(Id
) = E_Modular_Integer_Type
);
4633 procedure Set_Must_Be_On_Byte_Boundary
(Id
: E
; V
: B
:= True) is
4635 pragma Assert
(Is_Type
(Id
));
4636 Set_Flag183
(Id
, V
);
4637 end Set_Must_Be_On_Byte_Boundary
;
4639 procedure Set_Must_Have_Preelab_Init
(Id
: E
; V
: B
:= True) is
4641 pragma Assert
(Is_Type
(Id
));
4642 Set_Flag208
(Id
, V
);
4643 end Set_Must_Have_Preelab_Init
;
4645 procedure Set_Needs_Debug_Info
(Id
: E
; V
: B
:= True) is
4647 Set_Flag147
(Id
, V
);
4648 end Set_Needs_Debug_Info
;
4650 procedure Set_Needs_No_Actuals
(Id
: E
; V
: B
:= True) is
4653 (Is_Overloadable
(Id
)
4654 or else Ekind
(Id
) = E_Subprogram_Type
4655 or else Ekind
(Id
) = E_Entry_Family
);
4657 end Set_Needs_No_Actuals
;
4659 procedure Set_Never_Set_In_Source
(Id
: E
; V
: B
:= True) is
4661 Set_Flag115
(Id
, V
);
4662 end Set_Never_Set_In_Source
;
4664 procedure Set_Next_Inlined_Subprogram
(Id
: E
; V
: E
) is
4667 end Set_Next_Inlined_Subprogram
;
4669 procedure Set_No_Pool_Assigned
(Id
: E
; V
: B
:= True) is
4671 pragma Assert
(Is_Access_Type
(Id
) and then Id
= Base_Type
(Id
));
4672 Set_Flag131
(Id
, V
);
4673 end Set_No_Pool_Assigned
;
4675 procedure Set_No_Return
(Id
: E
; V
: B
:= True) is
4679 or else Ekind
(Id
) = E_Procedure
4680 or else Ekind
(Id
) = E_Generic_Procedure
);
4681 Set_Flag113
(Id
, V
);
4684 procedure Set_No_Strict_Aliasing
(Id
: E
; V
: B
:= True) is
4686 pragma Assert
(Is_Access_Type
(Id
) and then Id
= Base_Type
(Id
));
4687 Set_Flag136
(Id
, V
);
4688 end Set_No_Strict_Aliasing
;
4690 procedure Set_Non_Binary_Modulus
(Id
: E
; V
: B
:= True) is
4692 pragma Assert
(Is_Type
(Id
) and then Id
= Base_Type
(Id
));
4694 end Set_Non_Binary_Modulus
;
4696 procedure Set_Non_Limited_View
(Id
: E
; V
: E
) is
4698 pragma Assert
(Ekind
(Id
) in Incomplete_Kind
);
4700 end Set_Non_Limited_View
;
4702 procedure Set_Nonzero_Is_True
(Id
: E
; V
: B
:= True) is
4705 (Root_Type
(Id
) = Standard_Boolean
4706 and then Ekind
(Id
) = E_Enumeration_Type
);
4707 Set_Flag162
(Id
, V
);
4708 end Set_Nonzero_Is_True
;
4710 procedure Set_Normalized_First_Bit
(Id
: E
; V
: U
) is
4713 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
4715 end Set_Normalized_First_Bit
;
4717 procedure Set_Normalized_Position
(Id
: E
; V
: U
) is
4720 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
4722 end Set_Normalized_Position
;
4724 procedure Set_Normalized_Position_Max
(Id
: E
; V
: U
) is
4727 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
4729 end Set_Normalized_Position_Max
;
4731 procedure Set_OK_To_Reorder_Components
(Id
: E
; V
: B
:= True) is
4734 (Is_Record_Type
(Id
) and then Id
= Base_Type
(Id
));
4735 Set_Flag239
(Id
, V
);
4736 end Set_OK_To_Reorder_Components
;
4738 procedure Set_Optimize_Alignment_Space
(Id
: E
; V
: B
:= True) is
4742 or else Ekind
(Id
) = E_Constant
4743 or else Ekind
(Id
) = E_Variable
);
4744 Set_Flag241
(Id
, V
);
4745 end Set_Optimize_Alignment_Space
;
4747 procedure Set_Optimize_Alignment_Time
(Id
: E
; V
: B
:= True) is
4751 or else Ekind
(Id
) = E_Constant
4752 or else Ekind
(Id
) = E_Variable
);
4753 Set_Flag242
(Id
, V
);
4754 end Set_Optimize_Alignment_Time
;
4756 procedure Set_Original_Array_Type
(Id
: E
; V
: E
) is
4758 pragma Assert
(Is_Array_Type
(Id
) or else Is_Modular_Integer_Type
(Id
));
4760 end Set_Original_Array_Type
;
4762 procedure Set_Original_Record_Component
(Id
: E
; V
: E
) is
4765 (Ekind
(Id
) = E_Void
4766 or else Ekind
(Id
) = E_Component
4767 or else Ekind
(Id
) = E_Discriminant
);
4769 end Set_Original_Record_Component
;
4771 procedure Set_Overlays_Constant
(Id
: E
; V
: B
:= True) is
4773 Set_Flag243
(Id
, V
);
4774 end Set_Overlays_Constant
;
4776 procedure Set_Overridden_Operation
(Id
: E
; V
: E
) is
4779 end Set_Overridden_Operation
;
4781 procedure Set_Package_Instantiation
(Id
: E
; V
: N
) is
4784 (Ekind
(Id
) = E_Void
4785 or else Ekind
(Id
) = E_Generic_Package
4786 or else Ekind
(Id
) = E_Package
);
4788 end Set_Package_Instantiation
;
4790 procedure Set_Packed_Array_Type
(Id
: E
; V
: E
) is
4792 pragma Assert
(Is_Array_Type
(Id
));
4794 end Set_Packed_Array_Type
;
4796 procedure Set_Parent_Subtype
(Id
: E
; V
: E
) is
4798 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
4800 end Set_Parent_Subtype
;
4802 procedure Set_Primitive_Operations
(Id
: E
; V
: L
) is
4804 pragma Assert
(Is_Tagged_Type
(Id
));
4805 Set_Elist15
(Id
, V
);
4806 end Set_Primitive_Operations
;
4808 procedure Set_Prival
(Id
: E
; V
: E
) is
4810 pragma Assert
(Is_Protected_Component
(Id
));
4814 procedure Set_Prival_Link
(Id
: E
; V
: E
) is
4816 pragma Assert
(Ekind
(Id
) = E_Constant
4817 or else Ekind
(Id
) = E_Variable
);
4819 end Set_Prival_Link
;
4821 procedure Set_Private_Dependents
(Id
: E
; V
: L
) is
4823 pragma Assert
(Is_Incomplete_Or_Private_Type
(Id
));
4824 Set_Elist18
(Id
, V
);
4825 end Set_Private_Dependents
;
4827 procedure Set_Private_View
(Id
: E
; V
: N
) is
4829 pragma Assert
(Is_Private_Type
(Id
));
4831 end Set_Private_View
;
4833 procedure Set_Protected_Body_Subprogram
(Id
: E
; V
: E
) is
4835 pragma Assert
(Is_Subprogram
(Id
) or else Is_Entry
(Id
));
4837 end Set_Protected_Body_Subprogram
;
4839 procedure Set_Protected_Formal
(Id
: E
; V
: E
) is
4841 pragma Assert
(Is_Formal
(Id
));
4843 end Set_Protected_Formal
;
4845 procedure Set_Protection_Object
(Id
: E
; V
: E
) is
4847 pragma Assert
(Ekind
(Id
) = E_Entry
4848 or else Ekind
(Id
) = E_Entry_Family
4849 or else Ekind
(Id
) = E_Function
4850 or else Ekind
(Id
) = E_Procedure
);
4852 end Set_Protection_Object
;
4854 procedure Set_Reachable
(Id
: E
; V
: B
:= True) is
4859 procedure Set_Referenced
(Id
: E
; V
: B
:= True) is
4861 Set_Flag156
(Id
, V
);
4864 procedure Set_Referenced_As_LHS
(Id
: E
; V
: B
:= True) is
4867 end Set_Referenced_As_LHS
;
4869 procedure Set_Referenced_As_Out_Parameter
(Id
: E
; V
: B
:= True) is
4871 Set_Flag227
(Id
, V
);
4872 end Set_Referenced_As_Out_Parameter
;
4874 procedure Set_Referenced_Object
(Id
: E
; V
: N
) is
4876 pragma Assert
(Is_Type
(Id
));
4878 end Set_Referenced_Object
;
4880 procedure Set_Register_Exception_Call
(Id
: E
; V
: N
) is
4882 pragma Assert
(Ekind
(Id
) = E_Exception
);
4884 end Set_Register_Exception_Call
;
4886 procedure Set_Related_Array_Object
(Id
: E
; V
: E
) is
4888 pragma Assert
(Is_Array_Type
(Id
));
4890 end Set_Related_Array_Object
;
4892 procedure Set_Related_Instance
(Id
: E
; V
: E
) is
4895 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Package_Body
);
4897 end Set_Related_Instance
;
4899 procedure Set_Related_Type
(Id
: E
; V
: E
) is
4902 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Constant
);
4904 end Set_Related_Type
;
4906 procedure Set_Relative_Deadline_Variable
(Id
: E
; V
: E
) is
4908 pragma Assert
(Is_Task_Type
(Id
) and then Id
= Base_Type
(Id
));
4910 end Set_Relative_Deadline_Variable
;
4912 procedure Set_Renamed_Entity
(Id
: E
; V
: N
) is
4915 end Set_Renamed_Entity
;
4917 procedure Set_Renamed_In_Spec
(Id
: E
; V
: B
:= True) is
4919 pragma Assert
(Ekind
(Id
) = E_Package
);
4920 Set_Flag231
(Id
, V
);
4921 end Set_Renamed_In_Spec
;
4923 procedure Set_Renamed_Object
(Id
: E
; V
: N
) is
4926 end Set_Renamed_Object
;
4928 procedure Set_Renaming_Map
(Id
: E
; V
: U
) is
4931 end Set_Renaming_Map
;
4933 procedure Set_Requires_Overriding
(Id
: E
; V
: B
:= True) is
4935 pragma Assert
(Is_Overloadable
(Id
));
4936 Set_Flag213
(Id
, V
);
4937 end Set_Requires_Overriding
;
4939 procedure Set_Return_Present
(Id
: E
; V
: B
:= True) is
4942 end Set_Return_Present
;
4944 procedure Set_Return_Applies_To
(Id
: E
; V
: N
) is
4947 end Set_Return_Applies_To
;
4949 procedure Set_Returns_By_Ref
(Id
: E
; V
: B
:= True) is
4952 end Set_Returns_By_Ref
;
4954 procedure Set_Reverse_Bit_Order
(Id
: E
; V
: B
:= True) is
4957 (Is_Record_Type
(Id
) and then Id
= Base_Type
(Id
));
4958 Set_Flag164
(Id
, V
);
4959 end Set_Reverse_Bit_Order
;
4961 procedure Set_RM_Size
(Id
: E
; V
: U
) is
4963 pragma Assert
(Is_Type
(Id
));
4967 procedure Set_Scalar_Range
(Id
: E
; V
: N
) is
4970 end Set_Scalar_Range
;
4972 procedure Set_Scale_Value
(Id
: E
; V
: U
) is
4975 end Set_Scale_Value
;
4977 procedure Set_Scope_Depth_Value
(Id
: E
; V
: U
) is
4979 pragma Assert
(not Is_Record_Type
(Id
));
4981 end Set_Scope_Depth_Value
;
4983 procedure Set_Sec_Stack_Needed_For_Return
(Id
: E
; V
: B
:= True) is
4985 Set_Flag167
(Id
, V
);
4986 end Set_Sec_Stack_Needed_For_Return
;
4988 procedure Set_Shadow_Entities
(Id
: E
; V
: S
) is
4991 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
4993 end Set_Shadow_Entities
;
4995 procedure Set_Shared_Var_Procs_Instance
(Id
: E
; V
: E
) is
4997 pragma Assert
(Ekind
(Id
) = E_Variable
);
4999 end Set_Shared_Var_Procs_Instance
;
5001 procedure Set_Size_Check_Code
(Id
: E
; V
: N
) is
5003 pragma Assert
(Ekind
(Id
) = E_Constant
or else Ekind
(Id
) = E_Variable
);
5005 end Set_Size_Check_Code
;
5007 procedure Set_Size_Depends_On_Discriminant
(Id
: E
; V
: B
:= True) is
5009 Set_Flag177
(Id
, V
);
5010 end Set_Size_Depends_On_Discriminant
;
5012 procedure Set_Size_Known_At_Compile_Time
(Id
: E
; V
: B
:= True) is
5015 end Set_Size_Known_At_Compile_Time
;
5017 procedure Set_Small_Value
(Id
: E
; V
: R
) is
5019 pragma Assert
(Is_Fixed_Point_Type
(Id
));
5020 Set_Ureal21
(Id
, V
);
5021 end Set_Small_Value
;
5023 procedure Set_Spec_Entity
(Id
: E
; V
: E
) is
5025 pragma Assert
(Ekind
(Id
) = E_Package_Body
or else Is_Formal
(Id
));
5027 end Set_Spec_Entity
;
5029 procedure Set_Spec_PPC_List
(Id
: E
; V
: N
) is
5031 pragma Assert
(Is_Subprogram
(Id
));
5033 end Set_Spec_PPC_List
;
5035 procedure Set_Storage_Size_Variable
(Id
: E
; V
: E
) is
5037 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
5038 pragma Assert
(Id
= Base_Type
(Id
));
5040 end Set_Storage_Size_Variable
;
5042 procedure Set_Static_Elaboration_Desired
(Id
: E
; V
: B
) is
5044 pragma Assert
(Ekind
(Id
) = E_Package
);
5046 end Set_Static_Elaboration_Desired
;
5048 procedure Set_Static_Initialization
(Id
: E
; V
: N
) is
5051 (Ekind
(Id
) = E_Procedure
and then not Is_Dispatching_Operation
(Id
));
5053 end Set_Static_Initialization
;
5055 procedure Set_Stored_Constraint
(Id
: E
; V
: L
) is
5057 pragma Assert
(Nkind
(Id
) in N_Entity
);
5058 Set_Elist23
(Id
, V
);
5059 end Set_Stored_Constraint
;
5061 procedure Set_Strict_Alignment
(Id
: E
; V
: B
:= True) is
5063 pragma Assert
(Id
= Base_Type
(Id
));
5064 Set_Flag145
(Id
, V
);
5065 end Set_Strict_Alignment
;
5067 procedure Set_String_Literal_Length
(Id
: E
; V
: U
) is
5069 pragma Assert
(Ekind
(Id
) = E_String_Literal_Subtype
);
5071 end Set_String_Literal_Length
;
5073 procedure Set_String_Literal_Low_Bound
(Id
: E
; V
: N
) is
5075 pragma Assert
(Ekind
(Id
) = E_String_Literal_Subtype
);
5077 end Set_String_Literal_Low_Bound
;
5079 procedure Set_Suppress_Elaboration_Warnings
(Id
: E
; V
: B
:= True) is
5081 Set_Flag148
(Id
, V
);
5082 end Set_Suppress_Elaboration_Warnings
;
5084 procedure Set_Suppress_Init_Proc
(Id
: E
; V
: B
:= True) is
5086 pragma Assert
(Id
= Base_Type
(Id
));
5087 Set_Flag105
(Id
, V
);
5088 end Set_Suppress_Init_Proc
;
5090 procedure Set_Suppress_Style_Checks
(Id
: E
; V
: B
:= True) is
5092 Set_Flag165
(Id
, V
);
5093 end Set_Suppress_Style_Checks
;
5095 procedure Set_Suppress_Value_Tracking_On_Call
(Id
: E
; V
: B
:= True) is
5097 Set_Flag217
(Id
, V
);
5098 end Set_Suppress_Value_Tracking_On_Call
;
5100 procedure Set_Task_Body_Procedure
(Id
: E
; V
: N
) is
5102 pragma Assert
(Ekind
(Id
) in Task_Kind
);
5104 end Set_Task_Body_Procedure
;
5106 procedure Set_Treat_As_Volatile
(Id
: E
; V
: B
:= True) is
5109 end Set_Treat_As_Volatile
;
5111 procedure Set_Underlying_Full_View
(Id
: E
; V
: E
) is
5113 pragma Assert
(Ekind
(Id
) in Private_Kind
);
5115 end Set_Underlying_Full_View
;
5117 procedure Set_Universal_Aliasing
(Id
: E
; V
: B
:= True) is
5119 pragma Assert
(Is_Type
(Id
) and then Id
= Base_Type
(Id
));
5120 Set_Flag216
(Id
, V
);
5121 end Set_Universal_Aliasing
;
5123 procedure Set_Unset_Reference
(Id
: E
; V
: N
) is
5126 end Set_Unset_Reference
;
5128 procedure Set_Uses_Sec_Stack
(Id
: E
; V
: B
:= True) is
5131 end Set_Uses_Sec_Stack
;
5133 procedure Set_Used_As_Generic_Actual
(Id
: E
; V
: B
:= True) is
5135 Set_Flag222
(Id
, V
);
5136 end Set_Used_As_Generic_Actual
;
5138 procedure Set_Vax_Float
(Id
: E
; V
: B
:= True) is
5140 pragma Assert
(Id
= Base_Type
(Id
));
5141 Set_Flag151
(Id
, V
);
5144 procedure Set_Warnings_Off
(Id
: E
; V
: B
:= True) is
5147 end Set_Warnings_Off
;
5149 procedure Set_Warnings_Off_Used
(Id
: E
; V
: B
:= True) is
5151 Set_Flag236
(Id
, V
);
5152 end Set_Warnings_Off_Used
;
5154 procedure Set_Warnings_Off_Used_Unmodified
(Id
: E
; V
: B
:= True) is
5156 Set_Flag237
(Id
, V
);
5157 end Set_Warnings_Off_Used_Unmodified
;
5159 procedure Set_Warnings_Off_Used_Unreferenced
(Id
: E
; V
: B
:= True) is
5161 Set_Flag238
(Id
, V
);
5162 end Set_Warnings_Off_Used_Unreferenced
;
5164 procedure Set_Was_Hidden
(Id
: E
; V
: B
:= True) is
5166 Set_Flag196
(Id
, V
);
5169 procedure Set_Wrapped_Entity
(Id
: E
; V
: E
) is
5171 pragma Assert
(Ekind
(Id
) = E_Procedure
5172 and then Is_Primitive_Wrapper
(Id
));
5174 end Set_Wrapped_Entity
;
5176 -----------------------------------
5177 -- Field Initialization Routines --
5178 -----------------------------------
5180 procedure Init_Alignment
(Id
: E
) is
5182 Set_Uint14
(Id
, Uint_0
);
5185 procedure Init_Alignment
(Id
: E
; V
: Int
) is
5187 Set_Uint14
(Id
, UI_From_Int
(V
));
5190 procedure Init_Component_Bit_Offset
(Id
: E
) is
5192 Set_Uint11
(Id
, No_Uint
);
5193 end Init_Component_Bit_Offset
;
5195 procedure Init_Component_Bit_Offset
(Id
: E
; V
: Int
) is
5197 Set_Uint11
(Id
, UI_From_Int
(V
));
5198 end Init_Component_Bit_Offset
;
5200 procedure Init_Component_Size
(Id
: E
) is
5202 Set_Uint22
(Id
, Uint_0
);
5203 end Init_Component_Size
;
5205 procedure Init_Component_Size
(Id
: E
; V
: Int
) is
5207 Set_Uint22
(Id
, UI_From_Int
(V
));
5208 end Init_Component_Size
;
5210 procedure Init_Digits_Value
(Id
: E
) is
5212 Set_Uint17
(Id
, Uint_0
);
5213 end Init_Digits_Value
;
5215 procedure Init_Digits_Value
(Id
: E
; V
: Int
) is
5217 Set_Uint17
(Id
, UI_From_Int
(V
));
5218 end Init_Digits_Value
;
5220 procedure Init_Esize
(Id
: E
) is
5222 Set_Uint12
(Id
, Uint_0
);
5225 procedure Init_Esize
(Id
: E
; V
: Int
) is
5227 Set_Uint12
(Id
, UI_From_Int
(V
));
5230 procedure Init_Normalized_First_Bit
(Id
: E
) is
5232 Set_Uint8
(Id
, No_Uint
);
5233 end Init_Normalized_First_Bit
;
5235 procedure Init_Normalized_First_Bit
(Id
: E
; V
: Int
) is
5237 Set_Uint8
(Id
, UI_From_Int
(V
));
5238 end Init_Normalized_First_Bit
;
5240 procedure Init_Normalized_Position
(Id
: E
) is
5242 Set_Uint14
(Id
, No_Uint
);
5243 end Init_Normalized_Position
;
5245 procedure Init_Normalized_Position
(Id
: E
; V
: Int
) is
5247 Set_Uint14
(Id
, UI_From_Int
(V
));
5248 end Init_Normalized_Position
;
5250 procedure Init_Normalized_Position_Max
(Id
: E
) is
5252 Set_Uint10
(Id
, No_Uint
);
5253 end Init_Normalized_Position_Max
;
5255 procedure Init_Normalized_Position_Max
(Id
: E
; V
: Int
) is
5257 Set_Uint10
(Id
, UI_From_Int
(V
));
5258 end Init_Normalized_Position_Max
;
5260 procedure Init_RM_Size
(Id
: E
) is
5262 Set_Uint13
(Id
, Uint_0
);
5265 procedure Init_RM_Size
(Id
: E
; V
: Int
) is
5267 Set_Uint13
(Id
, UI_From_Int
(V
));
5270 -----------------------------
5271 -- Init_Component_Location --
5272 -----------------------------
5274 procedure Init_Component_Location
(Id
: E
) is
5276 Set_Uint8
(Id
, No_Uint
); -- Normalized_First_Bit
5277 Set_Uint10
(Id
, No_Uint
); -- Normalized_Position_Max
5278 Set_Uint11
(Id
, No_Uint
); -- Component_Bit_Offset
5279 Set_Uint12
(Id
, Uint_0
); -- Esize
5280 Set_Uint14
(Id
, No_Uint
); -- Normalized_Position
5281 end Init_Component_Location
;
5287 procedure Init_Size
(Id
: E
; V
: Int
) is
5289 Set_Uint12
(Id
, UI_From_Int
(V
)); -- Esize
5290 Set_Uint13
(Id
, UI_From_Int
(V
)); -- RM_Size
5293 ---------------------
5294 -- Init_Size_Align --
5295 ---------------------
5297 procedure Init_Size_Align
(Id
: E
) is
5299 Set_Uint12
(Id
, Uint_0
); -- Esize
5300 Set_Uint13
(Id
, Uint_0
); -- RM_Size
5301 Set_Uint14
(Id
, Uint_0
); -- Alignment
5302 end Init_Size_Align
;
5304 ----------------------------------------------
5305 -- Type Representation Attribute Predicates --
5306 ----------------------------------------------
5308 function Known_Alignment
(E
: Entity_Id
) return B
is
5310 return Uint14
(E
) /= Uint_0
5311 and then Uint14
(E
) /= No_Uint
;
5312 end Known_Alignment
;
5314 function Known_Component_Bit_Offset
(E
: Entity_Id
) return B
is
5316 return Uint11
(E
) /= No_Uint
;
5317 end Known_Component_Bit_Offset
;
5319 function Known_Component_Size
(E
: Entity_Id
) return B
is
5321 return Uint22
(Base_Type
(E
)) /= Uint_0
5322 and then Uint22
(Base_Type
(E
)) /= No_Uint
;
5323 end Known_Component_Size
;
5325 function Known_Esize
(E
: Entity_Id
) return B
is
5327 return Uint12
(E
) /= Uint_0
5328 and then Uint12
(E
) /= No_Uint
;
5331 function Known_Normalized_First_Bit
(E
: Entity_Id
) return B
is
5333 return Uint8
(E
) /= No_Uint
;
5334 end Known_Normalized_First_Bit
;
5336 function Known_Normalized_Position
(E
: Entity_Id
) return B
is
5338 return Uint14
(E
) /= No_Uint
;
5339 end Known_Normalized_Position
;
5341 function Known_Normalized_Position_Max
(E
: Entity_Id
) return B
is
5343 return Uint10
(E
) /= No_Uint
;
5344 end Known_Normalized_Position_Max
;
5346 function Known_RM_Size
(E
: Entity_Id
) return B
is
5348 return Uint13
(E
) /= No_Uint
5349 and then (Uint13
(E
) /= Uint_0
5350 or else Is_Discrete_Type
(E
)
5351 or else Is_Fixed_Point_Type
(E
));
5354 function Known_Static_Component_Bit_Offset
(E
: Entity_Id
) return B
is
5356 return Uint11
(E
) /= No_Uint
5357 and then Uint11
(E
) >= Uint_0
;
5358 end Known_Static_Component_Bit_Offset
;
5360 function Known_Static_Component_Size
(E
: Entity_Id
) return B
is
5362 return Uint22
(Base_Type
(E
)) > Uint_0
;
5363 end Known_Static_Component_Size
;
5365 function Known_Static_Esize
(E
: Entity_Id
) return B
is
5367 return Uint12
(E
) > Uint_0
;
5368 end Known_Static_Esize
;
5370 function Known_Static_Normalized_First_Bit
(E
: Entity_Id
) return B
is
5372 return Uint8
(E
) /= No_Uint
5373 and then Uint8
(E
) >= Uint_0
;
5374 end Known_Static_Normalized_First_Bit
;
5376 function Known_Static_Normalized_Position
(E
: Entity_Id
) return B
is
5378 return Uint14
(E
) /= No_Uint
5379 and then Uint14
(E
) >= Uint_0
;
5380 end Known_Static_Normalized_Position
;
5382 function Known_Static_Normalized_Position_Max
(E
: Entity_Id
) return B
is
5384 return Uint10
(E
) /= No_Uint
5385 and then Uint10
(E
) >= Uint_0
;
5386 end Known_Static_Normalized_Position_Max
;
5388 function Known_Static_RM_Size
(E
: Entity_Id
) return B
is
5390 return Uint13
(E
) > Uint_0
5391 or else Is_Discrete_Type
(E
)
5392 or else Is_Fixed_Point_Type
(E
);
5393 end Known_Static_RM_Size
;
5395 function Unknown_Alignment
(E
: Entity_Id
) return B
is
5397 return Uint14
(E
) = Uint_0
5398 or else Uint14
(E
) = No_Uint
;
5399 end Unknown_Alignment
;
5401 function Unknown_Component_Bit_Offset
(E
: Entity_Id
) return B
is
5403 return Uint11
(E
) = No_Uint
;
5404 end Unknown_Component_Bit_Offset
;
5406 function Unknown_Component_Size
(E
: Entity_Id
) return B
is
5408 return Uint22
(Base_Type
(E
)) = Uint_0
5410 Uint22
(Base_Type
(E
)) = No_Uint
;
5411 end Unknown_Component_Size
;
5413 function Unknown_Esize
(E
: Entity_Id
) return B
is
5415 return Uint12
(E
) = No_Uint
5417 Uint12
(E
) = Uint_0
;
5420 function Unknown_Normalized_First_Bit
(E
: Entity_Id
) return B
is
5422 return Uint8
(E
) = No_Uint
;
5423 end Unknown_Normalized_First_Bit
;
5425 function Unknown_Normalized_Position
(E
: Entity_Id
) return B
is
5427 return Uint14
(E
) = No_Uint
;
5428 end Unknown_Normalized_Position
;
5430 function Unknown_Normalized_Position_Max
(E
: Entity_Id
) return B
is
5432 return Uint10
(E
) = No_Uint
;
5433 end Unknown_Normalized_Position_Max
;
5435 function Unknown_RM_Size
(E
: Entity_Id
) return B
is
5437 return (Uint13
(E
) = Uint_0
5438 and then not Is_Discrete_Type
(E
)
5439 and then not Is_Fixed_Point_Type
(E
))
5440 or else Uint13
(E
) = No_Uint
;
5441 end Unknown_RM_Size
;
5443 --------------------
5444 -- Address_Clause --
5445 --------------------
5447 function Address_Clause
(Id
: E
) return N
is
5449 return Rep_Clause
(Id
, Name_Address
);
5452 ----------------------
5453 -- Alignment_Clause --
5454 ----------------------
5456 function Alignment_Clause
(Id
: E
) return N
is
5458 return Rep_Clause
(Id
, Name_Alignment
);
5459 end Alignment_Clause
;
5461 ----------------------
5462 -- Ancestor_Subtype --
5463 ----------------------
5465 function Ancestor_Subtype
(Id
: E
) return E
is
5467 -- If this is first subtype, or is a base type, then there is no
5468 -- ancestor subtype, so we return Empty to indicate this fact.
5470 if Is_First_Subtype
(Id
) or else Id
= Base_Type
(Id
) then
5475 D
: constant Node_Id
:= Declaration_Node
(Id
);
5478 -- If we have a subtype declaration, get the ancestor subtype
5480 if Nkind
(D
) = N_Subtype_Declaration
then
5481 if Nkind
(Subtype_Indication
(D
)) = N_Subtype_Indication
then
5482 return Entity
(Subtype_Mark
(Subtype_Indication
(D
)));
5484 return Entity
(Subtype_Indication
(D
));
5487 -- If not, then no subtype indication is available
5493 end Ancestor_Subtype
;
5499 procedure Append_Entity
(Id
: Entity_Id
; V
: Entity_Id
) is
5501 if Last_Entity
(V
) = Empty
then
5502 Set_First_Entity
(Id
=> V
, V
=> Id
);
5504 Set_Next_Entity
(Last_Entity
(V
), Id
);
5507 Set_Next_Entity
(Id
, Empty
);
5509 Set_Last_Entity
(Id
=> V
, V
=> Id
);
5512 --------------------
5513 -- Available_View --
5514 --------------------
5516 function Available_View
(Id
: E
) return E
is
5518 if Is_Incomplete_Type
(Id
)
5519 and then Present
(Non_Limited_View
(Id
))
5521 -- The non-limited view may itself be an incomplete type, in
5522 -- which case get its full view.
5524 return Get_Full_View
(Non_Limited_View
(Id
));
5526 elsif Is_Class_Wide_Type
(Id
)
5527 and then Is_Incomplete_Type
(Etype
(Id
))
5528 and then Present
(Non_Limited_View
(Etype
(Id
)))
5530 return Class_Wide_Type
(Non_Limited_View
(Etype
(Id
)));
5541 function Base_Type
(Id
: E
) return E
is
5544 when E_Enumeration_Subtype |
5546 E_Signed_Integer_Subtype |
5547 E_Modular_Integer_Subtype |
5548 E_Floating_Point_Subtype |
5549 E_Ordinary_Fixed_Point_Subtype |
5550 E_Decimal_Fixed_Point_Subtype |
5555 E_Record_Subtype_With_Private |
5556 E_Limited_Private_Subtype |
5558 E_Protected_Subtype |
5560 E_String_Literal_Subtype |
5561 E_Class_Wide_Subtype
=>
5569 -------------------------
5570 -- Component_Alignment --
5571 -------------------------
5573 -- Component Alignment is encoded using two flags, Flag128/129 as
5574 -- follows. Note that both flags False = Align_Default, so that the
5575 -- default initialization of flags to False initializes component
5576 -- alignment to the default value as required.
5578 -- Flag128 Flag129 Value
5579 -- ------- ------- -----
5580 -- False False Calign_Default
5581 -- False True Calign_Component_Size
5582 -- True False Calign_Component_Size_4
5583 -- True True Calign_Storage_Unit
5585 function Component_Alignment
(Id
: E
) return C
is
5586 BT
: constant Node_Id
:= Base_Type
(Id
);
5589 pragma Assert
(Is_Array_Type
(Id
) or else Is_Record_Type
(Id
));
5591 if Flag128
(BT
) then
5592 if Flag129
(BT
) then
5593 return Calign_Storage_Unit
;
5595 return Calign_Component_Size_4
;
5599 if Flag129
(BT
) then
5600 return Calign_Component_Size
;
5602 return Calign_Default
;
5605 end Component_Alignment
;
5607 --------------------
5608 -- Constant_Value --
5609 --------------------
5611 function Constant_Value
(Id
: E
) return N
is
5612 D
: constant Node_Id
:= Declaration_Node
(Id
);
5616 -- If we have no declaration node, then return no constant value.
5617 -- Not clear how this can happen, but it does sometimes ???
5618 -- To investigate, remove this check and compile discrim_po.adb.
5623 -- Normal case where a declaration node is present
5625 elsif Nkind
(D
) = N_Object_Renaming_Declaration
then
5626 return Renamed_Object
(Id
);
5628 -- If this is a component declaration whose entity is constant, it
5629 -- is a prival within a protected function. It does not have
5630 -- a constant value.
5632 elsif Nkind
(D
) = N_Component_Declaration
then
5635 -- If there is an expression, return it
5637 elsif Present
(Expression
(D
)) then
5638 return (Expression
(D
));
5640 -- For a constant, see if we have a full view
5642 elsif Ekind
(Id
) = E_Constant
5643 and then Present
(Full_View
(Id
))
5645 Full_D
:= Parent
(Full_View
(Id
));
5647 -- The full view may have been rewritten as an object renaming
5649 if Nkind
(Full_D
) = N_Object_Renaming_Declaration
then
5650 return Name
(Full_D
);
5652 return Expression
(Full_D
);
5655 -- Otherwise we have no expression to return
5662 ----------------------
5663 -- Declaration_Node --
5664 ----------------------
5666 function Declaration_Node
(Id
: E
) return N
is
5670 if Ekind
(Id
) = E_Incomplete_Type
5671 and then Present
(Full_View
(Id
))
5673 P
:= Parent
(Full_View
(Id
));
5679 if Nkind
(P
) /= N_Selected_Component
5680 and then Nkind
(P
) /= N_Expanded_Name
5682 not (Nkind
(P
) = N_Defining_Program_Unit_Name
5683 and then Is_Child_Unit
(Id
))
5690 end Declaration_Node
;
5692 ---------------------
5693 -- Designated_Type --
5694 ---------------------
5696 function Designated_Type
(Id
: E
) return E
is
5700 Desig_Type
:= Directly_Designated_Type
(Id
);
5702 if Ekind
(Desig_Type
) = E_Incomplete_Type
5703 and then Present
(Full_View
(Desig_Type
))
5705 return Full_View
(Desig_Type
);
5707 elsif Is_Class_Wide_Type
(Desig_Type
)
5708 and then Ekind
(Etype
(Desig_Type
)) = E_Incomplete_Type
5709 and then Present
(Full_View
(Etype
(Desig_Type
)))
5710 and then Present
(Class_Wide_Type
(Full_View
(Etype
(Desig_Type
))))
5712 return Class_Wide_Type
(Full_View
(Etype
(Desig_Type
)));
5717 end Designated_Type
;
5719 -----------------------------
5720 -- Enclosing_Dynamic_Scope --
5721 -----------------------------
5723 function Enclosing_Dynamic_Scope
(Id
: E
) return E
is
5727 -- The following test is an error defense against some syntax
5728 -- errors that can leave scopes very messed up.
5730 if Id
= Standard_Standard
then
5734 -- Normal case, search enclosing scopes
5736 -- Note: the test for Present (S) should not be required, it is a
5737 -- defence against an ill-formed tree.
5741 -- If we somehow got an empty value for Scope, the tree must be
5742 -- malformed. Rather than blow up we return Standard in this case.
5745 return Standard_Standard
;
5747 -- Quit if we get to standard or a dynamic scope
5749 elsif S
= Standard_Standard
5750 or else Is_Dynamic_Scope
(S
)
5754 -- Otherwise keep climbing
5760 end Enclosing_Dynamic_Scope
;
5762 ----------------------
5763 -- Entry_Index_Type --
5764 ----------------------
5766 function Entry_Index_Type
(Id
: E
) return N
is
5768 pragma Assert
(Ekind
(Id
) = E_Entry_Family
);
5769 return Etype
(Discrete_Subtype_Definition
(Parent
(Id
)));
5770 end Entry_Index_Type
;
5772 ---------------------
5773 -- First_Component --
5774 ---------------------
5776 function First_Component
(Id
: E
) return E
is
5781 (Is_Record_Type
(Id
) or else Is_Incomplete_Or_Private_Type
(Id
));
5783 Comp_Id
:= First_Entity
(Id
);
5784 while Present
(Comp_Id
) loop
5785 exit when Ekind
(Comp_Id
) = E_Component
;
5786 Comp_Id
:= Next_Entity
(Comp_Id
);
5790 end First_Component
;
5792 -------------------------------------
5793 -- First_Component_Or_Discriminant --
5794 -------------------------------------
5796 function First_Component_Or_Discriminant
(Id
: E
) return E
is
5801 (Is_Record_Type
(Id
) or else Is_Incomplete_Or_Private_Type
(Id
));
5803 Comp_Id
:= First_Entity
(Id
);
5804 while Present
(Comp_Id
) loop
5805 exit when Ekind
(Comp_Id
) = E_Component
5807 Ekind
(Comp_Id
) = E_Discriminant
;
5808 Comp_Id
:= Next_Entity
(Comp_Id
);
5812 end First_Component_Or_Discriminant
;
5814 ------------------------
5815 -- First_Discriminant --
5816 ------------------------
5818 function First_Discriminant
(Id
: E
) return E
is
5823 (Has_Discriminants
(Id
)
5824 or else Has_Unknown_Discriminants
(Id
));
5826 Ent
:= First_Entity
(Id
);
5828 -- The discriminants are not necessarily contiguous, because access
5829 -- discriminants will generate itypes. They are not the first entities
5830 -- either, because tag and controller record must be ahead of them.
5832 if Chars
(Ent
) = Name_uTag
then
5833 Ent
:= Next_Entity
(Ent
);
5836 if Chars
(Ent
) = Name_uController
then
5837 Ent
:= Next_Entity
(Ent
);
5840 -- Skip all hidden stored discriminants if any
5842 while Present
(Ent
) loop
5843 exit when Ekind
(Ent
) = E_Discriminant
5844 and then not Is_Completely_Hidden
(Ent
);
5846 Ent
:= Next_Entity
(Ent
);
5849 pragma Assert
(Ekind
(Ent
) = E_Discriminant
);
5852 end First_Discriminant
;
5858 function First_Formal
(Id
: E
) return E
is
5863 (Is_Overloadable
(Id
)
5864 or else Ekind
(Id
) = E_Entry_Family
5865 or else Ekind
(Id
) = E_Subprogram_Body
5866 or else Ekind
(Id
) = E_Subprogram_Type
);
5868 if Ekind
(Id
) = E_Enumeration_Literal
then
5872 Formal
:= First_Entity
(Id
);
5874 if Present
(Formal
) and then Is_Formal
(Formal
) then
5882 ------------------------------
5883 -- First_Formal_With_Extras --
5884 ------------------------------
5886 function First_Formal_With_Extras
(Id
: E
) return E
is
5891 (Is_Overloadable
(Id
)
5892 or else Ekind
(Id
) = E_Entry_Family
5893 or else Ekind
(Id
) = E_Subprogram_Body
5894 or else Ekind
(Id
) = E_Subprogram_Type
);
5896 if Ekind
(Id
) = E_Enumeration_Literal
then
5900 Formal
:= First_Entity
(Id
);
5902 if Present
(Formal
) and then Is_Formal
(Formal
) then
5905 return Extra_Formals
(Id
); -- Empty if no extra formals
5908 end First_Formal_With_Extras
;
5910 -------------------------------
5911 -- First_Stored_Discriminant --
5912 -------------------------------
5914 function First_Stored_Discriminant
(Id
: E
) return E
is
5917 function Has_Completely_Hidden_Discriminant
(Id
: E
) return Boolean;
5918 -- Scans the Discriminants to see whether any are Completely_Hidden
5919 -- (the mechanism for describing non-specified stored discriminants)
5921 ----------------------------------------
5922 -- Has_Completely_Hidden_Discriminant --
5923 ----------------------------------------
5925 function Has_Completely_Hidden_Discriminant
(Id
: E
) return Boolean is
5926 Ent
: Entity_Id
:= Id
;
5929 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
5931 while Present
(Ent
) and then Ekind
(Ent
) = E_Discriminant
loop
5932 if Is_Completely_Hidden
(Ent
) then
5936 Ent
:= Next_Entity
(Ent
);
5940 end Has_Completely_Hidden_Discriminant
;
5942 -- Start of processing for First_Stored_Discriminant
5946 (Has_Discriminants
(Id
)
5947 or else Has_Unknown_Discriminants
(Id
));
5949 Ent
:= First_Entity
(Id
);
5951 if Chars
(Ent
) = Name_uTag
then
5952 Ent
:= Next_Entity
(Ent
);
5955 if Chars
(Ent
) = Name_uController
then
5956 Ent
:= Next_Entity
(Ent
);
5959 if Has_Completely_Hidden_Discriminant
(Ent
) then
5961 while Present
(Ent
) loop
5962 exit when Is_Completely_Hidden
(Ent
);
5963 Ent
:= Next_Entity
(Ent
);
5968 pragma Assert
(Ekind
(Ent
) = E_Discriminant
);
5971 end First_Stored_Discriminant
;
5977 function First_Subtype
(Id
: E
) return E
is
5978 B
: constant Entity_Id
:= Base_Type
(Id
);
5979 F
: constant Node_Id
:= Freeze_Node
(B
);
5983 -- If the base type has no freeze node, it is a type in standard,
5984 -- and always acts as its own first subtype unless it is one of
5985 -- the predefined integer types. If the type is formal, it is also
5986 -- a first subtype, and its base type has no freeze node. On the other
5987 -- hand, a subtype of a generic formal is not its own first_subtype.
5988 -- Its base type, if anonymous, is attached to the formal type decl.
5989 -- from which the first subtype is obtained.
5993 if B
= Base_Type
(Standard_Integer
) then
5994 return Standard_Integer
;
5996 elsif B
= Base_Type
(Standard_Long_Integer
) then
5997 return Standard_Long_Integer
;
5999 elsif B
= Base_Type
(Standard_Short_Short_Integer
) then
6000 return Standard_Short_Short_Integer
;
6002 elsif B
= Base_Type
(Standard_Short_Integer
) then
6003 return Standard_Short_Integer
;
6005 elsif B
= Base_Type
(Standard_Long_Long_Integer
) then
6006 return Standard_Long_Long_Integer
;
6008 elsif Is_Generic_Type
(Id
) then
6009 if Present
(Parent
(B
)) then
6010 return Defining_Identifier
(Parent
(B
));
6012 return Defining_Identifier
(Associated_Node_For_Itype
(B
));
6019 -- Otherwise we check the freeze node, if it has a First_Subtype_Link
6020 -- then we use that link, otherwise (happens with some Itypes), we use
6021 -- the base type itself.
6024 Ent
:= First_Subtype_Link
(F
);
6026 if Present
(Ent
) then
6034 -------------------------------------
6035 -- Get_Attribute_Definition_Clause --
6036 -------------------------------------
6038 function Get_Attribute_Definition_Clause
6040 Id
: Attribute_Id
) return Node_Id
6045 N
:= First_Rep_Item
(E
);
6046 while Present
(N
) loop
6047 if Nkind
(N
) = N_Attribute_Definition_Clause
6048 and then Get_Attribute_Id
(Chars
(N
)) = Id
6057 end Get_Attribute_Definition_Clause
;
6063 function Get_Full_View
(T
: Entity_Id
) return Entity_Id
is
6065 if Ekind
(T
) = E_Incomplete_Type
6066 and then Present
(Full_View
(T
))
6068 return Full_View
(T
);
6070 elsif Is_Class_Wide_Type
(T
)
6071 and then Ekind
(Root_Type
(T
)) = E_Incomplete_Type
6072 and then Present
(Full_View
(Root_Type
(T
)))
6074 return Class_Wide_Type
(Full_View
(Root_Type
(T
)));
6081 --------------------
6082 -- Get_Rep_Pragma --
6083 --------------------
6085 function Get_Rep_Pragma
(E
: Entity_Id
; Nam
: Name_Id
) return Node_Id
is
6089 N
:= First_Rep_Item
(E
);
6090 while Present
(N
) loop
6091 if Nkind
(N
) = N_Pragma
and then Pragma_Name
(N
) = Nam
then
6101 ------------------------
6102 -- Has_Attach_Handler --
6103 ------------------------
6105 function Has_Attach_Handler
(Id
: E
) return B
is
6109 pragma Assert
(Is_Protected_Type
(Id
));
6111 Ritem
:= First_Rep_Item
(Id
);
6112 while Present
(Ritem
) loop
6113 if Nkind
(Ritem
) = N_Pragma
6114 and then Pragma_Name
(Ritem
) = Name_Attach_Handler
6118 Ritem
:= Next_Rep_Item
(Ritem
);
6123 end Has_Attach_Handler
;
6125 -------------------------------------
6126 -- Has_Attribute_Definition_Clause --
6127 -------------------------------------
6129 function Has_Attribute_Definition_Clause
6131 Id
: Attribute_Id
) return Boolean
6134 return Present
(Get_Attribute_Definition_Clause
(E
, Id
));
6135 end Has_Attribute_Definition_Clause
;
6141 function Has_Entries
(Id
: E
) return B
is
6145 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 -- Has_Foreign_Convention --
6161 ----------------------------
6163 function Has_Foreign_Convention
(Id
: E
) return B
is
6165 return Convention
(Id
) in Foreign_Convention
;
6166 end Has_Foreign_Convention
;
6168 ---------------------------
6169 -- Has_Interrupt_Handler --
6170 ---------------------------
6172 function Has_Interrupt_Handler
(Id
: E
) return B
is
6176 pragma Assert
(Is_Protected_Type
(Id
));
6178 Ritem
:= First_Rep_Item
(Id
);
6179 while Present
(Ritem
) loop
6180 if Nkind
(Ritem
) = N_Pragma
6181 and then Pragma_Name
(Ritem
) = Name_Interrupt_Handler
6185 Ritem
:= Next_Rep_Item
(Ritem
);
6190 end Has_Interrupt_Handler
;
6192 --------------------------
6193 -- Has_Private_Ancestor --
6194 --------------------------
6196 function Has_Private_Ancestor
(Id
: E
) return B
is
6197 R
: constant Entity_Id
:= Root_Type
(Id
);
6198 T1
: Entity_Id
:= Id
;
6201 if Is_Private_Type
(T1
) then
6209 end Has_Private_Ancestor
;
6211 --------------------
6212 -- Has_Rep_Pragma --
6213 --------------------
6215 function Has_Rep_Pragma
(E
: Entity_Id
; Nam
: Name_Id
) return Boolean is
6217 return Present
(Get_Rep_Pragma
(E
, Nam
));
6220 --------------------
6221 -- Has_Unmodified --
6222 --------------------
6224 function Has_Unmodified
(E
: Entity_Id
) return Boolean is
6226 if Has_Pragma_Unmodified
(E
) then
6228 elsif Warnings_Off
(E
) then
6229 Set_Warnings_Off_Used_Unmodified
(E
);
6236 ---------------------
6237 -- Has_Unreferenced --
6238 ---------------------
6240 function Has_Unreferenced
(E
: Entity_Id
) return Boolean is
6242 if Has_Pragma_Unreferenced
(E
) then
6244 elsif Warnings_Off
(E
) then
6245 Set_Warnings_Off_Used_Unreferenced
(E
);
6250 end Has_Unreferenced
;
6252 ----------------------
6253 -- Has_Warnings_Off --
6254 ----------------------
6256 function Has_Warnings_Off
(E
: Entity_Id
) return Boolean is
6258 if Warnings_Off
(E
) then
6259 Set_Warnings_Off_Used
(E
);
6264 end Has_Warnings_Off
;
6266 ------------------------------
6267 -- Implementation_Base_Type --
6268 ------------------------------
6270 function Implementation_Base_Type
(Id
: E
) return E
is
6275 Bastyp
:= Base_Type
(Id
);
6277 if Is_Incomplete_Or_Private_Type
(Bastyp
) then
6278 Imptyp
:= Underlying_Type
(Bastyp
);
6280 -- If we have an implementation type, then just return it,
6281 -- otherwise we return the Base_Type anyway. This can only
6282 -- happen in error situations and should avoid some error bombs.
6284 if Present
(Imptyp
) then
6285 return Base_Type
(Imptyp
);
6293 end Implementation_Base_Type
;
6295 ---------------------
6296 -- Is_Boolean_Type --
6297 ---------------------
6299 function Is_Boolean_Type
(Id
: E
) return B
is
6301 return Root_Type
(Id
) = Standard_Boolean
;
6302 end Is_Boolean_Type
;
6304 ---------------------
6305 -- Is_By_Copy_Type --
6306 ---------------------
6308 function Is_By_Copy_Type
(Id
: E
) return B
is
6310 -- If Id is a private type whose full declaration has not been seen,
6311 -- we assume for now that it is not a By_Copy type. Clearly this
6312 -- attribute should not be used before the type is frozen, but it is
6313 -- needed to build the associated record of a protected type. Another
6314 -- place where some lookahead for a full view is needed ???
6317 Is_Elementary_Type
(Id
)
6318 or else (Is_Private_Type
(Id
)
6319 and then Present
(Underlying_Type
(Id
))
6320 and then Is_Elementary_Type
(Underlying_Type
(Id
)));
6321 end Is_By_Copy_Type
;
6323 --------------------------
6324 -- Is_By_Reference_Type --
6325 --------------------------
6327 -- This function knows too much semantics, it should be in sem_util ???
6329 function Is_By_Reference_Type
(Id
: E
) return B
is
6330 Btype
: constant Entity_Id
:= Base_Type
(Id
);
6333 if Error_Posted
(Id
)
6334 or else Error_Posted
(Btype
)
6338 elsif Is_Private_Type
(Btype
) then
6340 Utyp
: constant Entity_Id
:= Underlying_Type
(Btype
);
6345 return Is_By_Reference_Type
(Utyp
);
6349 elsif Is_Incomplete_Type
(Btype
) then
6351 Ftyp
: constant Entity_Id
:= Full_View
(Btype
);
6356 return Is_By_Reference_Type
(Ftyp
);
6360 elsif Is_Concurrent_Type
(Btype
) then
6363 elsif Is_Record_Type
(Btype
) then
6364 if Is_Limited_Record
(Btype
)
6365 or else Is_Tagged_Type
(Btype
)
6366 or else Is_Volatile
(Btype
)
6375 C
:= First_Component
(Btype
);
6376 while Present
(C
) loop
6377 if Is_By_Reference_Type
(Etype
(C
))
6378 or else Is_Volatile
(Etype
(C
))
6383 C
:= Next_Component
(C
);
6390 elsif Is_Array_Type
(Btype
) then
6393 or else Is_By_Reference_Type
(Component_Type
(Btype
))
6394 or else Is_Volatile
(Component_Type
(Btype
))
6395 or else Has_Volatile_Components
(Btype
);
6400 end Is_By_Reference_Type
;
6402 ------------------------
6403 -- Is_Constant_Object --
6404 ------------------------
6406 function Is_Constant_Object
(Id
: E
) return B
is
6407 K
: constant Entity_Kind
:= Ekind
(Id
);
6410 K
= E_Constant
or else K
= E_In_Parameter
or else K
= E_Loop_Parameter
;
6411 end Is_Constant_Object
;
6413 ---------------------
6414 -- Is_Derived_Type --
6415 ---------------------
6417 function Is_Derived_Type
(Id
: E
) return B
is
6422 and then Base_Type
(Id
) /= Root_Type
(Id
)
6423 and then not Is_Class_Wide_Type
(Id
)
6425 if not Is_Numeric_Type
(Root_Type
(Id
)) then
6429 Par
:= Parent
(First_Subtype
(Id
));
6431 return Present
(Par
)
6432 and then Nkind
(Par
) = N_Full_Type_Declaration
6433 and then Nkind
(Type_Definition
(Par
)) =
6434 N_Derived_Type_Definition
;
6440 end Is_Derived_Type
;
6442 --------------------
6443 -- Is_Discriminal --
6444 --------------------
6446 function Is_Discriminal
(Id
: E
) return B
is
6449 (Ekind
(Id
) = E_Constant
6450 or else Ekind
(Id
) = E_In_Parameter
)
6451 and then Present
(Discriminal_Link
(Id
));
6454 ----------------------
6455 -- Is_Dynamic_Scope --
6456 ----------------------
6458 function Is_Dynamic_Scope
(Id
: E
) return B
is
6461 Ekind
(Id
) = E_Block
6463 Ekind
(Id
) = E_Function
6465 Ekind
(Id
) = E_Procedure
6467 Ekind
(Id
) = E_Subprogram_Body
6469 Ekind
(Id
) = E_Task_Type
6471 Ekind
(Id
) = E_Entry
6473 Ekind
(Id
) = E_Entry_Family
6475 Ekind
(Id
) = E_Return_Statement
;
6476 end Is_Dynamic_Scope
;
6478 --------------------
6479 -- Is_Entity_Name --
6480 --------------------
6482 function Is_Entity_Name
(N
: Node_Id
) return Boolean is
6483 Kind
: constant Node_Kind
:= Nkind
(N
);
6486 -- Identifiers, operator symbols, expanded names are entity names
6488 return Kind
= N_Identifier
6489 or else Kind
= N_Operator_Symbol
6490 or else Kind
= N_Expanded_Name
6492 -- Attribute references are entity names if they refer to an entity.
6493 -- Note that we don't do this by testing for the presence of the
6494 -- Entity field in the N_Attribute_Reference node, since it may not
6495 -- have been set yet.
6497 or else (Kind
= N_Attribute_Reference
6498 and then Is_Entity_Attribute_Name
(Attribute_Name
(N
)));
6501 ---------------------------
6502 -- Is_Indefinite_Subtype --
6503 ---------------------------
6505 function Is_Indefinite_Subtype
(Id
: Entity_Id
) return B
is
6506 K
: constant Entity_Kind
:= Ekind
(Id
);
6509 if Is_Constrained
(Id
) then
6512 elsif K
in Array_Kind
6513 or else K
in Class_Wide_Kind
6514 or else Has_Unknown_Discriminants
(Id
)
6518 -- Known discriminants: indefinite if there are no default values
6520 elsif K
in Record_Kind
6521 or else Is_Incomplete_Or_Private_Type
(Id
)
6522 or else Is_Concurrent_Type
(Id
)
6524 return (Has_Discriminants
(Id
)
6525 and then No
(Discriminant_Default_Value
(First_Discriminant
(Id
))));
6530 end Is_Indefinite_Subtype
;
6532 --------------------------------
6533 -- Is_Inherently_Limited_Type --
6534 --------------------------------
6536 function Is_Inherently_Limited_Type
(Id
: E
) return B
is
6537 Btype
: constant Entity_Id
:= Base_Type
(Id
);
6540 if Is_Private_Type
(Btype
) then
6542 Utyp
: constant Entity_Id
:= Underlying_Type
(Btype
);
6547 return Is_Inherently_Limited_Type
(Utyp
);
6551 elsif Is_Concurrent_Type
(Btype
) then
6554 elsif Is_Record_Type
(Btype
) then
6555 if Is_Limited_Record
(Btype
) then
6556 return not Is_Interface
(Btype
)
6557 or else Is_Protected_Interface
(Btype
)
6558 or else Is_Synchronized_Interface
(Btype
)
6559 or else Is_Task_Interface
(Btype
);
6561 elsif Is_Class_Wide_Type
(Btype
) then
6562 return Is_Inherently_Limited_Type
(Root_Type
(Btype
));
6569 C
:= First_Component
(Btype
);
6570 while Present
(C
) loop
6571 if Is_Inherently_Limited_Type
(Etype
(C
)) then
6575 C
:= Next_Component
(C
);
6582 elsif Is_Array_Type
(Btype
) then
6583 return Is_Inherently_Limited_Type
(Component_Type
(Btype
));
6588 end Is_Inherently_Limited_Type
;
6590 ---------------------
6591 -- Is_Limited_Type --
6592 ---------------------
6594 function Is_Limited_Type
(Id
: E
) return B
is
6595 Btype
: constant E
:= Base_Type
(Id
);
6596 Rtype
: constant E
:= Root_Type
(Btype
);
6599 if not Is_Type
(Id
) then
6602 elsif Ekind
(Btype
) = E_Limited_Private_Type
6603 or else Is_Limited_Composite
(Btype
)
6607 elsif Is_Concurrent_Type
(Btype
) then
6610 -- The Is_Limited_Record flag normally indicates that the type is
6611 -- limited. The exception is that a type does not inherit limitedness
6612 -- from its interface ancestor. So the type may be derived from a
6613 -- limited interface, but is not limited.
6615 elsif Is_Limited_Record
(Id
)
6616 and then not Is_Interface
(Id
)
6620 -- Otherwise we will look around to see if there is some other reason
6621 -- for it to be limited, except that if an error was posted on the
6622 -- entity, then just assume it is non-limited, because it can cause
6623 -- trouble to recurse into a murky erroneous entity!
6625 elsif Error_Posted
(Id
) then
6628 elsif Is_Record_Type
(Btype
) then
6630 if Is_Limited_Interface
(Id
) then
6633 -- AI-419: limitedness is not inherited from a limited interface
6635 elsif Is_Limited_Record
(Rtype
) then
6636 return not Is_Interface
(Rtype
)
6637 or else Is_Protected_Interface
(Rtype
)
6638 or else Is_Synchronized_Interface
(Rtype
)
6639 or else Is_Task_Interface
(Rtype
);
6641 elsif Is_Class_Wide_Type
(Btype
) then
6642 return Is_Limited_Type
(Rtype
);
6649 C
:= First_Component
(Btype
);
6650 while Present
(C
) loop
6651 if Is_Limited_Type
(Etype
(C
)) then
6655 C
:= Next_Component
(C
);
6662 elsif Is_Array_Type
(Btype
) then
6663 return Is_Limited_Type
(Component_Type
(Btype
));
6668 end Is_Limited_Type
;
6670 -----------------------------------
6671 -- Is_Package_Or_Generic_Package --
6672 -----------------------------------
6674 function Is_Package_Or_Generic_Package
(Id
: E
) return B
is
6677 Ekind
(Id
) = E_Package
6679 Ekind
(Id
) = E_Generic_Package
;
6680 end Is_Package_Or_Generic_Package
;
6686 function Is_Prival
(Id
: E
) return B
is
6689 (Ekind
(Id
) = E_Constant
6690 or else Ekind
(Id
) = E_Variable
)
6691 and then Present
(Prival_Link
(Id
));
6694 ----------------------------
6695 -- Is_Protected_Component --
6696 ----------------------------
6698 function Is_Protected_Component
(Id
: E
) return B
is
6700 return Ekind
(Id
) = E_Component
6701 and then Is_Protected_Type
(Scope
(Id
));
6702 end Is_Protected_Component
;
6704 ------------------------------
6705 -- Is_Protected_Record_Type --
6706 ------------------------------
6708 function Is_Protected_Record_Type
(Id
: E
) return B
is
6711 Is_Concurrent_Record_Type
(Id
)
6712 and then Is_Protected_Type
(Corresponding_Concurrent_Type
(Id
));
6713 end Is_Protected_Record_Type
;
6715 --------------------------------
6716 -- Is_Standard_Character_Type --
6717 --------------------------------
6719 function Is_Standard_Character_Type
(Id
: E
) return B
is
6721 if Is_Type
(Id
) then
6723 R
: constant Entity_Id
:= Root_Type
(Id
);
6726 R
= Standard_Character
6728 R
= Standard_Wide_Character
6730 R
= Standard_Wide_Wide_Character
;
6736 end Is_Standard_Character_Type
;
6738 --------------------
6739 -- Is_String_Type --
6740 --------------------
6742 function Is_String_Type
(Id
: E
) return B
is
6744 return Ekind
(Id
) in String_Kind
6745 or else (Is_Array_Type
(Id
)
6746 and then Number_Dimensions
(Id
) = 1
6747 and then Is_Character_Type
(Component_Type
(Id
)));
6750 -------------------------
6751 -- Is_Task_Record_Type --
6752 -------------------------
6754 function Is_Task_Record_Type
(Id
: E
) return B
is
6757 Is_Concurrent_Record_Type
(Id
)
6758 and then Is_Task_Type
(Corresponding_Concurrent_Type
(Id
));
6759 end Is_Task_Record_Type
;
6761 ------------------------
6762 -- Is_Wrapper_Package --
6763 ------------------------
6765 function Is_Wrapper_Package
(Id
: E
) return B
is
6767 return (Ekind
(Id
) = E_Package
6768 and then Present
(Related_Instance
(Id
)));
6769 end Is_Wrapper_Package
;
6771 --------------------
6772 -- Next_Component --
6773 --------------------
6775 function Next_Component
(Id
: E
) return E
is
6779 Comp_Id
:= Next_Entity
(Id
);
6780 while Present
(Comp_Id
) loop
6781 exit when Ekind
(Comp_Id
) = E_Component
;
6782 Comp_Id
:= Next_Entity
(Comp_Id
);
6788 ------------------------------------
6789 -- Next_Component_Or_Discriminant --
6790 ------------------------------------
6792 function Next_Component_Or_Discriminant
(Id
: E
) return E
is
6796 Comp_Id
:= Next_Entity
(Id
);
6797 while Present
(Comp_Id
) loop
6798 exit when Ekind
(Comp_Id
) = E_Component
6800 Ekind
(Comp_Id
) = E_Discriminant
;
6801 Comp_Id
:= Next_Entity
(Comp_Id
);
6805 end Next_Component_Or_Discriminant
;
6807 -----------------------
6808 -- Next_Discriminant --
6809 -----------------------
6811 -- This function actually implements both Next_Discriminant and
6812 -- Next_Stored_Discriminant by making sure that the Discriminant
6813 -- returned is of the same variety as Id.
6815 function Next_Discriminant
(Id
: E
) return E
is
6817 -- Derived Tagged types with private extensions look like this...
6819 -- E_Discriminant d1
6820 -- E_Discriminant d2
6822 -- E_Discriminant d1
6823 -- E_Discriminant d2
6826 -- so it is critical not to go past the leading discriminants
6831 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
6834 D
:= Next_Entity
(D
);
6836 or else (Ekind
(D
) /= E_Discriminant
6837 and then not Is_Itype
(D
))
6842 exit when Ekind
(D
) = E_Discriminant
6843 and then (Is_Completely_Hidden
(D
) = Is_Completely_Hidden
(Id
));
6847 end Next_Discriminant
;
6853 function Next_Formal
(Id
: E
) return E
is
6857 -- Follow the chain of declared entities as long as the kind of the
6858 -- entity corresponds to a formal parameter. Skip internal entities
6859 -- that may have been created for implicit subtypes, in the process
6860 -- of analyzing default expressions.
6865 P
:= Next_Entity
(P
);
6867 if No
(P
) or else Is_Formal
(P
) then
6869 elsif not Is_Internal
(P
) then
6875 -----------------------------
6876 -- Next_Formal_With_Extras --
6877 -----------------------------
6879 function Next_Formal_With_Extras
(Id
: E
) return E
is
6881 if Present
(Extra_Formal
(Id
)) then
6882 return Extra_Formal
(Id
);
6884 return Next_Formal
(Id
);
6886 end Next_Formal_With_Extras
;
6892 function Next_Index
(Id
: Node_Id
) return Node_Id
is
6901 function Next_Literal
(Id
: E
) return E
is
6903 pragma Assert
(Nkind
(Id
) in N_Entity
);
6907 ------------------------------
6908 -- Next_Stored_Discriminant --
6909 ------------------------------
6911 function Next_Stored_Discriminant
(Id
: E
) return E
is
6913 -- See comment in Next_Discriminant
6915 return Next_Discriminant
(Id
);
6916 end Next_Stored_Discriminant
;
6918 -----------------------
6919 -- Number_Dimensions --
6920 -----------------------
6922 function Number_Dimensions
(Id
: E
) return Pos
is
6927 if Ekind
(Id
) in String_Kind
then
6932 T
:= First_Index
(Id
);
6933 while Present
(T
) loop
6940 end Number_Dimensions
;
6942 --------------------------
6943 -- Number_Discriminants --
6944 --------------------------
6946 function Number_Discriminants
(Id
: E
) return Pos
is
6952 Discr
:= First_Discriminant
(Id
);
6953 while Present
(Discr
) loop
6955 Discr
:= Next_Discriminant
(Discr
);
6959 end Number_Discriminants
;
6961 --------------------
6962 -- Number_Entries --
6963 --------------------
6965 function Number_Entries
(Id
: E
) return Nat
is
6970 pragma Assert
(Is_Concurrent_Type
(Id
));
6973 Ent
:= First_Entity
(Id
);
6974 while Present
(Ent
) loop
6975 if Is_Entry
(Ent
) then
6979 Ent
:= Next_Entity
(Ent
);
6985 --------------------
6986 -- Number_Formals --
6987 --------------------
6989 function Number_Formals
(Id
: E
) return Pos
is
6995 Formal
:= First_Formal
(Id
);
6996 while Present
(Formal
) loop
6998 Formal
:= Next_Formal
(Formal
);
7004 --------------------
7005 -- Parameter_Mode --
7006 --------------------
7008 function Parameter_Mode
(Id
: E
) return Formal_Kind
is
7013 ---------------------
7014 -- Record_Rep_Item --
7015 ---------------------
7017 procedure Record_Rep_Item
(E
: Entity_Id
; N
: Node_Id
) is
7019 Set_Next_Rep_Item
(N
, First_Rep_Item
(E
));
7020 Set_First_Rep_Item
(E
, N
);
7021 end Record_Rep_Item
;
7027 function Root_Type
(Id
: E
) return E
is
7031 pragma Assert
(Nkind
(Id
) in N_Entity
);
7033 T
:= Base_Type
(Id
);
7035 if Ekind
(T
) = E_Class_Wide_Type
then
7038 elsif Ekind
(T
) = E_Class_Wide_Subtype
then
7039 return Etype
(Base_Type
(T
));
7041 -- ??? T comes from Base_Type, how can it be a subtype?
7042 -- Also Base_Type is supposed to be idempotent, so either way
7043 -- this is equivalent to "return Etype (T)" and should be merged
7044 -- with the E_Class_Wide_Type case.
7055 -- Following test catches some error cases resulting from
7058 elsif No
(Etyp
) then
7061 elsif Is_Private_Type
(T
) and then Etyp
= Full_View
(T
) then
7064 elsif Is_Private_Type
(Etyp
) and then Full_View
(Etyp
) = T
then
7070 -- Return if there is a circularity in the inheritance chain. This
7071 -- happens in some error situations and we do not want to get
7072 -- stuck in this loop.
7074 if T
= Base_Type
(Id
) then
7085 function Scope_Depth
(Id
: E
) return Uint
is
7090 while Is_Record_Type
(Scop
) loop
7091 Scop
:= Scope
(Scop
);
7094 return Scope_Depth_Value
(Scop
);
7097 ---------------------
7098 -- Scope_Depth_Set --
7099 ---------------------
7101 function Scope_Depth_Set
(Id
: E
) return B
is
7103 return not Is_Record_Type
(Id
)
7104 and then Field22
(Id
) /= Union_Id
(Empty
);
7105 end Scope_Depth_Set
;
7107 -----------------------------
7108 -- Set_Component_Alignment --
7109 -----------------------------
7111 -- Component Alignment is encoded using two flags, Flag128/129 as
7112 -- follows. Note that both flags False = Align_Default, so that the
7113 -- default initialization of flags to False initializes component
7114 -- alignment to the default value as required.
7116 -- Flag128 Flag129 Value
7117 -- ------- ------- -----
7118 -- False False Calign_Default
7119 -- False True Calign_Component_Size
7120 -- True False Calign_Component_Size_4
7121 -- True True Calign_Storage_Unit
7123 procedure Set_Component_Alignment
(Id
: E
; V
: C
) is
7125 pragma Assert
((Is_Array_Type
(Id
) or else Is_Record_Type
(Id
))
7126 and then Id
= Base_Type
(Id
));
7129 when Calign_Default
=>
7130 Set_Flag128
(Id
, False);
7131 Set_Flag129
(Id
, False);
7133 when Calign_Component_Size
=>
7134 Set_Flag128
(Id
, False);
7135 Set_Flag129
(Id
, True);
7137 when Calign_Component_Size_4
=>
7138 Set_Flag128
(Id
, True);
7139 Set_Flag129
(Id
, False);
7141 when Calign_Storage_Unit
=>
7142 Set_Flag128
(Id
, True);
7143 Set_Flag129
(Id
, True);
7145 end Set_Component_Alignment
;
7151 function Size_Clause
(Id
: E
) return N
is
7153 return Rep_Clause
(Id
, Name_Size
);
7156 ------------------------
7157 -- Stream_Size_Clause --
7158 ------------------------
7160 function Stream_Size_Clause
(Id
: E
) return N
is
7162 return Rep_Clause
(Id
, Name_Stream_Size
);
7163 end Stream_Size_Clause
;
7169 function Subtype_Kind
(K
: Entity_Kind
) return Entity_Kind
is
7175 Kind
:= E_Access_Subtype
;
7179 Kind
:= E_Array_Subtype
;
7181 when E_Class_Wide_Type |
7182 E_Class_Wide_Subtype
=>
7183 Kind
:= E_Class_Wide_Subtype
;
7185 when E_Decimal_Fixed_Point_Type |
7186 E_Decimal_Fixed_Point_Subtype
=>
7187 Kind
:= E_Decimal_Fixed_Point_Subtype
;
7189 when E_Ordinary_Fixed_Point_Type |
7190 E_Ordinary_Fixed_Point_Subtype
=>
7191 Kind
:= E_Ordinary_Fixed_Point_Subtype
;
7193 when E_Private_Type |
7194 E_Private_Subtype
=>
7195 Kind
:= E_Private_Subtype
;
7197 when E_Limited_Private_Type |
7198 E_Limited_Private_Subtype
=>
7199 Kind
:= E_Limited_Private_Subtype
;
7201 when E_Record_Type_With_Private |
7202 E_Record_Subtype_With_Private
=>
7203 Kind
:= E_Record_Subtype_With_Private
;
7205 when E_Record_Type |
7207 Kind
:= E_Record_Subtype
;
7209 when E_String_Type |
7211 Kind
:= E_String_Subtype
;
7213 when Enumeration_Kind
=>
7214 Kind
:= E_Enumeration_Subtype
;
7217 Kind
:= E_Floating_Point_Subtype
;
7219 when Signed_Integer_Kind
=>
7220 Kind
:= E_Signed_Integer_Subtype
;
7222 when Modular_Integer_Kind
=>
7223 Kind
:= E_Modular_Integer_Subtype
;
7225 when Protected_Kind
=>
7226 Kind
:= E_Protected_Subtype
;
7229 Kind
:= E_Task_Subtype
;
7233 raise Program_Error
;
7239 -------------------------
7240 -- First_Tag_Component --
7241 -------------------------
7243 function First_Tag_Component
(Id
: E
) return E
is
7245 Typ
: Entity_Id
:= Id
;
7248 pragma Assert
(Is_Tagged_Type
(Typ
));
7250 if Is_Class_Wide_Type
(Typ
) then
7251 Typ
:= Root_Type
(Typ
);
7254 if Is_Private_Type
(Typ
) then
7255 Typ
:= Underlying_Type
(Typ
);
7257 -- If the underlying type is missing then the source program has
7258 -- errors and there is nothing else to do (the full-type declaration
7259 -- associated with the private type declaration is missing).
7266 Comp
:= First_Entity
(Typ
);
7267 while Present
(Comp
) loop
7268 if Is_Tag
(Comp
) then
7272 Comp
:= Next_Entity
(Comp
);
7275 -- No tag component found
7278 end First_Tag_Component
;
7280 ------------------------
7281 -- Next_Tag_Component --
7282 ------------------------
7284 function Next_Tag_Component
(Id
: E
) return E
is
7288 pragma Assert
(Is_Tag
(Id
));
7290 Comp
:= Next_Entity
(Id
);
7291 while Present
(Comp
) loop
7292 if Is_Tag
(Comp
) then
7293 pragma Assert
(Chars
(Comp
) /= Name_uTag
);
7297 Comp
:= Next_Entity
(Comp
);
7300 -- No tag component found
7303 end Next_Tag_Component
;
7305 ---------------------
7306 -- Type_High_Bound --
7307 ---------------------
7309 function Type_High_Bound
(Id
: E
) return Node_Id
is
7310 Rng
: constant Node_Id
:= Scalar_Range
(Id
);
7312 if Nkind
(Rng
) = N_Subtype_Indication
then
7313 return High_Bound
(Range_Expression
(Constraint
(Rng
)));
7315 return High_Bound
(Rng
);
7317 end Type_High_Bound
;
7319 --------------------
7320 -- Type_Low_Bound --
7321 --------------------
7323 function Type_Low_Bound
(Id
: E
) return Node_Id
is
7324 Rng
: constant Node_Id
:= Scalar_Range
(Id
);
7326 if Nkind
(Rng
) = N_Subtype_Indication
then
7327 return Low_Bound
(Range_Expression
(Constraint
(Rng
)));
7329 return Low_Bound
(Rng
);
7333 ---------------------
7334 -- Underlying_Type --
7335 ---------------------
7337 function Underlying_Type
(Id
: E
) return E
is
7339 -- For record_with_private the underlying type is always the direct
7340 -- full view. Never try to take the full view of the parent it
7341 -- doesn't make sense.
7343 if Ekind
(Id
) = E_Record_Type_With_Private
then
7344 return Full_View
(Id
);
7346 elsif Ekind
(Id
) in Incomplete_Or_Private_Kind
then
7348 -- If we have an incomplete or private type with a full view,
7349 -- then we return the Underlying_Type of this full view
7351 if Present
(Full_View
(Id
)) then
7352 if Id
= Full_View
(Id
) then
7354 -- Previous error in declaration
7359 return Underlying_Type
(Full_View
(Id
));
7362 -- If we have an incomplete entity that comes from the limited
7363 -- view then we return the Underlying_Type of its non-limited
7366 elsif From_With_Type
(Id
)
7367 and then Present
(Non_Limited_View
(Id
))
7369 return Underlying_Type
(Non_Limited_View
(Id
));
7371 -- Otherwise check for the case where we have a derived type or
7372 -- subtype, and if so get the Underlying_Type of the parent type.
7374 elsif Etype
(Id
) /= Id
then
7375 return Underlying_Type
(Etype
(Id
));
7377 -- Otherwise we have an incomplete or private type that has
7378 -- no full view, which means that we have not encountered the
7379 -- completion, so return Empty to indicate the underlying type
7380 -- is not yet known.
7386 -- For non-incomplete, non-private types, return the type itself
7387 -- Also for entities that are not types at all return the entity
7393 end Underlying_Type
;
7395 ------------------------
7396 -- Write_Entity_Flags --
7397 ------------------------
7399 procedure Write_Entity_Flags
(Id
: Entity_Id
; Prefix
: String) is
7401 procedure W
(Flag_Name
: String; Flag
: Boolean);
7402 -- Write out given flag if it is set
7408 procedure W
(Flag_Name
: String; Flag
: Boolean) is
7412 Write_Str
(Flag_Name
);
7413 Write_Str
(" = True");
7418 -- Start of processing for Write_Entity_Flags
7421 if (Is_Array_Type
(Id
) or else Is_Record_Type
(Id
))
7422 and then Id
= Base_Type
(Id
)
7425 Write_Str
("Component_Alignment = ");
7427 case Component_Alignment
(Id
) is
7428 when Calign_Default
=>
7429 Write_Str
("Calign_Default");
7431 when Calign_Component_Size
=>
7432 Write_Str
("Calign_Component_Size");
7434 when Calign_Component_Size_4
=>
7435 Write_Str
("Calign_Component_Size_4");
7437 when Calign_Storage_Unit
=>
7438 Write_Str
("Calign_Storage_Unit");
7444 W
("Address_Taken", Flag104
(Id
));
7445 W
("Body_Needed_For_SAL", Flag40
(Id
));
7446 W
("C_Pass_By_Copy", Flag125
(Id
));
7447 W
("Can_Never_Be_Null", Flag38
(Id
));
7448 W
("Checks_May_Be_Suppressed", Flag31
(Id
));
7449 W
("Debug_Info_Off", Flag166
(Id
));
7450 W
("Default_Expressions_Processed", Flag108
(Id
));
7451 W
("Delay_Cleanups", Flag114
(Id
));
7452 W
("Delay_Subprogram_Descriptors", Flag50
(Id
));
7453 W
("Depends_On_Private", Flag14
(Id
));
7454 W
("Discard_Names", Flag88
(Id
));
7455 W
("Elaboration_Entity_Required", Flag174
(Id
));
7456 W
("Elaborate_Body_Desirable", Flag210
(Id
));
7457 W
("Entry_Accepted", Flag152
(Id
));
7458 W
("Can_Use_Internal_Rep", Flag229
(Id
));
7459 W
("Finalize_Storage_Only", Flag158
(Id
));
7460 W
("From_With_Type", Flag159
(Id
));
7461 W
("Has_Aliased_Components", Flag135
(Id
));
7462 W
("Has_Alignment_Clause", Flag46
(Id
));
7463 W
("Has_All_Calls_Remote", Flag79
(Id
));
7464 W
("Has_Anon_Block_Suffix", Flag201
(Id
));
7465 W
("Has_Atomic_Components", Flag86
(Id
));
7466 W
("Has_Biased_Representation", Flag139
(Id
));
7467 W
("Has_Completion", Flag26
(Id
));
7468 W
("Has_Completion_In_Body", Flag71
(Id
));
7469 W
("Has_Complex_Representation", Flag140
(Id
));
7470 W
("Has_Component_Size_Clause", Flag68
(Id
));
7471 W
("Has_Contiguous_Rep", Flag181
(Id
));
7472 W
("Has_Controlled_Component", Flag43
(Id
));
7473 W
("Has_Controlling_Result", Flag98
(Id
));
7474 W
("Has_Convention_Pragma", Flag119
(Id
));
7475 W
("Has_Delayed_Freeze", Flag18
(Id
));
7476 W
("Has_Discriminants", Flag5
(Id
));
7477 W
("Has_Enumeration_Rep_Clause", Flag66
(Id
));
7478 W
("Has_Exit", Flag47
(Id
));
7479 W
("Has_External_Tag_Rep_Clause", Flag110
(Id
));
7480 W
("Has_Forward_Instantiation", Flag175
(Id
));
7481 W
("Has_Fully_Qualified_Name", Flag173
(Id
));
7482 W
("Has_Gigi_Rep_Item", Flag82
(Id
));
7483 W
("Has_Homonym", Flag56
(Id
));
7484 W
("Has_Initial_Value", Flag219
(Id
));
7485 W
("Has_Machine_Radix_Clause", Flag83
(Id
));
7486 W
("Has_Master_Entity", Flag21
(Id
));
7487 W
("Has_Missing_Return", Flag142
(Id
));
7488 W
("Has_Nested_Block_With_Handler", Flag101
(Id
));
7489 W
("Has_Non_Standard_Rep", Flag75
(Id
));
7490 W
("Has_Object_Size_Clause", Flag172
(Id
));
7491 W
("Has_Per_Object_Constraint", Flag154
(Id
));
7492 W
("Has_Persistent_BSS", Flag188
(Id
));
7493 W
("Has_Postconditions", Flag240
(Id
));
7494 W
("Has_Pragma_Controlled", Flag27
(Id
));
7495 W
("Has_Pragma_Elaborate_Body", Flag150
(Id
));
7496 W
("Has_Pragma_Inline", Flag157
(Id
));
7497 W
("Has_Pragma_Inline_Always", Flag230
(Id
));
7498 W
("Has_Pragma_Pack", Flag121
(Id
));
7499 W
("Has_Pragma_Preelab_Init", Flag221
(Id
));
7500 W
("Has_Pragma_Pure", Flag203
(Id
));
7501 W
("Has_Pragma_Pure_Function", Flag179
(Id
));
7502 W
("Has_Pragma_Unmodified", Flag233
(Id
));
7503 W
("Has_Pragma_Unreferenced", Flag180
(Id
));
7504 W
("Has_Pragma_Unreferenced_Objects", Flag212
(Id
));
7505 W
("Has_Primitive_Operations", Flag120
(Id
));
7506 W
("Has_Private_Declaration", Flag155
(Id
));
7507 W
("Has_Qualified_Name", Flag161
(Id
));
7508 W
("Has_RACW", Flag214
(Id
));
7509 W
("Has_Record_Rep_Clause", Flag65
(Id
));
7510 W
("Has_Recursive_Call", Flag143
(Id
));
7511 W
("Has_Size_Clause", Flag29
(Id
));
7512 W
("Has_Small_Clause", Flag67
(Id
));
7513 W
("Has_Specified_Layout", Flag100
(Id
));
7514 W
("Has_Specified_Stream_Input", Flag190
(Id
));
7515 W
("Has_Specified_Stream_Output", Flag191
(Id
));
7516 W
("Has_Specified_Stream_Read", Flag192
(Id
));
7517 W
("Has_Specified_Stream_Write", Flag193
(Id
));
7518 W
("Has_Static_Discriminants", Flag211
(Id
));
7519 W
("Has_Storage_Size_Clause", Flag23
(Id
));
7520 W
("Has_Stream_Size_Clause", Flag184
(Id
));
7521 W
("Has_Subprogram_Descriptor", Flag93
(Id
));
7522 W
("Has_Task", Flag30
(Id
));
7523 W
("Has_Thunks", Flag228
(Id
));
7524 W
("Has_Unchecked_Union", Flag123
(Id
));
7525 W
("Has_Unknown_Discriminants", Flag72
(Id
));
7526 W
("Has_Up_Level_Access", Flag215
(Id
));
7527 W
("Has_Volatile_Components", Flag87
(Id
));
7528 W
("Has_Xref_Entry", Flag182
(Id
));
7529 W
("Implemented_By_Entry", Flag232
(Id
));
7530 W
("In_Package_Body", Flag48
(Id
));
7531 W
("In_Private_Part", Flag45
(Id
));
7532 W
("In_Use", Flag8
(Id
));
7533 W
("Is_AST_Entry", Flag132
(Id
));
7534 W
("Is_Abstract_Subprogram", Flag19
(Id
));
7535 W
("Is_Abstract_Type", Flag146
(Id
));
7536 W
("Is_Local_Anonymous_Access", Flag194
(Id
));
7537 W
("Is_Access_Constant", Flag69
(Id
));
7538 W
("Is_Ada_2005_Only", Flag185
(Id
));
7539 W
("Is_Aliased", Flag15
(Id
));
7540 W
("Is_Asynchronous", Flag81
(Id
));
7541 W
("Is_Atomic", Flag85
(Id
));
7542 W
("Is_Bit_Packed_Array", Flag122
(Id
));
7543 W
("Is_CPP_Class", Flag74
(Id
));
7544 W
("Is_Called", Flag102
(Id
));
7545 W
("Is_Character_Type", Flag63
(Id
));
7546 W
("Is_Child_Unit", Flag73
(Id
));
7547 W
("Is_Class_Wide_Equivalent_Type", Flag35
(Id
));
7548 W
("Is_Compilation_Unit", Flag149
(Id
));
7549 W
("Is_Completely_Hidden", Flag103
(Id
));
7550 W
("Is_Concurrent_Record_Type", Flag20
(Id
));
7551 W
("Is_Constr_Subt_For_UN_Aliased", Flag141
(Id
));
7552 W
("Is_Constr_Subt_For_U_Nominal", Flag80
(Id
));
7553 W
("Is_Constrained", Flag12
(Id
));
7554 W
("Is_Constructor", Flag76
(Id
));
7555 W
("Is_Controlled", Flag42
(Id
));
7556 W
("Is_Controlling_Formal", Flag97
(Id
));
7557 W
("Is_Descendent_Of_Address", Flag223
(Id
));
7558 W
("Is_Discrim_SO_Function", Flag176
(Id
));
7559 W
("Is_Dispatch_Table_Entity", Flag234
(Id
));
7560 W
("Is_Dispatching_Operation", Flag6
(Id
));
7561 W
("Is_Eliminated", Flag124
(Id
));
7562 W
("Is_Entry_Formal", Flag52
(Id
));
7563 W
("Is_Exported", Flag99
(Id
));
7564 W
("Is_First_Subtype", Flag70
(Id
));
7565 W
("Is_For_Access_Subtype", Flag118
(Id
));
7566 W
("Is_Formal_Subprogram", Flag111
(Id
));
7567 W
("Is_Frozen", Flag4
(Id
));
7568 W
("Is_Generic_Actual_Type", Flag94
(Id
));
7569 W
("Is_Generic_Instance", Flag130
(Id
));
7570 W
("Is_Generic_Type", Flag13
(Id
));
7571 W
("Is_Hidden", Flag57
(Id
));
7572 W
("Is_Hidden_Open_Scope", Flag171
(Id
));
7573 W
("Is_Immediately_Visible", Flag7
(Id
));
7574 W
("Is_Imported", Flag24
(Id
));
7575 W
("Is_Inlined", Flag11
(Id
));
7576 W
("Is_Instantiated", Flag126
(Id
));
7577 W
("Is_Interface", Flag186
(Id
));
7578 W
("Is_Internal", Flag17
(Id
));
7579 W
("Is_Interrupt_Handler", Flag89
(Id
));
7580 W
("Is_Intrinsic_Subprogram", Flag64
(Id
));
7581 W
("Is_Itype", Flag91
(Id
));
7582 W
("Is_Known_Non_Null", Flag37
(Id
));
7583 W
("Is_Known_Null", Flag204
(Id
));
7584 W
("Is_Known_Valid", Flag170
(Id
));
7585 W
("Is_Limited_Composite", Flag106
(Id
));
7586 W
("Is_Limited_Interface", Flag197
(Id
));
7587 W
("Is_Limited_Record", Flag25
(Id
));
7588 W
("Is_Machine_Code_Subprogram", Flag137
(Id
));
7589 W
("Is_Non_Static_Subtype", Flag109
(Id
));
7590 W
("Is_Null_Init_Proc", Flag178
(Id
));
7591 W
("Is_Obsolescent", Flag153
(Id
));
7592 W
("Is_Only_Out_Parameter", Flag226
(Id
));
7593 W
("Is_Optional_Parameter", Flag134
(Id
));
7594 W
("Is_Overriding_Operation", Flag39
(Id
));
7595 W
("Is_Package_Body_Entity", Flag160
(Id
));
7596 W
("Is_Packed", Flag51
(Id
));
7597 W
("Is_Packed_Array_Type", Flag138
(Id
));
7598 W
("Is_Potentially_Use_Visible", Flag9
(Id
));
7599 W
("Is_Preelaborated", Flag59
(Id
));
7600 W
("Is_Primitive_Wrapper", Flag195
(Id
));
7601 W
("Is_Private_Composite", Flag107
(Id
));
7602 W
("Is_Private_Descendant", Flag53
(Id
));
7603 W
("Is_Protected_Interface", Flag198
(Id
));
7604 W
("Is_Public", Flag10
(Id
));
7605 W
("Is_Pure", Flag44
(Id
));
7606 W
("Is_Pure_Unit_Access_Type", Flag189
(Id
));
7607 W
("Is_RACW_Stub_Type", Flag244
(Id
));
7608 W
("Is_Raised", Flag224
(Id
));
7609 W
("Is_Remote_Call_Interface", Flag62
(Id
));
7610 W
("Is_Remote_Types", Flag61
(Id
));
7611 W
("Is_Renaming_Of_Object", Flag112
(Id
));
7612 W
("Is_Return_Object", Flag209
(Id
));
7613 W
("Is_Shared_Passive", Flag60
(Id
));
7614 W
("Is_Synchronized_Interface", Flag199
(Id
));
7615 W
("Is_Statically_Allocated", Flag28
(Id
));
7616 W
("Is_Tag", Flag78
(Id
));
7617 W
("Is_Tagged_Type", Flag55
(Id
));
7618 W
("Is_Task_Interface", Flag200
(Id
));
7619 W
("Is_Thunk", Flag225
(Id
));
7620 W
("Is_Trivial_Subprogram", Flag235
(Id
));
7621 W
("Is_True_Constant", Flag163
(Id
));
7622 W
("Is_Unchecked_Union", Flag117
(Id
));
7623 W
("Is_Unsigned_Type", Flag144
(Id
));
7624 W
("Is_VMS_Exception", Flag133
(Id
));
7625 W
("Is_Valued_Procedure", Flag127
(Id
));
7626 W
("Is_Visible_Child_Unit", Flag116
(Id
));
7627 W
("Is_Visible_Formal", Flag206
(Id
));
7628 W
("Is_Volatile", Flag16
(Id
));
7629 W
("Itype_Printed", Flag202
(Id
));
7630 W
("Kill_Elaboration_Checks", Flag32
(Id
));
7631 W
("Kill_Range_Checks", Flag33
(Id
));
7632 W
("Kill_Tag_Checks", Flag34
(Id
));
7633 W
("Known_To_Have_Preelab_Init", Flag207
(Id
));
7634 W
("Low_Bound_Known", Flag205
(Id
));
7635 W
("Machine_Radix_10", Flag84
(Id
));
7636 W
("Materialize_Entity", Flag168
(Id
));
7637 W
("Must_Be_On_Byte_Boundary", Flag183
(Id
));
7638 W
("Must_Have_Preelab_Init", Flag208
(Id
));
7639 W
("Needs_Debug_Info", Flag147
(Id
));
7640 W
("Needs_No_Actuals", Flag22
(Id
));
7641 W
("Never_Set_In_Source", Flag115
(Id
));
7642 W
("No_Pool_Assigned", Flag131
(Id
));
7643 W
("No_Return", Flag113
(Id
));
7644 W
("No_Strict_Aliasing", Flag136
(Id
));
7645 W
("Non_Binary_Modulus", Flag58
(Id
));
7646 W
("Nonzero_Is_True", Flag162
(Id
));
7647 W
("OK_To_Reorder_Components", Flag239
(Id
));
7648 W
("Optimize_Alignment_Space", Flag241
(Id
));
7649 W
("Optimize_Alignment_Time", Flag242
(Id
));
7650 W
("Overlays_Constant", Flag243
(Id
));
7651 W
("Reachable", Flag49
(Id
));
7652 W
("Referenced", Flag156
(Id
));
7653 W
("Referenced_As_LHS", Flag36
(Id
));
7654 W
("Referenced_As_Out_Parameter", Flag227
(Id
));
7655 W
("Renamed_In_Spec", Flag231
(Id
));
7656 W
("Requires_Overriding", Flag213
(Id
));
7657 W
("Return_Present", Flag54
(Id
));
7658 W
("Returns_By_Ref", Flag90
(Id
));
7659 W
("Reverse_Bit_Order", Flag164
(Id
));
7660 W
("Sec_Stack_Needed_For_Return", Flag167
(Id
));
7661 W
("Size_Depends_On_Discriminant", Flag177
(Id
));
7662 W
("Size_Known_At_Compile_Time", Flag92
(Id
));
7663 W
("Static_Elaboration_Desired", Flag77
(Id
));
7664 W
("Strict_Alignment", Flag145
(Id
));
7665 W
("Suppress_Elaboration_Warnings", Flag148
(Id
));
7666 W
("Suppress_Init_Proc", Flag105
(Id
));
7667 W
("Suppress_Style_Checks", Flag165
(Id
));
7668 W
("Suppress_Value_Tracking_On_Call", Flag217
(Id
));
7669 W
("Is_Primitive", Flag218
(Id
));
7670 W
("Treat_As_Volatile", Flag41
(Id
));
7671 W
("Universal_Aliasing", Flag216
(Id
));
7672 W
("Used_As_Generic_Actual", Flag222
(Id
));
7673 W
("Uses_Sec_Stack", Flag95
(Id
));
7674 W
("Vax_Float", Flag151
(Id
));
7675 W
("Warnings_Off", Flag96
(Id
));
7676 W
("Warnings_Off_Used", Flag236
(Id
));
7677 W
("Warnings_Off_Used_Unmodified", Flag237
(Id
));
7678 W
("Warnings_Off_Used_Unreferenced", Flag238
(Id
));
7679 W
("Was_Hidden", Flag196
(Id
));
7680 end Write_Entity_Flags
;
7682 -----------------------
7683 -- Write_Entity_Info --
7684 -----------------------
7686 procedure Write_Entity_Info
(Id
: Entity_Id
; Prefix
: String) is
7688 procedure Write_Attribute
(Which
: String; Nam
: E
);
7689 -- Write attribute value with given string name
7691 procedure Write_Kind
(Id
: Entity_Id
);
7692 -- Write Ekind field of entity
7694 ---------------------
7695 -- Write_Attribute --
7696 ---------------------
7698 procedure Write_Attribute
(Which
: String; Nam
: E
) is
7702 Write_Int
(Int
(Nam
));
7704 Write_Name
(Chars
(Nam
));
7706 end Write_Attribute
;
7712 procedure Write_Kind
(Id
: Entity_Id
) is
7713 K
: constant String := Entity_Kind
'Image (Ekind
(Id
));
7717 Write_Str
(" Kind ");
7719 if Is_Type
(Id
) and then Is_Tagged_Type
(Id
) then
7720 Write_Str
("TAGGED ");
7723 Write_Str
(K
(3 .. K
'Length));
7726 if Is_Type
(Id
) and then Depends_On_Private
(Id
) then
7727 Write_Str
("Depends_On_Private ");
7731 -- Start of processing for Write_Entity_Info
7735 Write_Attribute
("Name ", Id
);
7736 Write_Int
(Int
(Id
));
7740 Write_Attribute
(" Type ", Etype
(Id
));
7742 Write_Attribute
(" Scope ", Scope
(Id
));
7747 when Discrete_Kind
=>
7748 Write_Str
("Bounds: Id = ");
7750 if Present
(Scalar_Range
(Id
)) then
7751 Write_Int
(Int
(Type_Low_Bound
(Id
)));
7752 Write_Str
(" .. Id = ");
7753 Write_Int
(Int
(Type_High_Bound
(Id
)));
7755 Write_Str
("Empty");
7766 (" Component Type ", Component_Type
(Id
));
7769 Write_Str
(" Indices ");
7771 Index
:= First_Index
(Id
);
7772 while Present
(Index
) loop
7773 Write_Attribute
(" ", Etype
(Index
));
7774 Index
:= Next_Index
(Index
);
7782 (" Directly Designated Type ",
7783 Directly_Designated_Type
(Id
));
7786 when Overloadable_Kind
=>
7787 if Present
(Homonym
(Id
)) then
7788 Write_Str
(" Homonym ");
7789 Write_Name
(Chars
(Homonym
(Id
)));
7791 Write_Int
(Int
(Homonym
(Id
)));
7798 if Ekind
(Scope
(Id
)) in Record_Kind
then
7800 " Original_Record_Component ",
7801 Original_Record_Component
(Id
));
7802 Write_Int
(Int
(Original_Record_Component
(Id
)));
7806 when others => null;
7808 end Write_Entity_Info
;
7810 -----------------------
7811 -- Write_Field6_Name --
7812 -----------------------
7814 procedure Write_Field6_Name
(Id
: Entity_Id
) is
7815 pragma Warnings
(Off
, Id
);
7817 Write_Str
("First_Rep_Item");
7818 end Write_Field6_Name
;
7820 -----------------------
7821 -- Write_Field7_Name --
7822 -----------------------
7824 procedure Write_Field7_Name
(Id
: Entity_Id
) is
7825 pragma Warnings
(Off
, Id
);
7827 Write_Str
("Freeze_Node");
7828 end Write_Field7_Name
;
7830 -----------------------
7831 -- Write_Field8_Name --
7832 -----------------------
7834 procedure Write_Field8_Name
(Id
: Entity_Id
) is
7839 Write_Str
("Normalized_First_Bit");
7843 E_Subprogram_Body
=>
7844 Write_Str
("Mechanism");
7847 Write_Str
("Associated_Node_For_Itype");
7850 Write_Str
("Dependent_Instances");
7852 when E_Return_Statement
=>
7853 Write_Str
("Return_Applies_To");
7856 Write_Str
("Hiding_Loop_Variable");
7859 Write_Str
("Field8??");
7861 end Write_Field8_Name
;
7863 -----------------------
7864 -- Write_Field9_Name --
7865 -----------------------
7867 procedure Write_Field9_Name
(Id
: Entity_Id
) is
7871 Write_Str
("Class_Wide_Type");
7874 E_Generic_Function |
7876 E_Generic_Procedure |
7879 Write_Str
("Renaming_Map");
7882 Write_Str
("Current_Value");
7885 Write_Str
("Field9??");
7887 end Write_Field9_Name
;
7889 ------------------------
7890 -- Write_Field10_Name --
7891 ------------------------
7893 procedure Write_Field10_Name
(Id
: Entity_Id
) is
7897 Write_Str
("Referenced_Object");
7899 when E_In_Parameter |
7901 Write_Str
("Discriminal_Link");
7907 Write_Str
("Handler_Records");
7911 Write_Str
("Normalized_Position_Max");
7914 Write_Str
("Field10??");
7916 end Write_Field10_Name
;
7918 ------------------------
7919 -- Write_Field11_Name --
7920 ------------------------
7922 procedure Write_Field11_Name
(Id
: Entity_Id
) is
7926 Write_Str
("Entry_Component");
7930 Write_Str
("Component_Bit_Offset");
7933 Write_Str
("Full_View");
7935 when E_Enumeration_Literal
=>
7936 Write_Str
("Enumeration_Pos");
7939 Write_Str
("Block_Node");
7945 Write_Str
("Protected_Body_Subprogram");
7947 when E_Generic_Package
=>
7948 Write_Str
("Generic_Homonym");
7951 Write_Str
("Full_View");
7954 Write_Str
("Field11??");
7956 end Write_Field11_Name
;
7958 ------------------------
7959 -- Write_Field12_Name --
7960 ------------------------
7962 procedure Write_Field12_Name
(Id
: Entity_Id
) is
7966 Write_Str
("Barrier_Function");
7968 when E_Enumeration_Literal
=>
7969 Write_Str
("Enumeration_Rep");
7977 E_In_Out_Parameter |
7981 Write_Str
("Esize");
7985 Write_Str
("Next_Inlined_Subprogram");
7988 Write_Str
("Associated_Formal_Package");
7991 Write_Str
("Field12??");
7993 end Write_Field12_Name
;
7995 ------------------------
7996 -- Write_Field13_Name --
7997 ------------------------
7999 procedure Write_Field13_Name
(Id
: Entity_Id
) is
8003 Write_Str
("RM_Size");
8007 Write_Str
("Component_Clause");
8010 if not Comes_From_Source
(Id
)
8012 Chars
(Id
) = Name_Op_Ne
8014 Write_Str
("Corresponding_Equality");
8016 elsif Comes_From_Source
(Id
) then
8017 Write_Str
("Elaboration_Entity");
8020 Write_Str
("Field13??");
8025 Write_Str
("Extra_Accessibility");
8029 Generic_Unit_Kind
=>
8030 Write_Str
("Elaboration_Entity");
8033 Write_Str
("Field13??");
8035 end Write_Field13_Name
;
8037 -----------------------
8038 -- Write_Field14_Name --
8039 -----------------------
8041 procedure Write_Field14_Name
(Id
: Entity_Id
) is
8050 Write_Str
("Alignment");
8054 Write_Str
("Normalized_Position");
8058 Write_Str
("First_Optional_Parameter");
8061 E_Generic_Package
=>
8062 Write_Str
("Shadow_Entities");
8065 Write_Str
("Field14??");
8067 end Write_Field14_Name
;
8069 ------------------------
8070 -- Write_Field15_Name --
8071 ------------------------
8073 procedure Write_Field15_Name
(Id
: Entity_Id
) is
8078 Write_Str
("Storage_Size_Variable");
8080 when Class_Wide_Kind |
8084 Write_Str
("Primitive_Operations");
8087 Write_Str
("DT_Entry_Count");
8089 when Decimal_Fixed_Point_Kind
=>
8090 Write_Str
("Scale_Value");
8092 when E_Discriminant
=>
8093 Write_Str
("Discriminant_Number");
8096 Write_Str
("Extra_Formal");
8100 Write_Str
("DT_Position");
8103 Write_Str
("Entry_Parameters_Type");
8105 when Enumeration_Kind
=>
8106 Write_Str
("Lit_Indexes");
8110 Write_Str
("Related_Instance");
8112 when E_Protected_Type
=>
8113 Write_Str
("Entry_Bodies_Array");
8115 when E_String_Literal_Subtype
=>
8116 Write_Str
("String_Literal_Low_Bound");
8119 Write_Str
("Field15??");
8121 end Write_Field15_Name
;
8123 ------------------------
8124 -- Write_Field16_Name --
8125 ------------------------
8127 procedure Write_Field16_Name
(Id
: Entity_Id
) is
8131 Write_Str
("Entry_Formal");
8135 Write_Str
("DTC_Entity");
8140 Write_Str
("First_Private_Entity");
8142 when E_Record_Type |
8143 E_Record_Type_With_Private
=>
8144 Write_Str
("Access_Disp_Table");
8146 when E_String_Literal_Subtype
=>
8147 Write_Str
("String_Literal_Length");
8149 when Enumeration_Kind
=>
8150 Write_Str
("Lit_Strings");
8154 Write_Str
("Unset_Reference");
8156 when E_Record_Subtype |
8157 E_Class_Wide_Subtype
=>
8158 Write_Str
("Cloned_Subtype");
8161 Write_Str
("Field16??");
8163 end Write_Field16_Name
;
8165 ------------------------
8166 -- Write_Field17_Name --
8167 ------------------------
8169 procedure Write_Field17_Name
(Id
: Entity_Id
) is
8173 Write_Str
("Digits_Value");
8176 Write_Str
("Prival");
8178 when E_Discriminant
=>
8179 Write_Str
("Discriminal");
8188 E_Generic_Function |
8190 E_Generic_Procedure |
8198 E_Return_Statement |
8200 E_Subprogram_Type
=>
8201 Write_Str
("First_Entity");
8204 Write_Str
("First_Index");
8206 when Enumeration_Kind
=>
8207 Write_Str
("First_Literal");
8210 Write_Str
("Master_Id");
8212 when Modular_Integer_Kind
=>
8213 Write_Str
("Modulus");
8217 E_Generic_In_Out_Parameter |
8219 Write_Str
("Actual_Subtype");
8221 when E_Incomplete_Type
=>
8222 Write_Str
("Non_Limited_View");
8224 when E_Incomplete_Subtype
=>
8225 if From_With_Type
(Id
) then
8226 Write_Str
("Non_Limited_View");
8230 Write_Str
("Field17??");
8232 end Write_Field17_Name
;
8234 ------------------------
8235 -- Write_Field18_Name --
8236 ------------------------
8238 procedure Write_Field18_Name
(Id
: Entity_Id
) is
8241 when E_Enumeration_Literal |
8245 Write_Str
("Alias");
8247 when E_Record_Type
=>
8248 Write_Str
("Corresponding_Concurrent_Type");
8250 when E_Entry_Index_Parameter
=>
8251 Write_Str
("Entry_Index_Constant");
8253 when E_Class_Wide_Subtype |
8254 E_Access_Protected_Subprogram_Type |
8255 E_Anonymous_Access_Protected_Subprogram_Type |
8256 E_Access_Subprogram_Type |
8258 Write_Str
("Equivalent_Type");
8260 when Fixed_Point_Kind
=>
8261 Write_Str
("Delta_Value");
8264 Write_Str
("Renamed_Object");
8268 E_Generic_Function |
8269 E_Generic_Procedure |
8270 E_Generic_Package
=>
8271 Write_Str
("Renamed_Entity");
8273 when Incomplete_Or_Private_Kind
=>
8274 Write_Str
("Private_Dependents");
8276 when Concurrent_Kind
=>
8277 Write_Str
("Corresponding_Record_Type");
8282 Write_Str
("Enclosing_Scope");
8285 Write_Str
("Field18??");
8287 end Write_Field18_Name
;
8289 -----------------------
8290 -- Write_Field19_Name --
8291 -----------------------
8293 procedure Write_Field19_Name
(Id
: Entity_Id
) is
8298 Write_Str
("Related_Array_Object");
8304 E_Return_Statement |
8306 Write_Str
("Finalization_Chain_Entity");
8308 when E_Constant | E_Variable
=>
8309 Write_Str
("Size_Check_Code");
8311 when E_Discriminant
=>
8312 Write_Str
("Corresponding_Discriminant");
8315 E_Generic_Package
=>
8316 Write_Str
("Body_Entity");
8318 when E_Package_Body |
8320 Write_Str
("Spec_Entity");
8322 when Private_Kind
=>
8323 Write_Str
("Underlying_Full_View");
8325 when E_Record_Type
=>
8326 Write_Str
("Parent_Subtype");
8329 Write_Str
("Field19??");
8331 end Write_Field19_Name
;
8333 -----------------------
8334 -- Write_Field20_Name --
8335 -----------------------
8337 procedure Write_Field20_Name
(Id
: Entity_Id
) is
8341 Write_Str
("Component_Type");
8343 when E_In_Parameter |
8344 E_Generic_In_Parameter
=>
8345 Write_Str
("Default_Value");
8348 Write_Str
("Directly_Designated_Type");
8351 Write_Str
("Discriminant_Checking_Func");
8355 Write_Str
("Prival_Link");
8357 when E_Discriminant
=>
8358 Write_Str
("Discriminant_Default_Value");
8367 E_Generic_Function |
8369 E_Generic_Procedure |
8377 E_Return_Statement |
8379 E_Subprogram_Type
=>
8381 Write_Str
("Last_Entity");
8384 Write_Str
("Scalar_Range");
8387 Write_Str
("Register_Exception_Call");
8390 Write_Str
("Field20??");
8392 end Write_Field20_Name
;
8394 -----------------------
8395 -- Write_Field21_Name --
8396 -----------------------
8398 procedure Write_Field21_Name
(Id
: Entity_Id
) is
8404 E_Generic_Function |
8406 E_Generic_Procedure |
8408 Write_Str
("Interface_Name");
8410 when Concurrent_Kind |
8411 Incomplete_Or_Private_Kind |
8415 Write_Str
("Discriminant_Constraint");
8418 Write_Str
("Accept_Address");
8420 when Fixed_Point_Kind
=>
8421 Write_Str
("Small_Value");
8423 when E_In_Parameter
=>
8424 Write_Str
("Default_Expr_Function");
8427 Modular_Integer_Kind
=>
8428 Write_Str
("Original_Array_Type");
8431 Write_Str
("Field21??");
8433 end Write_Field21_Name
;
8435 -----------------------
8436 -- Write_Field22_Name --
8437 -----------------------
8439 procedure Write_Field22_Name
(Id
: Entity_Id
) is
8443 Write_Str
("Associated_Storage_Pool");
8446 Write_Str
("Component_Size");
8450 Write_Str
("Original_Record_Component");
8452 when E_Enumeration_Literal
=>
8453 Write_Str
("Enumeration_Rep_Expr");
8456 Write_Str
("Exception_Code");
8459 Write_Str
("Protected_Formal");
8461 when E_Record_Type
=>
8462 Write_Str
("Corresponding_Remote_Type");
8472 E_Generic_Function |
8473 E_Generic_Procedure |
8476 E_Return_Statement |
8479 Write_Str
("Scope_Depth_Value");
8481 when E_Record_Type_With_Private |
8482 E_Record_Subtype_With_Private |
8485 E_Limited_Private_Type |
8486 E_Limited_Private_Subtype
=>
8487 Write_Str
("Private_View");
8490 Write_Str
("Shared_Var_Procs_Instance");
8493 Write_Str
("Field22??");
8495 end Write_Field22_Name
;
8497 ------------------------
8498 -- Write_Field23_Name --
8499 ------------------------
8501 procedure Write_Field23_Name
(Id
: Entity_Id
) is
8505 Write_Str
("Associated_Final_Chain");
8508 Write_Str
("Packed_Array_Type");
8511 Write_Str
("Entry_Cancel_Parameter");
8513 when E_Discriminant
=>
8514 Write_Str
("CR_Discriminant");
8516 when E_Enumeration_Type
=>
8517 Write_Str
("Enum_Pos_To_Rep");
8521 Write_Str
("Extra_Constrained");
8523 when E_Generic_Function |
8525 E_Generic_Procedure
=>
8526 Write_Str
("Inner_Instances");
8528 when Concurrent_Kind |
8529 Incomplete_Or_Private_Kind |
8533 Write_Str
("Stored_Constraint");
8537 if Present
(Scope
(Id
))
8538 and then Is_Protected_Type
(Scope
(Id
))
8540 Write_Str
("Protection_Object");
8542 Write_Str
("Generic_Renamings");
8546 if Is_Generic_Instance
(Id
) then
8547 Write_Str
("Generic_Renamings");
8549 Write_Str
("Limited_View");
8553 Write_Str
("Protection_Object");
8556 Write_Str
("Field23??");
8558 end Write_Field23_Name
;
8560 ------------------------
8561 -- Write_Field24_Name --
8562 ------------------------
8564 procedure Write_Field24_Name
(Id
: Entity_Id
) is
8567 when Subprogram_Kind
=>
8568 Write_Str
("Spec_PPC_List");
8573 end Write_Field24_Name
;
8575 ------------------------
8576 -- Write_Field25_Name --
8577 ------------------------
8579 procedure Write_Field25_Name
(Id
: Entity_Id
) is
8583 Write_Str
("DT_Offset_To_Top_Func");
8587 Write_Str
("Interface_Alias");
8589 when E_Record_Type |
8591 E_Record_Type_With_Private |
8592 E_Record_Subtype_With_Private
=>
8593 Write_Str
("Interfaces");
8596 Write_Str
("Task_Body_Procedure");
8599 Write_Str
("Debug_Renaming_Link");
8602 Write_Str
("Field25??");
8604 end Write_Field25_Name
;
8606 ------------------------
8607 -- Write_Field26_Name --
8608 ------------------------
8610 procedure Write_Field26_Name
(Id
: Entity_Id
) is
8615 Write_Str
("Related_Type");
8617 when E_Generic_Package |
8619 Write_Str
("Package_Instantiation");
8624 if Is_Dispatching_Operation
(Id
) then
8625 Write_Str
("Overridden_Operation");
8627 Write_Str
("Static_Initialization");
8630 when E_Record_Type |
8631 E_Record_Type_With_Private
=>
8632 Write_Str
("Dispatch_Table_Wrapper");
8634 when E_In_Out_Parameter |
8637 Write_Str
("Last_Assignment");
8640 Write_Str
("Relative_Deadline_Variable");
8643 Write_Str
("Field26??");
8645 end Write_Field26_Name
;
8647 ------------------------
8648 -- Write_Field27_Name --
8649 ------------------------
8651 procedure Write_Field27_Name
(Id
: Entity_Id
) is
8655 Write_Str
("Wrapped_Entity");
8657 when E_Package | Type_Kind
=>
8658 Write_Str
("Current_Use_Clause");
8661 Write_Str
("Field27??");
8663 end Write_Field27_Name
;
8665 ------------------------
8666 -- Write_Field28_Name --
8667 ------------------------
8669 procedure Write_Field28_Name
(Id
: Entity_Id
) is
8672 when E_Procedure | E_Function | E_Entry
=>
8673 Write_Str
("Extra_Formals");
8676 Write_Str
("Field28??");
8678 end Write_Field28_Name
;
8680 -------------------------
8681 -- Iterator Procedures --
8682 -------------------------
8684 procedure Proc_Next_Component
(N
: in out Node_Id
) is
8686 N
:= Next_Component
(N
);
8687 end Proc_Next_Component
;
8689 procedure Proc_Next_Component_Or_Discriminant
(N
: in out Node_Id
) is
8691 N
:= Next_Entity
(N
);
8692 while Present
(N
) loop
8693 exit when Ekind
(N
) = E_Component
8695 Ekind
(N
) = E_Discriminant
;
8696 N
:= Next_Entity
(N
);
8698 end Proc_Next_Component_Or_Discriminant
;
8700 procedure Proc_Next_Discriminant
(N
: in out Node_Id
) is
8702 N
:= Next_Discriminant
(N
);
8703 end Proc_Next_Discriminant
;
8705 procedure Proc_Next_Formal
(N
: in out Node_Id
) is
8707 N
:= Next_Formal
(N
);
8708 end Proc_Next_Formal
;
8710 procedure Proc_Next_Formal_With_Extras
(N
: in out Node_Id
) is
8712 N
:= Next_Formal_With_Extras
(N
);
8713 end Proc_Next_Formal_With_Extras
;
8715 procedure Proc_Next_Index
(N
: in out Node_Id
) is
8717 N
:= Next_Index
(N
);
8718 end Proc_Next_Index
;
8720 procedure Proc_Next_Inlined_Subprogram
(N
: in out Node_Id
) is
8722 N
:= Next_Inlined_Subprogram
(N
);
8723 end Proc_Next_Inlined_Subprogram
;
8725 procedure Proc_Next_Literal
(N
: in out Node_Id
) is
8727 N
:= Next_Literal
(N
);
8728 end Proc_Next_Literal
;
8730 procedure Proc_Next_Stored_Discriminant
(N
: in out Node_Id
) is
8732 N
:= Next_Stored_Discriminant
(N
);
8733 end Proc_Next_Stored_Discriminant
;