1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 pragma Style_Checks
(All_Checks
);
37 -- Turn off subprogram ordering, not used for this unit
39 with Atree
; use Atree
;
40 with Namet
; use Namet
;
41 with Nlists
; use Nlists
;
42 with Sinfo
; use Sinfo
;
43 with Snames
; use Snames
;
44 with Stand
; use Stand
;
45 with Output
; use Output
;
49 use Atree
.Unchecked_Access
;
50 -- This is one of the packages that is allowed direct untyped access to
51 -- the fields in a node, since it provides the next level abstraction
52 -- which incorporates appropriate checks.
54 ----------------------------------------------
55 -- Usage of Fields in Defining Entity Nodes --
56 ----------------------------------------------
58 -- Four of these fields are defined in Sinfo, since they in are the
59 -- base part of the node. The access routines for these fields and
60 -- the corresponding set procedures are defined in Sinfo. These fields
61 -- are present in all entities.
68 -- The fifth field is also in the base part of the node, but it
69 -- carries some additional semantic checks and its subprograms are
70 -- more properly defined in Einfo.
74 -- Remaining fields are present only in extended nodes (i.e. entities)
76 -- The following fields are present in all entities
78 -- First_Rep_Item Node6
81 -- The usage of each field (and the entity kinds to which it applies)
82 -- depends on the particular field (see Einfo spec for details).
84 -- Associated_Node_For_Itype Node8
85 -- Dependent_Instances Elist8
86 -- Hiding_Loop_Variable Node8
87 -- Mechanism Uint8 (but returns Mechanism_Type)
88 -- Normalized_First_Bit Uint8
90 -- Class_Wide_Type Node9
91 -- Normalized_Position Uint9
92 -- Size_Check_Code Node9
95 -- Discriminal_Link Node10
96 -- Handler_Records List10
97 -- Normalized_Position_Max Uint10
98 -- Referenced_Object Node10
100 -- Component_Bit_Offset Uint11
102 -- Entry_Component Node11
103 -- Enumeration_Pos Uint11
104 -- Protected_Body_Subprogram Node11
107 -- Barrier_Function Node12
108 -- Enumeration_Rep Uint12
110 -- Next_Inlined_Subprogram Node12
112 -- Corresponding_Equality Node13
113 -- Component_Clause Node13
114 -- Debug_Renaming_Link Node13
115 -- Elaboration_Entity Node13
116 -- Extra_Accessibility Node13
120 -- First_Optional_Parameter Node14
121 -- Shadow_Entities List14
123 -- Discriminant_Number Uint15
124 -- DT_Position Uint15
125 -- DT_Entry_Count Uint15
126 -- Entry_Bodies_Array Node15
127 -- Entry_Parameters_Type Node15
128 -- Extra_Formal Node15
129 -- Lit_Indexes Node15
130 -- Primitive_Operations Elist15
131 -- Related_Instance Node15
132 -- Scale_Value Uint15
133 -- Storage_Size_Variable Node15
134 -- String_Literal_Low_Bound Node15
135 -- Shared_Var_Read_Proc Node15
137 -- Access_Disp_Table Node16
138 -- Cloned_Subtype Node16
140 -- Entry_Formal Node16
141 -- First_Private_Entity Node16
142 -- Lit_Strings Node16
143 -- String_Literal_Length Uint16
144 -- Unset_Reference Node16
146 -- Actual_Subtype Node17
147 -- Digits_Value Uint17
148 -- Discriminal Node17
149 -- First_Entity Node17
150 -- First_Index Node17
151 -- First_Literal Node17
158 -- Corresponding_Concurrent_Type Node18
159 -- Corresponding_Record_Type Node18
160 -- Delta_Value Ureal18
161 -- Enclosing_Scope Node18
162 -- Equivalent_Type Node18
163 -- Private_Dependents Elist18
164 -- Renamed_Entity Node18
165 -- Renamed_Object Node18
167 -- Body_Entity Node19
168 -- Corresponding_Discriminant Node19
169 -- Finalization_Chain_Entity Node19
170 -- Parent_Subtype Node19
171 -- Related_Array_Object Node19
172 -- Spec_Entity Node19
173 -- Underlying_Full_View Node19
175 -- Component_Type Node20
176 -- Default_Value Node20
177 -- Directly_Designated_Type Node20
178 -- Discriminant_Checking_Func Node20
179 -- Discriminant_Default_Value Node20
180 -- Last_Entity Node20
181 -- Register_Exception_Call Node20
182 -- Scalar_Range Node20
184 -- Accept_Address Elist21
185 -- Default_Expr_Function Node21
186 -- Discriminant_Constraint Elist21
187 -- Small_Value Ureal21
188 -- Interface_Name Node21
190 -- Associated_Storage_Pool Node22
191 -- Component_Size Uint22
192 -- Corresponding_Remote_Type Node22
193 -- Enumeration_Rep_Expr Node22
194 -- Exception_Code Uint22
195 -- Original_Record_Component Node22
196 -- Private_View Node22
197 -- Protected_Formal Node22
198 -- Scope_Depth_Value Uint22
199 -- Shared_Var_Assign_Proc Node22
201 -- Associated_Final_Chain Node23
202 -- CR_Discriminant Node23
203 -- Girder_Constraint Elist23
204 -- Entry_Cancel_Parameter Node23
205 -- Extra_Constrained Node23
206 -- Generic_Renamings Elist23
207 -- Inner_Instances Elist23
208 -- Enum_Pos_To_Rep Node23
209 -- Packed_Array_Type Node23
210 -- Privals_Chain Elist23
211 -- Protected_Operation Node23
213 ---------------------------------------------
214 -- Usage of Flags in Defining Entity Nodes --
215 ---------------------------------------------
217 -- All flags are unique, there is no overlaying, so each flag is physically
218 -- present in every entity. However, for many of the flags, it only makes
219 -- sense for them to be set true for certain subsets of entity kinds. See
220 -- the spec of Einfo for further details.
222 -- Note: Flag1-Flag3 are absent from this list, since these flag positions
223 -- are used for the flags Analyzed, Comes_From_Source, and Error_Posted,
224 -- which are common to all nodes, including entity nodes.
227 -- Has_Discriminants Flag5
228 -- Is_Dispatching_Operation Flag6
229 -- Is_Immediately_Visible Flag7
231 -- Is_Potentially_Use_Visible Flag9
234 -- Is_Constrained Flag12
235 -- Is_Generic_Type Flag13
236 -- Depends_On_Private Flag14
238 -- Is_Volatile Flag16
239 -- Is_Internal Flag17
240 -- Has_Delayed_Freeze Flag18
241 -- Is_Abstract Flag19
242 -- Is_Concurrent_Record_Type Flag20
243 -- Has_Master_Entity Flag21
244 -- Needs_No_Actuals Flag22
245 -- Has_Storage_Size_Clause Flag23
246 -- Is_Imported Flag24
247 -- Is_Limited_Record Flag25
248 -- Has_Completion Flag26
249 -- Has_Pragma_Controlled Flag27
250 -- Is_Statically_Allocated Flag28
251 -- Has_Size_Clause Flag29
253 -- Suppress_Access_Checks Flag31
254 -- Suppress_Accessibility_Checks Flag32
255 -- Suppress_Discriminant_Checks Flag33
256 -- Suppress_Division_Checks Flag34
257 -- Suppress_Elaboration_Checks Flag35
258 -- Suppress_Index_Checks Flag36
259 -- Suppress_Length_Checks Flag37
260 -- Suppress_Overflow_Checks Flag38
261 -- Suppress_Range_Checks Flag39
262 -- Suppress_Storage_Checks Flag40
263 -- Suppress_Tag_Checks Flag41
264 -- Is_Controlled Flag42
265 -- Has_Controlled_Component Flag43
267 -- In_Private_Part Flag45
268 -- Has_Alignment_Clause Flag46
270 -- In_Package_Body Flag48
272 -- Delay_Subprogram_Descriptors Flag50
274 -- Is_Entry_Formal Flag52
275 -- Is_Private_Descendant Flag53
276 -- Return_Present Flag54
277 -- Is_Tagged_Type Flag55
278 -- Has_Homonym Flag56
280 -- Non_Binary_Modulus Flag58
281 -- Is_Preelaborated Flag59
282 -- Is_Shared_Passive Flag60
283 -- Is_Remote_Types Flag61
284 -- Is_Remote_Call_Interface Flag62
285 -- Is_Character_Type Flag63
286 -- Is_Intrinsic_Subprogram Flag64
287 -- Has_Record_Rep_Clause Flag65
288 -- Has_Enumeration_Rep_Clause Flag66
289 -- Has_Small_Clause Flag67
290 -- Has_Component_Size_Clause Flag68
291 -- Is_Access_Constant Flag69
292 -- Is_First_Subtype Flag70
293 -- Has_Completion_In_Body Flag71
294 -- Has_Unknown_Discriminants Flag72
295 -- Is_Child_Unit Flag73
296 -- Is_CPP_Class Flag74
297 -- Has_Non_Standard_Rep Flag75
298 -- Is_Constructor Flag76
299 -- Is_Destructor Flag77
301 -- Has_All_Calls_Remote Flag79
302 -- Is_Constr_Subt_For_U_Nominal Flag80
303 -- Is_Asynchronous Flag81
304 -- Has_Gigi_Rep_Item Flag82
305 -- Has_Machine_Radix_Clause Flag83
306 -- Machine_Radix_10 Flag84
308 -- Has_Atomic_Components Flag86
309 -- Has_Volatile_Components Flag87
310 -- Discard_Names Flag88
311 -- Is_Interrupt_Handler Flag89
312 -- Returns_By_Ref Flag90
314 -- Size_Known_At_Compile_Time Flag92
315 -- Has_Subprogram_Descriptor Flag93
316 -- Is_Generic_Actual_Type Flag94
317 -- Uses_Sec_Stack Flag95
318 -- Warnings_Off Flag96
319 -- Is_Controlling_Formal Flag97
320 -- Has_Controlling_Result Flag98
321 -- Is_Exported Flag99
322 -- Has_Specified_Layout Flag100
323 -- Has_Nested_Block_With_Handler Flag101
325 -- Is_Completely_Hidden Flag103
326 -- Address_Taken Flag104
327 -- Suppress_Init_Proc Flag105
328 -- Is_Limited_Composite Flag106
329 -- Is_Private_Composite Flag107
330 -- Default_Expressions_Processed Flag108
331 -- Is_Non_Static_Subtype Flag109
332 -- Has_External_Tag_Rep_Clause Flag110
333 -- Is_Formal_Subprogram Flag111
334 -- Is_Renaming_Of_Object Flag112
336 -- Delay_Cleanups Flag114
337 -- Not_Source_Assigned Flag115
338 -- Is_Visible_Child_Unit Flag116
339 -- Is_Unchecked_Union Flag117
340 -- Is_For_Access_Subtype Flag118
341 -- Has_Convention_Pragma Flag119
342 -- Has_Primitive_Operations Flag120
343 -- Has_Pragma_Pack Flag121
344 -- Is_Bit_Packed_Array Flag122
345 -- Has_Unchecked_Union Flag123
346 -- Is_Eliminated Flag124
347 -- C_Pass_By_Copy Flag125
348 -- Is_Instantiated Flag126
349 -- Is_Valued_Procedure Flag127
350 -- (used for Component_Alignment) Flag128
351 -- (used for Component_Alignment) Flag129
352 -- Is_Generic_Instance Flag130
353 -- No_Pool_Assigned Flag131
354 -- Is_AST_Entry Flag132
355 -- Is_VMS_Exception Flag133
356 -- Is_Optional_Parameter Flag134
357 -- Has_Aliased_Components Flag135
358 -- Is_Machine_Code_Subprogram Flag137
359 -- Is_Packed_Array_Type Flag138
360 -- Has_Biased_Representation Flag139
361 -- Has_Complex_Representation Flag140
362 -- Is_Constr_Subt_For_UN_Aliased Flag141
363 -- Has_Missing_Return Flag142
364 -- Has_Recursive_Call Flag143
365 -- Is_Unsigned_Type Flag144
366 -- Strict_Alignment Flag145
367 -- Elaborate_All_Desirable Flag146
368 -- Needs_Debug_Info Flag147
369 -- Suppress_Elaboration_Warnings Flag148
370 -- Is_Compilation_Unit Flag149
371 -- Has_Pragma_Elaborate_Body Flag150
373 -- Entry_Accepted Flag152
374 -- Is_Psected Flag153
375 -- Has_Per_Object_Constraint Flag154
376 -- Has_Private_Declaration Flag155
377 -- Referenced Flag156
378 -- Has_Pragma_Inline Flag157
379 -- Finalize_Storage_Only Flag158
380 -- From_With_Type Flag159
381 -- Is_Package_Body_Entity Flag160
382 -- Has_Qualified_Name Flag161
383 -- Nonzero_Is_True Flag162
384 -- Is_True_Constant Flag163
385 -- Reverse_Bit_Order Flag164
386 -- Suppress_Style_Checks Flag165
387 -- Debug_Info_Off Flag166
388 -- Sec_Stack_Needed_For_Return Flag167
389 -- Materialize_Entity Flag168
390 -- Function_Returns_With_DSP Flag169
391 -- Is_Known_Valid Flag170
392 -- Is_Hidden_Open_Scope Flag171
393 -- Has_Object_Size_Clause Flag172
394 -- Has_Fully_Qualified_Name Flag173
395 -- Elaboration_Entity_Required Flag174
396 -- Has_Forward_Instantiation Flag175
397 -- Is_Discrim_SO_Function Flag176
398 -- Size_Depends_On_Discriminant Flag177
399 -- Is_Null_Init_Proc Flag178
407 --------------------------------
408 -- Attribute Access Functions --
409 --------------------------------
411 function Accept_Address
(Id
: E
) return L
is
416 function Access_Disp_Table
(Id
: E
) return E
is
418 pragma Assert
(Is_Tagged_Type
(Id
));
419 return Node16
(Base_Type
(Underlying_Type
(Base_Type
(Id
))));
420 end Access_Disp_Table
;
422 function Actual_Subtype
(Id
: E
) return E
is
425 (Ekind
(Id
) = E_Constant
426 or else Ekind
(Id
) = E_Variable
427 or else Ekind
(Id
) = E_Generic_In_Out_Parameter
428 or else Ekind
(Id
) in E_In_Parameter
.. E_In_Out_Parameter
);
432 function Address_Taken
(Id
: E
) return B
is
437 function Alias
(Id
: E
) return E
is
440 (Is_Overloadable
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
444 function Alignment
(Id
: E
) return U
is
449 function Associated_Final_Chain
(Id
: E
) return E
is
451 pragma Assert
(Is_Access_Type
(Id
));
453 end Associated_Final_Chain
;
455 function Associated_Formal_Package
(Id
: E
) return E
is
457 pragma Assert
(Ekind
(Id
) = E_Package
);
459 end Associated_Formal_Package
;
461 function Associated_Node_For_Itype
(Id
: E
) return N
is
464 end Associated_Node_For_Itype
;
466 function Associated_Storage_Pool
(Id
: E
) return E
is
468 pragma Assert
(Is_Access_Type
(Id
));
470 end Associated_Storage_Pool
;
472 function Barrier_Function
(Id
: E
) return N
is
474 pragma Assert
(Is_Entry
(Id
));
476 end Barrier_Function
;
478 function Block_Node
(Id
: E
) return N
is
480 pragma Assert
(Ekind
(Id
) = E_Block
);
484 function Body_Entity
(Id
: E
) return E
is
487 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
491 function C_Pass_By_Copy
(Id
: E
) return B
is
493 pragma Assert
(Is_Record_Type
(Id
));
494 return Flag125
(Implementation_Base_Type
(Id
));
497 function Class_Wide_Type
(Id
: E
) return E
is
499 pragma Assert
(Is_Type
(Id
));
503 function Cloned_Subtype
(Id
: E
) return E
is
506 (Ekind
(Id
) = E_Record_Subtype
507 or else Ekind
(Id
) = E_Class_Wide_Subtype
);
511 function Component_Bit_Offset
(Id
: E
) return U
is
514 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
516 end Component_Bit_Offset
;
518 function Component_Clause
(Id
: E
) return N
is
521 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
523 end Component_Clause
;
525 function Component_Size
(Id
: E
) return U
is
527 pragma Assert
(Is_Array_Type
(Id
));
528 return Uint22
(Implementation_Base_Type
(Id
));
531 function Component_Type
(Id
: E
) return E
is
533 return Node20
(Implementation_Base_Type
(Id
));
536 function Corresponding_Concurrent_Type
(Id
: E
) return E
is
538 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
540 end Corresponding_Concurrent_Type
;
542 function Corresponding_Discriminant
(Id
: E
) return E
is
544 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
546 end Corresponding_Discriminant
;
548 function Corresponding_Equality
(Id
: E
) return E
is
551 (Ekind
(Id
) = E_Function
552 and then not Comes_From_Source
(Id
)
553 and then Chars
(Id
) = Name_Op_Ne
);
555 end Corresponding_Equality
;
557 function Corresponding_Record_Type
(Id
: E
) return E
is
559 pragma Assert
(Is_Concurrent_Type
(Id
));
561 end Corresponding_Record_Type
;
563 function Corresponding_Remote_Type
(Id
: E
) return E
is
566 end Corresponding_Remote_Type
;
568 function CR_Discriminant
(Id
: E
) return E
is
573 function Debug_Info_Off
(Id
: E
) return B
is
578 function Debug_Renaming_Link
(Id
: E
) return E
is
581 end Debug_Renaming_Link
;
583 function Default_Expr_Function
(Id
: E
) return E
is
585 pragma Assert
(Is_Formal
(Id
));
587 end Default_Expr_Function
;
589 function Default_Expressions_Processed
(Id
: E
) return B
is
592 end Default_Expressions_Processed
;
594 function Default_Value
(Id
: E
) return N
is
596 pragma Assert
(Is_Formal
(Id
));
600 function Delay_Cleanups
(Id
: E
) return B
is
605 function Delay_Subprogram_Descriptors
(Id
: E
) return B
is
608 end Delay_Subprogram_Descriptors
;
610 function Delta_Value
(Id
: E
) return R
is
612 pragma Assert
(Is_Fixed_Point_Type
(Id
));
616 function Dependent_Instances
(Id
: E
) return L
is
618 pragma Assert
(Is_Generic_Instance
(Id
));
620 end Dependent_Instances
;
622 function Depends_On_Private
(Id
: E
) return B
is
624 pragma Assert
(Nkind
(Id
) in N_Entity
);
626 end Depends_On_Private
;
628 function Digits_Value
(Id
: E
) return U
is
631 (Is_Floating_Point_Type
(Id
)
632 or else Is_Decimal_Fixed_Point_Type
(Id
));
636 function Directly_Designated_Type
(Id
: E
) return E
is
639 end Directly_Designated_Type
;
641 function Discard_Names
(Id
: E
) return B
is
646 function Discriminal
(Id
: E
) return E
is
648 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
652 function Discriminal_Link
(Id
: E
) return N
is
655 end Discriminal_Link
;
657 function Discriminant_Checking_Func
(Id
: E
) return E
is
659 pragma Assert
(Ekind
(Id
) = E_Component
);
661 end Discriminant_Checking_Func
;
663 function Discriminant_Constraint
(Id
: E
) return L
is
665 pragma Assert
(Is_Composite_Type
(Id
) and then Has_Discriminants
(Id
));
667 end Discriminant_Constraint
;
669 function Discriminant_Default_Value
(Id
: E
) return N
is
671 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
673 end Discriminant_Default_Value
;
675 function Discriminant_Number
(Id
: E
) return U
is
677 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
679 end Discriminant_Number
;
681 function DT_Entry_Count
(Id
: E
) return U
is
683 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
687 function DT_Position
(Id
: E
) return U
is
690 ((Ekind
(Id
) = E_Function
691 or else Ekind
(Id
) = E_Procedure
)
692 and then Present
(DTC_Entity
(Id
)));
696 function DTC_Entity
(Id
: E
) return E
is
699 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
703 function Elaborate_All_Desirable
(Id
: E
) return B
is
706 end Elaborate_All_Desirable
;
708 function Elaboration_Entity
(Id
: E
) return E
is
713 Ekind
(Id
) = E_Package
715 Is_Generic_Unit
(Id
));
717 end Elaboration_Entity
;
719 function Elaboration_Entity_Required
(Id
: E
) return B
is
724 Ekind
(Id
) = E_Package
726 Is_Generic_Unit
(Id
));
728 end Elaboration_Entity_Required
;
730 function Enclosing_Scope
(Id
: E
) return E
is
735 function Entry_Accepted
(Id
: E
) return B
is
737 pragma Assert
(Is_Entry
(Id
));
741 function Entry_Bodies_Array
(Id
: E
) return E
is
744 end Entry_Bodies_Array
;
746 function Entry_Cancel_Parameter
(Id
: E
) return E
is
749 end Entry_Cancel_Parameter
;
751 function Entry_Component
(Id
: E
) return E
is
756 function Entry_Formal
(Id
: E
) return E
is
761 function Entry_Index_Constant
(Id
: E
) return N
is
763 pragma Assert
(Ekind
(Id
) = E_Entry_Index_Parameter
);
765 end Entry_Index_Constant
;
767 function Entry_Parameters_Type
(Id
: E
) return E
is
770 end Entry_Parameters_Type
;
772 function Enum_Pos_To_Rep
(Id
: E
) return E
is
774 pragma Assert
(Ekind
(Id
) = E_Enumeration_Type
);
778 function Enumeration_Pos
(Id
: E
) return Uint
is
780 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
784 function Enumeration_Rep
(Id
: E
) return U
is
786 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
790 function Enumeration_Rep_Expr
(Id
: E
) return N
is
792 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
794 end Enumeration_Rep_Expr
;
796 function Equivalent_Type
(Id
: E
) return E
is
799 (Ekind
(Id
) = E_Class_Wide_Subtype
or else
800 Ekind
(Id
) = E_Access_Protected_Subprogram_Type
or else
801 Ekind
(Id
) = E_Access_Subprogram_Type
or else
802 Ekind
(Id
) = E_Exception_Type
);
806 function Esize
(Id
: E
) return Uint
is
811 function Exception_Code
(Id
: E
) return Uint
is
813 pragma Assert
(Ekind
(Id
) = E_Exception
);
817 function Extra_Accessibility
(Id
: E
) return E
is
819 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
821 end Extra_Accessibility
;
823 function Extra_Constrained
(Id
: E
) return E
is
825 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
827 end Extra_Constrained
;
829 function Extra_Formal
(Id
: E
) return E
is
834 function Finalization_Chain_Entity
(Id
: E
) return E
is
837 end Finalization_Chain_Entity
;
839 function Finalize_Storage_Only
(Id
: E
) return B
is
841 pragma Assert
(Is_Type
(Id
));
842 return Flag158
(Base_Type
(Id
));
843 end Finalize_Storage_Only
;
845 function First_Entity
(Id
: E
) return E
is
850 function First_Index
(Id
: E
) return N
is
855 function First_Literal
(Id
: E
) return E
is
860 function First_Optional_Parameter
(Id
: E
) return E
is
863 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
865 end First_Optional_Parameter
;
867 function First_Private_Entity
(Id
: E
) return E
is
870 end First_Private_Entity
;
872 function First_Rep_Item
(Id
: E
) return E
is
877 function Freeze_Node
(Id
: E
) return N
is
882 function From_With_Type
(Id
: E
) return B
is
887 function Full_View
(Id
: E
) return E
is
889 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Constant
);
893 function Function_Returns_With_DSP
(Id
: E
) return B
is
896 (Is_Subprogram
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
898 end Function_Returns_With_DSP
;
900 function Generic_Renamings
(Id
: E
) return L
is
903 end Generic_Renamings
;
905 function Girder_Constraint
(Id
: E
) return L
is
908 (Is_Composite_Type
(Id
) and then not Is_Array_Type
(Id
));
910 end Girder_Constraint
;
912 function Handler_Records
(Id
: E
) return S
is
917 function Has_Aliased_Components
(Id
: E
) return B
is
919 return Flag135
(Implementation_Base_Type
(Id
));
920 end Has_Aliased_Components
;
922 function Has_Alignment_Clause
(Id
: E
) return B
is
925 end Has_Alignment_Clause
;
927 function Has_All_Calls_Remote
(Id
: E
) return B
is
930 end Has_All_Calls_Remote
;
932 function Has_Atomic_Components
(Id
: E
) return B
is
934 return Flag86
(Implementation_Base_Type
(Id
));
935 end Has_Atomic_Components
;
937 function Has_Biased_Representation
(Id
: E
) return B
is
940 end Has_Biased_Representation
;
942 function Has_Completion
(Id
: E
) return B
is
947 function Has_Completion_In_Body
(Id
: E
) return B
is
949 pragma Assert
(Is_Type
(Id
));
951 end Has_Completion_In_Body
;
953 function Has_Complex_Representation
(Id
: E
) return B
is
955 pragma Assert
(Is_Type
(Id
));
956 return Flag140
(Implementation_Base_Type
(Id
));
957 end Has_Complex_Representation
;
959 function Has_Component_Size_Clause
(Id
: E
) return B
is
961 pragma Assert
(Is_Array_Type
(Id
));
962 return Flag68
(Implementation_Base_Type
(Id
));
963 end Has_Component_Size_Clause
;
965 function Has_Controlled_Component
(Id
: E
) return B
is
967 return Flag43
(Base_Type
(Id
));
968 end Has_Controlled_Component
;
970 function Has_Controlling_Result
(Id
: E
) return B
is
973 end Has_Controlling_Result
;
975 function Has_Convention_Pragma
(Id
: E
) return B
is
978 end Has_Convention_Pragma
;
980 function Has_Delayed_Freeze
(Id
: E
) return B
is
982 pragma Assert
(Nkind
(Id
) in N_Entity
);
984 end Has_Delayed_Freeze
;
986 function Has_Discriminants
(Id
: E
) return B
is
988 pragma Assert
(Nkind
(Id
) in N_Entity
);
990 end Has_Discriminants
;
992 function Has_Enumeration_Rep_Clause
(Id
: E
) return B
is
994 pragma Assert
(Is_Enumeration_Type
(Id
));
996 end Has_Enumeration_Rep_Clause
;
998 function Has_Exit
(Id
: E
) return B
is
1003 function Has_External_Tag_Rep_Clause
(Id
: E
) return B
is
1005 pragma Assert
(Is_Tagged_Type
(Id
));
1006 return Flag110
(Id
);
1007 end Has_External_Tag_Rep_Clause
;
1009 function Has_Forward_Instantiation
(Id
: E
) return B
is
1011 return Flag175
(Id
);
1012 end Has_Forward_Instantiation
;
1014 function Has_Fully_Qualified_Name
(Id
: E
) return B
is
1016 return Flag173
(Id
);
1017 end Has_Fully_Qualified_Name
;
1019 function Has_Gigi_Rep_Item
(Id
: E
) return B
is
1022 end Has_Gigi_Rep_Item
;
1024 function Has_Homonym
(Id
: E
) return B
is
1029 function Has_Machine_Radix_Clause
(Id
: E
) return B
is
1031 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
1033 end Has_Machine_Radix_Clause
;
1035 function Has_Master_Entity
(Id
: E
) return B
is
1038 end Has_Master_Entity
;
1040 function Has_Missing_Return
(Id
: E
) return B
is
1043 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Generic_Function
);
1044 return Flag142
(Id
);
1045 end Has_Missing_Return
;
1047 function Has_Nested_Block_With_Handler
(Id
: E
) return B
is
1049 return Flag101
(Id
);
1050 end Has_Nested_Block_With_Handler
;
1052 function Has_Non_Standard_Rep
(Id
: E
) return B
is
1054 return Flag75
(Implementation_Base_Type
(Id
));
1055 end Has_Non_Standard_Rep
;
1057 function Has_Object_Size_Clause
(Id
: E
) return B
is
1059 pragma Assert
(Is_Type
(Id
));
1060 return Flag172
(Id
);
1061 end Has_Object_Size_Clause
;
1063 function Has_Per_Object_Constraint
(Id
: E
) return B
is
1065 return Flag154
(Id
);
1066 end Has_Per_Object_Constraint
;
1068 function Has_Pragma_Controlled
(Id
: E
) return B
is
1070 pragma Assert
(Is_Access_Type
(Id
));
1071 return Flag27
(Implementation_Base_Type
(Id
));
1072 end Has_Pragma_Controlled
;
1074 function Has_Pragma_Elaborate_Body
(Id
: E
) return B
is
1076 return Flag150
(Id
);
1077 end Has_Pragma_Elaborate_Body
;
1079 function Has_Pragma_Inline
(Id
: E
) return B
is
1081 return Flag157
(Id
);
1082 end Has_Pragma_Inline
;
1084 function Has_Pragma_Pack
(Id
: E
) return B
is
1086 pragma Assert
(Is_Record_Type
(Id
) or else Is_Array_Type
(Id
));
1087 return Flag121
(Implementation_Base_Type
(Id
));
1088 end Has_Pragma_Pack
;
1090 function Has_Primitive_Operations
(Id
: E
) return B
is
1092 pragma Assert
(Is_Type
(Id
));
1093 return Flag120
(Base_Type
(Id
));
1094 end Has_Primitive_Operations
;
1096 function Has_Private_Declaration
(Id
: E
) return B
is
1098 return Flag155
(Id
);
1099 end Has_Private_Declaration
;
1101 function Has_Qualified_Name
(Id
: E
) return B
is
1103 return Flag161
(Id
);
1104 end Has_Qualified_Name
;
1106 function Has_Record_Rep_Clause
(Id
: E
) return B
is
1108 pragma Assert
(Is_Record_Type
(Id
));
1110 end Has_Record_Rep_Clause
;
1112 function Has_Recursive_Call
(Id
: E
) return B
is
1114 pragma Assert
(Is_Subprogram
(Id
));
1115 return Flag143
(Id
);
1116 end Has_Recursive_Call
;
1118 function Has_Size_Clause
(Id
: E
) return B
is
1121 end Has_Size_Clause
;
1123 function Has_Small_Clause
(Id
: E
) return B
is
1126 end Has_Small_Clause
;
1128 function Has_Specified_Layout
(Id
: E
) return B
is
1130 pragma Assert
(Is_Type
(Id
));
1131 return Flag100
(Id
);
1132 end Has_Specified_Layout
;
1134 function Has_Storage_Size_Clause
(Id
: E
) return B
is
1136 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
1137 return Flag23
(Implementation_Base_Type
(Id
));
1138 end Has_Storage_Size_Clause
;
1140 function Has_Subprogram_Descriptor
(Id
: E
) return B
is
1143 end Has_Subprogram_Descriptor
;
1145 function Has_Task
(Id
: E
) return B
is
1147 return Flag30
(Base_Type
(Id
));
1150 function Has_Unchecked_Union
(Id
: E
) return B
is
1152 return Flag123
(Base_Type
(Id
));
1153 end Has_Unchecked_Union
;
1155 function Has_Unknown_Discriminants
(Id
: E
) return B
is
1157 pragma Assert
(Is_Type
(Id
));
1159 end Has_Unknown_Discriminants
;
1161 function Has_Volatile_Components
(Id
: E
) return B
is
1163 return Flag87
(Implementation_Base_Type
(Id
));
1164 end Has_Volatile_Components
;
1166 function Hiding_Loop_Variable
(Id
: E
) return E
is
1168 pragma Assert
(Ekind
(Id
) = E_Variable
);
1170 end Hiding_Loop_Variable
;
1172 function Homonym
(Id
: E
) return E
is
1177 function In_Package_Body
(Id
: E
) return B
is
1180 end In_Package_Body
;
1182 function In_Private_Part
(Id
: E
) return B
is
1185 end In_Private_Part
;
1187 function In_Use
(Id
: E
) return B
is
1189 pragma Assert
(Nkind
(Id
) in N_Entity
);
1193 function Inner_Instances
(Id
: E
) return L
is
1195 return Elist23
(Id
);
1196 end Inner_Instances
;
1198 function Interface_Name
(Id
: E
) return N
is
1203 function Is_Abstract
(Id
: E
) return B
is
1208 function Is_Access_Constant
(Id
: E
) return B
is
1210 pragma Assert
(Is_Access_Type
(Id
));
1212 end Is_Access_Constant
;
1214 function Is_Aliased
(Id
: E
) return B
is
1216 pragma Assert
(Nkind
(Id
) in N_Entity
);
1220 function Is_AST_Entry
(Id
: E
) return B
is
1222 pragma Assert
(Is_Entry
(Id
));
1223 return Flag132
(Id
);
1226 function Is_Asynchronous
(Id
: E
) return B
is
1229 (Ekind
(Id
) = E_Procedure
or else Is_Type
(Id
));
1231 end Is_Asynchronous
;
1233 function Is_Atomic
(Id
: E
) return B
is
1238 function Is_Bit_Packed_Array
(Id
: E
) return B
is
1240 return Flag122
(Implementation_Base_Type
(Id
));
1241 end Is_Bit_Packed_Array
;
1243 function Is_Called
(Id
: E
) return B
is
1246 (Ekind
(Id
) = E_Procedure
or else Ekind
(Id
) = E_Function
);
1247 return Flag102
(Id
);
1250 function Is_Character_Type
(Id
: E
) return B
is
1253 end Is_Character_Type
;
1255 function Is_Child_Unit
(Id
: E
) return B
is
1260 function Is_Compilation_Unit
(Id
: E
) return B
is
1262 return Flag149
(Id
);
1263 end Is_Compilation_Unit
;
1265 function Is_Completely_Hidden
(Id
: E
) return B
is
1267 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
1268 return Flag103
(Id
);
1269 end Is_Completely_Hidden
;
1271 function Is_Constr_Subt_For_U_Nominal
(Id
: E
) return B
is
1274 end Is_Constr_Subt_For_U_Nominal
;
1276 function Is_Constr_Subt_For_UN_Aliased
(Id
: E
) return B
is
1278 return Flag141
(Id
);
1279 end Is_Constr_Subt_For_UN_Aliased
;
1281 function Is_Constrained
(Id
: E
) return B
is
1283 pragma Assert
(Nkind
(Id
) in N_Entity
);
1287 function Is_Constructor
(Id
: E
) return B
is
1292 function Is_Controlled
(Id
: E
) return B
is
1294 return Flag42
(Base_Type
(Id
));
1297 function Is_Controlling_Formal
(Id
: E
) return B
is
1299 pragma Assert
(Is_Formal
(Id
));
1301 end Is_Controlling_Formal
;
1303 function Is_CPP_Class
(Id
: E
) return B
is
1308 function Is_Destructor
(Id
: E
) return B
is
1313 function Is_Discrim_SO_Function
(Id
: E
) return B
is
1315 return Flag176
(Id
);
1316 end Is_Discrim_SO_Function
;
1318 function Is_Dispatching_Operation
(Id
: E
) return B
is
1320 pragma Assert
(Nkind
(Id
) in N_Entity
);
1322 end Is_Dispatching_Operation
;
1324 function Is_Eliminated
(Id
: E
) return B
is
1326 return Flag124
(Id
);
1329 function Is_Entry_Formal
(Id
: E
) return B
is
1332 end Is_Entry_Formal
;
1334 function Is_Exported
(Id
: E
) return B
is
1339 function Is_First_Subtype
(Id
: E
) return B
is
1342 end Is_First_Subtype
;
1344 function Is_For_Access_Subtype
(Id
: E
) return B
is
1347 (Ekind
(Id
) = E_Record_Subtype
1349 Ekind
(Id
) = E_Private_Subtype
);
1350 return Flag118
(Id
);
1351 end Is_For_Access_Subtype
;
1353 function Is_Formal_Subprogram
(Id
: E
) return B
is
1355 return Flag111
(Id
);
1356 end Is_Formal_Subprogram
;
1358 function Is_Frozen
(Id
: E
) return B
is
1363 function Is_Generic_Actual_Type
(Id
: E
) return B
is
1365 pragma Assert
(Is_Type
(Id
));
1367 end Is_Generic_Actual_Type
;
1369 function Is_Generic_Instance
(Id
: E
) return B
is
1371 return Flag130
(Id
);
1372 end Is_Generic_Instance
;
1374 function Is_Generic_Type
(Id
: E
) return B
is
1376 pragma Assert
(Nkind
(Id
) in N_Entity
);
1378 end Is_Generic_Type
;
1380 function Is_Hidden
(Id
: E
) return B
is
1385 function Is_Hidden_Open_Scope
(Id
: E
) return B
is
1387 return Flag171
(Id
);
1388 end Is_Hidden_Open_Scope
;
1390 function Is_Immediately_Visible
(Id
: E
) return B
is
1392 pragma Assert
(Nkind
(Id
) in N_Entity
);
1394 end Is_Immediately_Visible
;
1396 function Is_Imported
(Id
: E
) return B
is
1401 function Is_Inlined
(Id
: E
) return B
is
1406 function Is_Instantiated
(Id
: E
) return B
is
1408 return Flag126
(Id
);
1409 end Is_Instantiated
;
1411 function Is_Internal
(Id
: E
) return B
is
1413 pragma Assert
(Nkind
(Id
) in N_Entity
);
1417 function Is_Interrupt_Handler
(Id
: E
) return B
is
1419 pragma Assert
(Nkind
(Id
) in N_Entity
);
1421 end Is_Interrupt_Handler
;
1423 function Is_Intrinsic_Subprogram
(Id
: E
) return B
is
1426 end Is_Intrinsic_Subprogram
;
1428 function Is_Itype
(Id
: E
) return B
is
1433 function Is_Known_Valid
(Id
: E
) return B
is
1435 return Flag170
(Id
);
1438 function Is_Limited_Composite
(Id
: E
) return B
is
1440 return Flag106
(Id
);
1441 end Is_Limited_Composite
;
1443 function Is_Limited_Record
(Id
: E
) return B
is
1446 end Is_Limited_Record
;
1448 function Is_Machine_Code_Subprogram
(Id
: E
) return B
is
1450 pragma Assert
(Is_Subprogram
(Id
));
1451 return Flag137
(Id
);
1452 end Is_Machine_Code_Subprogram
;
1454 function Is_Non_Static_Subtype
(Id
: E
) return B
is
1456 pragma Assert
(Is_Type
(Id
));
1457 return Flag109
(Id
);
1458 end Is_Non_Static_Subtype
;
1460 function Is_Null_Init_Proc
(Id
: E
) return B
is
1462 pragma Assert
(Ekind
(Id
) = E_Procedure
);
1463 return Flag178
(Id
);
1464 end Is_Null_Init_Proc
;
1466 function Is_Optional_Parameter
(Id
: E
) return B
is
1468 pragma Assert
(Is_Formal
(Id
));
1469 return Flag134
(Id
);
1470 end Is_Optional_Parameter
;
1472 function Is_Package_Body_Entity
(Id
: E
) return B
is
1474 return Flag160
(Id
);
1475 end Is_Package_Body_Entity
;
1477 function Is_Packed
(Id
: E
) return B
is
1479 return Flag51
(Implementation_Base_Type
(Id
));
1482 function Is_Packed_Array_Type
(Id
: E
) return B
is
1484 return Flag138
(Id
);
1485 end Is_Packed_Array_Type
;
1487 function Is_Potentially_Use_Visible
(Id
: E
) return B
is
1489 pragma Assert
(Nkind
(Id
) in N_Entity
);
1491 end Is_Potentially_Use_Visible
;
1493 function Is_Preelaborated
(Id
: E
) return B
is
1496 end Is_Preelaborated
;
1498 function Is_Private_Composite
(Id
: E
) return B
is
1500 pragma Assert
(Is_Type
(Id
));
1501 return Flag107
(Id
);
1502 end Is_Private_Composite
;
1504 function Is_Private_Descendant
(Id
: E
) return B
is
1507 end Is_Private_Descendant
;
1509 function Is_Psected
(Id
: E
) return B
is
1511 return Flag153
(Id
);
1514 function Is_Public
(Id
: E
) return B
is
1516 pragma Assert
(Nkind
(Id
) in N_Entity
);
1520 function Is_Pure
(Id
: E
) return B
is
1525 function Is_Remote_Call_Interface
(Id
: E
) return B
is
1528 end Is_Remote_Call_Interface
;
1530 function Is_Remote_Types
(Id
: E
) return B
is
1533 end Is_Remote_Types
;
1535 function Is_Renaming_Of_Object
(Id
: E
) return B
is
1537 return Flag112
(Id
);
1538 end Is_Renaming_Of_Object
;
1540 function Is_Shared_Passive
(Id
: E
) return B
is
1543 end Is_Shared_Passive
;
1545 function Is_Statically_Allocated
(Id
: E
) return B
is
1548 end Is_Statically_Allocated
;
1550 function Is_Tag
(Id
: E
) return B
is
1552 pragma Assert
(Nkind
(Id
) in N_Entity
);
1556 function Is_Tagged_Type
(Id
: E
) return B
is
1561 function Is_True_Constant
(Id
: E
) return B
is
1563 return Flag163
(Id
);
1564 end Is_True_Constant
;
1566 function Is_Unchecked_Union
(Id
: E
) return B
is
1568 return Flag117
(Id
);
1569 end Is_Unchecked_Union
;
1571 function Is_Unsigned_Type
(Id
: E
) return B
is
1573 pragma Assert
(Is_Type
(Id
));
1574 return Flag144
(Id
);
1575 end Is_Unsigned_Type
;
1577 function Is_Valued_Procedure
(Id
: E
) return B
is
1579 pragma Assert
(Ekind
(Id
) = E_Procedure
);
1580 return Flag127
(Id
);
1581 end Is_Valued_Procedure
;
1583 function Is_Visible_Child_Unit
(Id
: E
) return B
is
1585 pragma Assert
(Is_Child_Unit
(Id
));
1586 return Flag116
(Id
);
1587 end Is_Visible_Child_Unit
;
1589 function Is_VMS_Exception
(Id
: E
) return B
is
1591 return Flag133
(Id
);
1592 end Is_VMS_Exception
;
1594 function Is_Volatile
(Id
: E
) return B
is
1596 pragma Assert
(Nkind
(Id
) in N_Entity
);
1600 function Last_Entity
(Id
: E
) return E
is
1605 function Lit_Indexes
(Id
: E
) return E
is
1607 pragma Assert
(Is_Enumeration_Type
(Id
));
1611 function Lit_Strings
(Id
: E
) return E
is
1613 pragma Assert
(Is_Enumeration_Type
(Id
));
1617 function Machine_Radix_10
(Id
: E
) return B
is
1619 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
1621 end Machine_Radix_10
;
1623 function Master_Id
(Id
: E
) return E
is
1628 function Materialize_Entity
(Id
: E
) return B
is
1630 return Flag168
(Id
);
1631 end Materialize_Entity
;
1633 function Mechanism
(Id
: E
) return M
is
1635 pragma Assert
(Ekind
(Id
) = E_Function
or else Is_Formal
(Id
));
1636 return UI_To_Int
(Uint8
(Id
));
1639 function Modulus
(Id
: E
) return Uint
is
1641 pragma Assert
(Is_Modular_Integer_Type
(Id
));
1642 return Uint17
(Base_Type
(Id
));
1645 function Needs_Debug_Info
(Id
: E
) return B
is
1647 return Flag147
(Id
);
1648 end Needs_Debug_Info
;
1650 function Needs_No_Actuals
(Id
: E
) return B
is
1653 (Is_Overloadable
(Id
)
1654 or else Ekind
(Id
) = E_Subprogram_Type
1655 or else Ekind
(Id
) = E_Entry_Family
);
1657 end Needs_No_Actuals
;
1659 function Next_Inlined_Subprogram
(Id
: E
) return E
is
1662 end Next_Inlined_Subprogram
;
1664 function No_Pool_Assigned
(Id
: E
) return B
is
1666 pragma Assert
(Is_Access_Type
(Id
));
1667 return Flag131
(Root_Type
(Id
));
1668 end No_Pool_Assigned
;
1670 function No_Return
(Id
: E
) return B
is
1673 (Ekind
(Id
) = E_Procedure
or else Ekind
(Id
) = E_Generic_Procedure
);
1674 return Flag113
(Id
);
1677 function Non_Binary_Modulus
(Id
: E
) return B
is
1679 pragma Assert
(Is_Modular_Integer_Type
(Id
));
1680 return Flag58
(Base_Type
(Id
));
1681 end Non_Binary_Modulus
;
1683 function Nonzero_Is_True
(Id
: E
) return B
is
1685 pragma Assert
(Root_Type
(Id
) = Standard_Boolean
);
1686 return Flag162
(Base_Type
(Id
));
1687 end Nonzero_Is_True
;
1689 function Normalized_First_Bit
(Id
: E
) return U
is
1692 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
1694 end Normalized_First_Bit
;
1696 function Normalized_Position
(Id
: E
) return U
is
1699 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
1701 end Normalized_Position
;
1703 function Normalized_Position_Max
(Id
: E
) return U
is
1706 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
1708 end Normalized_Position_Max
;
1710 function Not_Source_Assigned
(Id
: E
) return B
is
1712 return Flag115
(Id
);
1713 end Not_Source_Assigned
;
1715 function Object_Ref
(Id
: E
) return E
is
1717 pragma Assert
(Ekind
(Id
) = E_Protected_Body
);
1721 function Original_Record_Component
(Id
: E
) return E
is
1724 end Original_Record_Component
;
1726 function Packed_Array_Type
(Id
: E
) return E
is
1728 pragma Assert
(Is_Array_Type
(Id
));
1730 end Packed_Array_Type
;
1732 function Parent_Subtype
(Id
: E
) return E
is
1734 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
1738 function Primitive_Operations
(Id
: E
) return L
is
1740 pragma Assert
(Is_Tagged_Type
(Id
));
1741 return Elist15
(Id
);
1742 end Primitive_Operations
;
1744 function Prival
(Id
: E
) return E
is
1746 pragma Assert
(Is_Protected_Private
(Id
));
1750 function Privals_Chain
(Id
: E
) return L
is
1752 pragma Assert
(Is_Overloadable
(Id
)
1753 or else Ekind
(Id
) = E_Entry_Family
);
1754 return Elist23
(Id
);
1757 function Private_Dependents
(Id
: E
) return L
is
1759 pragma Assert
(Is_Incomplete_Or_Private_Type
(Id
));
1760 return Elist18
(Id
);
1761 end Private_Dependents
;
1763 function Private_View
(Id
: E
) return N
is
1765 pragma Assert
(Is_Private_Type
(Id
));
1769 function Protected_Body_Subprogram
(Id
: E
) return E
is
1771 pragma Assert
(Is_Subprogram
(Id
) or else Is_Entry
(Id
));
1773 end Protected_Body_Subprogram
;
1775 function Protected_Formal
(Id
: E
) return E
is
1777 pragma Assert
(Is_Formal
(Id
));
1779 end Protected_Formal
;
1781 function Protected_Operation
(Id
: E
) return N
is
1783 pragma Assert
(Is_Protected_Private
(Id
));
1785 end Protected_Operation
;
1787 function Reachable
(Id
: E
) return B
is
1792 function Referenced
(Id
: E
) return B
is
1794 return Flag156
(Id
);
1797 function Referenced_Object
(Id
: E
) return N
is
1799 pragma Assert
(Is_Type
(Id
));
1801 end Referenced_Object
;
1803 function Register_Exception_Call
(Id
: E
) return N
is
1805 pragma Assert
(Ekind
(Id
) = E_Exception
);
1807 end Register_Exception_Call
;
1809 function Related_Array_Object
(Id
: E
) return E
is
1811 pragma Assert
(Is_Array_Type
(Id
));
1813 end Related_Array_Object
;
1815 function Related_Instance
(Id
: E
) return E
is
1817 pragma Assert
(Ekind
(Id
) = E_Package
);
1819 end Related_Instance
;
1821 function Renamed_Entity
(Id
: E
) return N
is
1826 function Renamed_Object
(Id
: E
) return N
is
1831 function Renaming_Map
(Id
: E
) return U
is
1836 function Return_Present
(Id
: E
) return B
is
1841 function Returns_By_Ref
(Id
: E
) return B
is
1846 function Reverse_Bit_Order
(Id
: E
) return B
is
1848 pragma Assert
(Is_Record_Type
(Id
));
1849 return Flag164
(Base_Type
(Id
));
1850 end Reverse_Bit_Order
;
1852 function RM_Size
(Id
: E
) return U
is
1854 pragma Assert
(Is_Type
(Id
));
1858 function Scalar_Range
(Id
: E
) return N
is
1863 function Scale_Value
(Id
: E
) return U
is
1868 function Scope_Depth_Value
(Id
: E
) return U
is
1871 end Scope_Depth_Value
;
1873 function Sec_Stack_Needed_For_Return
(Id
: E
) return B
is
1875 return Flag167
(Id
);
1876 end Sec_Stack_Needed_For_Return
;
1878 function Shadow_Entities
(Id
: E
) return S
is
1881 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
1883 end Shadow_Entities
;
1885 function Shared_Var_Assign_Proc
(Id
: E
) return E
is
1887 pragma Assert
(Ekind
(Id
) = E_Variable
);
1889 end Shared_Var_Assign_Proc
;
1891 function Shared_Var_Read_Proc
(Id
: E
) return E
is
1893 pragma Assert
(Ekind
(Id
) = E_Variable
);
1895 end Shared_Var_Read_Proc
;
1897 function Size_Check_Code
(Id
: E
) return N
is
1899 pragma Assert
(Ekind
(Id
) = E_Constant
or else Ekind
(Id
) = E_Variable
);
1901 end Size_Check_Code
;
1903 function Size_Depends_On_Discriminant
(Id
: E
) return B
is
1905 return Flag177
(Id
);
1906 end Size_Depends_On_Discriminant
;
1908 function Size_Known_At_Compile_Time
(Id
: E
) return B
is
1911 end Size_Known_At_Compile_Time
;
1913 function Small_Value
(Id
: E
) return R
is
1915 pragma Assert
(Is_Fixed_Point_Type
(Id
));
1916 return Ureal21
(Id
);
1919 function Spec_Entity
(Id
: E
) return E
is
1922 (Ekind
(Id
) = E_Package_Body
or else Is_Formal
(Id
));
1926 function Storage_Size_Variable
(Id
: E
) return E
is
1928 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
1929 return Node15
(Implementation_Base_Type
(Id
));
1930 end Storage_Size_Variable
;
1932 function Strict_Alignment
(Id
: E
) return B
is
1934 return Flag145
(Implementation_Base_Type
(Id
));
1935 end Strict_Alignment
;
1937 function String_Literal_Length
(Id
: E
) return U
is
1940 end String_Literal_Length
;
1942 function String_Literal_Low_Bound
(Id
: E
) return N
is
1945 end String_Literal_Low_Bound
;
1947 function Suppress_Access_Checks
(Id
: E
) return B
is
1950 end Suppress_Access_Checks
;
1952 function Suppress_Accessibility_Checks
(Id
: E
) return B
is
1955 end Suppress_Accessibility_Checks
;
1957 function Suppress_Discriminant_Checks
(Id
: E
) return B
is
1960 end Suppress_Discriminant_Checks
;
1962 function Suppress_Division_Checks
(Id
: E
) return B
is
1965 end Suppress_Division_Checks
;
1967 function Suppress_Elaboration_Checks
(Id
: E
) return B
is
1970 end Suppress_Elaboration_Checks
;
1972 function Suppress_Elaboration_Warnings
(Id
: E
) return B
is
1974 return Flag148
(Id
);
1975 end Suppress_Elaboration_Warnings
;
1977 function Suppress_Index_Checks
(Id
: E
) return B
is
1980 end Suppress_Index_Checks
;
1982 function Suppress_Init_Proc
(Id
: E
) return B
is
1984 return Flag105
(Base_Type
(Id
));
1985 end Suppress_Init_Proc
;
1987 function Suppress_Length_Checks
(Id
: E
) return B
is
1990 end Suppress_Length_Checks
;
1992 function Suppress_Overflow_Checks
(Id
: E
) return B
is
1995 end Suppress_Overflow_Checks
;
1997 function Suppress_Range_Checks
(Id
: E
) return B
is
2000 end Suppress_Range_Checks
;
2002 function Suppress_Storage_Checks
(Id
: E
) return B
is
2005 end Suppress_Storage_Checks
;
2007 function Suppress_Style_Checks
(Id
: E
) return B
is
2009 return Flag165
(Id
);
2010 end Suppress_Style_Checks
;
2012 function Suppress_Tag_Checks
(Id
: E
) return B
is
2015 end Suppress_Tag_Checks
;
2017 function Underlying_Full_View
(Id
: E
) return E
is
2019 pragma Assert
(Ekind
(Id
) in Private_Kind
);
2021 end Underlying_Full_View
;
2023 function Unset_Reference
(Id
: E
) return N
is
2026 end Unset_Reference
;
2028 function Uses_Sec_Stack
(Id
: E
) return B
is
2033 function Vax_Float
(Id
: E
) return B
is
2035 return Flag151
(Base_Type
(Id
));
2038 function Warnings_Off
(Id
: E
) return B
is
2043 ------------------------------
2044 -- Classification Functions --
2045 ------------------------------
2047 function Is_Access_Type
(Id
: E
) return B
is
2049 return Ekind
(Id
) in Access_Kind
;
2052 function Is_Array_Type
(Id
: E
) return B
is
2054 return Ekind
(Id
) in Array_Kind
;
2057 function Is_Class_Wide_Type
(Id
: E
) return B
is
2059 return Ekind
(Id
) in Class_Wide_Kind
;
2060 end Is_Class_Wide_Type
;
2062 function Is_Composite_Type
(Id
: E
) return B
is
2064 return Ekind
(Id
) in Composite_Kind
;
2065 end Is_Composite_Type
;
2067 function Is_Concurrent_Body
(Id
: E
) return B
is
2069 return Ekind
(Id
) in
2070 Concurrent_Body_Kind
;
2071 end Is_Concurrent_Body
;
2073 function Is_Concurrent_Record_Type
(Id
: E
) return B
is
2076 end Is_Concurrent_Record_Type
;
2078 function Is_Concurrent_Type
(Id
: E
) return B
is
2080 return Ekind
(Id
) in Concurrent_Kind
;
2081 end Is_Concurrent_Type
;
2083 function Is_Decimal_Fixed_Point_Type
(Id
: E
) return B
is
2085 return Ekind
(Id
) in
2086 Decimal_Fixed_Point_Kind
;
2087 end Is_Decimal_Fixed_Point_Type
;
2089 function Is_Digits_Type
(Id
: E
) return B
is
2091 return Ekind
(Id
) in Digits_Kind
;
2094 function Is_Discrete_Or_Fixed_Point_Type
(Id
: E
) return B
is
2096 return Ekind
(Id
) in Discrete_Or_Fixed_Point_Kind
;
2097 end Is_Discrete_Or_Fixed_Point_Type
;
2099 function Is_Discrete_Type
(Id
: E
) return B
is
2101 return Ekind
(Id
) in Discrete_Kind
;
2102 end Is_Discrete_Type
;
2104 function Is_Elementary_Type
(Id
: E
) return B
is
2106 return Ekind
(Id
) in Elementary_Kind
;
2107 end Is_Elementary_Type
;
2109 function Is_Entry
(Id
: E
) return B
is
2111 return Ekind
(Id
) in Entry_Kind
;
2114 function Is_Enumeration_Type
(Id
: E
) return B
is
2116 return Ekind
(Id
) in
2118 end Is_Enumeration_Type
;
2120 function Is_Fixed_Point_Type
(Id
: E
) return B
is
2122 return Ekind
(Id
) in
2124 end Is_Fixed_Point_Type
;
2126 function Is_Floating_Point_Type
(Id
: E
) return B
is
2128 return Ekind
(Id
) in Float_Kind
;
2129 end Is_Floating_Point_Type
;
2131 function Is_Formal
(Id
: E
) return B
is
2133 return Ekind
(Id
) in Formal_Kind
;
2136 function Is_Generic_Unit
(Id
: E
) return B
is
2138 return Ekind
(Id
) in Generic_Unit_Kind
;
2139 end Is_Generic_Unit
;
2141 function Is_Incomplete_Or_Private_Type
(Id
: E
) return B
is
2143 return Ekind
(Id
) in
2144 Incomplete_Or_Private_Kind
;
2145 end Is_Incomplete_Or_Private_Type
;
2147 function Is_Integer_Type
(Id
: E
) return B
is
2149 return Ekind
(Id
) in Integer_Kind
;
2150 end Is_Integer_Type
;
2152 function Is_Modular_Integer_Type
(Id
: E
) return B
is
2154 return Ekind
(Id
) in
2155 Modular_Integer_Kind
;
2156 end Is_Modular_Integer_Type
;
2158 function Is_Named_Number
(Id
: E
) return B
is
2160 return Ekind
(Id
) in Named_Kind
;
2161 end Is_Named_Number
;
2163 function Is_Numeric_Type
(Id
: E
) return B
is
2165 return Ekind
(Id
) in Numeric_Kind
;
2166 end Is_Numeric_Type
;
2168 function Is_Object
(Id
: E
) return B
is
2170 return Ekind
(Id
) in Object_Kind
;
2173 function Is_Ordinary_Fixed_Point_Type
(Id
: E
) return B
is
2175 return Ekind
(Id
) in
2176 Ordinary_Fixed_Point_Kind
;
2177 end Is_Ordinary_Fixed_Point_Type
;
2179 function Is_Overloadable
(Id
: E
) return B
is
2181 return Ekind
(Id
) in Overloadable_Kind
;
2182 end Is_Overloadable
;
2184 function Is_Private_Type
(Id
: E
) return B
is
2186 return Ekind
(Id
) in Private_Kind
;
2187 end Is_Private_Type
;
2189 function Is_Protected_Type
(Id
: E
) return B
is
2191 return Ekind
(Id
) in Protected_Kind
;
2192 end Is_Protected_Type
;
2194 function Is_Real_Type
(Id
: E
) return B
is
2196 return Ekind
(Id
) in Real_Kind
;
2199 function Is_Record_Type
(Id
: E
) return B
is
2201 return Ekind
(Id
) in Record_Kind
;
2204 function Is_Scalar_Type
(Id
: E
) return B
is
2206 return Ekind
(Id
) in Scalar_Kind
;
2209 function Is_Signed_Integer_Type
(Id
: E
) return B
is
2211 return Ekind
(Id
) in
2212 Signed_Integer_Kind
;
2213 end Is_Signed_Integer_Type
;
2215 function Is_Subprogram
(Id
: E
) return B
is
2217 return Ekind
(Id
) in Subprogram_Kind
;
2220 function Is_Task_Type
(Id
: E
) return B
is
2222 return Ekind
(Id
) in Task_Kind
;
2225 function Is_Type
(Id
: E
) return B
is
2227 return Ekind
(Id
) in Type_Kind
;
2230 ------------------------------
2231 -- Attribute Set Procedures --
2232 ------------------------------
2234 procedure Set_Accept_Address
(Id
: E
; V
: L
) is
2236 Set_Elist21
(Id
, V
);
2237 end Set_Accept_Address
;
2239 procedure Set_Access_Disp_Table
(Id
: E
; V
: E
) is
2241 pragma Assert
(Is_Tagged_Type
(Id
));
2242 Set_Node16
(Base_Type
(Id
), V
);
2243 end Set_Access_Disp_Table
;
2245 procedure Set_Associated_Final_Chain
(Id
: E
; V
: E
) is
2247 pragma Assert
(Is_Access_Type
(Id
));
2249 end Set_Associated_Final_Chain
;
2251 procedure Set_Associated_Formal_Package
(Id
: E
; V
: E
) is
2254 end Set_Associated_Formal_Package
;
2256 procedure Set_Associated_Node_For_Itype
(Id
: E
; V
: E
) is
2259 end Set_Associated_Node_For_Itype
;
2261 procedure Set_Associated_Storage_Pool
(Id
: E
; V
: E
) is
2263 pragma Assert
(Is_Access_Type
(Id
));
2265 end Set_Associated_Storage_Pool
;
2267 procedure Set_Actual_Subtype
(Id
: E
; V
: E
) is
2270 (Ekind
(Id
) = E_Constant
2271 or else Ekind
(Id
) = E_Variable
2272 or else Ekind
(Id
) = E_Generic_In_Out_Parameter
2273 or else Ekind
(Id
) in E_In_Parameter
.. E_In_Out_Parameter
);
2275 end Set_Actual_Subtype
;
2277 procedure Set_Address_Taken
(Id
: E
; V
: B
:= True) is
2279 Set_Flag104
(Id
, V
);
2280 end Set_Address_Taken
;
2282 procedure Set_Alias
(Id
: E
; V
: E
) is
2285 (Is_Overloadable
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
2289 procedure Set_Alignment
(Id
: E
; V
: U
) is
2294 procedure Set_Barrier_Function
(Id
: E
; V
: N
) is
2296 pragma Assert
(Is_Entry
(Id
));
2298 end Set_Barrier_Function
;
2300 procedure Set_Block_Node
(Id
: E
; V
: N
) is
2302 pragma Assert
(Ekind
(Id
) = E_Block
);
2306 procedure Set_Body_Entity
(Id
: E
; V
: E
) is
2309 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
2311 end Set_Body_Entity
;
2313 procedure Set_C_Pass_By_Copy
(Id
: E
; V
: B
:= True) is
2315 pragma Assert
(Is_Record_Type
(Id
) and then Id
= Base_Type
(Id
));
2316 Set_Flag125
(Id
, V
);
2317 end Set_C_Pass_By_Copy
;
2319 procedure Set_Class_Wide_Type
(Id
: E
; V
: E
) is
2321 pragma Assert
(Is_Type
(Id
));
2323 end Set_Class_Wide_Type
;
2325 procedure Set_Cloned_Subtype
(Id
: E
; V
: E
) is
2328 (Ekind
(Id
) = E_Record_Subtype
2329 or else Ekind
(Id
) = E_Class_Wide_Subtype
);
2331 end Set_Cloned_Subtype
;
2333 procedure Set_Component_Bit_Offset
(Id
: E
; V
: U
) is
2336 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2338 end Set_Component_Bit_Offset
;
2340 procedure Set_Component_Clause
(Id
: E
; V
: N
) is
2343 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
2345 end Set_Component_Clause
;
2347 procedure Set_Component_Size
(Id
: E
; V
: U
) is
2349 pragma Assert
(Is_Array_Type
(Id
));
2350 Set_Uint22
(Base_Type
(Id
), V
);
2351 end Set_Component_Size
;
2353 procedure Set_Component_Type
(Id
: E
; V
: E
) is
2356 end Set_Component_Type
;
2358 procedure Set_Corresponding_Concurrent_Type
(Id
: E
; V
: E
) is
2361 (Ekind
(Id
) = E_Record_Type
and then Is_Concurrent_Type
(V
));
2363 end Set_Corresponding_Concurrent_Type
;
2365 procedure Set_Corresponding_Discriminant
(Id
: E
; V
: E
) is
2367 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
2369 end Set_Corresponding_Discriminant
;
2371 procedure Set_Corresponding_Equality
(Id
: E
; V
: E
) is
2374 (Ekind
(Id
) = E_Function
2375 and then not Comes_From_Source
(Id
)
2376 and then Chars
(Id
) = Name_Op_Ne
);
2378 end Set_Corresponding_Equality
;
2380 procedure Set_Corresponding_Record_Type
(Id
: E
; V
: E
) is
2382 pragma Assert
(Is_Concurrent_Type
(Id
));
2384 end Set_Corresponding_Record_Type
;
2386 procedure Set_Corresponding_Remote_Type
(Id
: E
; V
: E
) is
2389 end Set_Corresponding_Remote_Type
;
2391 procedure Set_CR_Discriminant
(Id
: E
; V
: E
) is
2394 end Set_CR_Discriminant
;
2396 procedure Set_Debug_Info_Off
(Id
: E
; V
: B
:= True) is
2398 Set_Flag166
(Id
, V
);
2399 end Set_Debug_Info_Off
;
2401 procedure Set_Debug_Renaming_Link
(Id
: E
; V
: E
) is
2404 end Set_Debug_Renaming_Link
;
2406 procedure Set_Default_Expr_Function
(Id
: E
; V
: E
) is
2408 pragma Assert
(Is_Formal
(Id
));
2410 end Set_Default_Expr_Function
;
2412 procedure Set_Default_Expressions_Processed
(Id
: E
; V
: B
:= True) is
2414 Set_Flag108
(Id
, V
);
2415 end Set_Default_Expressions_Processed
;
2417 procedure Set_Default_Value
(Id
: E
; V
: N
) is
2419 pragma Assert
(Is_Formal
(Id
));
2421 end Set_Default_Value
;
2423 procedure Set_Delay_Cleanups
(Id
: E
; V
: B
:= True) is
2427 or else Is_Task_Type
(Id
)
2428 or else Ekind
(Id
) = E_Block
);
2429 Set_Flag114
(Id
, V
);
2430 end Set_Delay_Cleanups
;
2432 procedure Set_Delay_Subprogram_Descriptors
(Id
: E
; V
: B
:= True) is
2436 or else Ekind
(Id
) = E_Package
2437 or else Ekind
(Id
) = E_Package_Body
);
2439 end Set_Delay_Subprogram_Descriptors
;
2441 procedure Set_Delta_Value
(Id
: E
; V
: R
) is
2443 pragma Assert
(Is_Fixed_Point_Type
(Id
));
2444 Set_Ureal18
(Id
, V
);
2445 end Set_Delta_Value
;
2447 procedure Set_Dependent_Instances
(Id
: E
; V
: L
) is
2449 pragma Assert
(Is_Generic_Instance
(Id
));
2451 end Set_Dependent_Instances
;
2453 procedure Set_Depends_On_Private
(Id
: E
; V
: B
:= True) is
2455 pragma Assert
(Nkind
(Id
) in N_Entity
);
2457 end Set_Depends_On_Private
;
2459 procedure Set_Digits_Value
(Id
: E
; V
: U
) is
2462 (Is_Floating_Point_Type
(Id
)
2463 or else Is_Decimal_Fixed_Point_Type
(Id
));
2465 end Set_Digits_Value
;
2467 procedure Set_Directly_Designated_Type
(Id
: E
; V
: E
) is
2470 end Set_Directly_Designated_Type
;
2472 procedure Set_Discard_Names
(Id
: E
; V
: B
:= True) is
2475 end Set_Discard_Names
;
2477 procedure Set_Discriminal
(Id
: E
; V
: E
) is
2479 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
2481 end Set_Discriminal
;
2483 procedure Set_Discriminal_Link
(Id
: E
; V
: E
) is
2486 end Set_Discriminal_Link
;
2488 procedure Set_Discriminant_Checking_Func
(Id
: E
; V
: E
) is
2491 (Ekind
(Id
) = E_Component
and Ekind
(Scope
(Id
)) in Record_Kind
);
2493 end Set_Discriminant_Checking_Func
;
2495 procedure Set_Discriminant_Constraint
(Id
: E
; V
: L
) is
2497 pragma Assert
(Nkind
(Id
) in N_Entity
);
2498 Set_Elist21
(Id
, V
);
2499 end Set_Discriminant_Constraint
;
2501 procedure Set_Discriminant_Default_Value
(Id
: E
; V
: N
) is
2504 end Set_Discriminant_Default_Value
;
2506 procedure Set_Discriminant_Number
(Id
: E
; V
: U
) is
2509 end Set_Discriminant_Number
;
2511 procedure Set_DT_Entry_Count
(Id
: E
; V
: U
) is
2513 pragma Assert
(Ekind
(Id
) = E_Component
);
2515 end Set_DT_Entry_Count
;
2517 procedure Set_DT_Position
(Id
: E
; V
: U
) is
2519 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
2521 end Set_DT_Position
;
2523 procedure Set_DTC_Entity
(Id
: E
; V
: E
) is
2526 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
2530 procedure Set_Elaborate_All_Desirable
(Id
: E
; V
: B
:= True) is
2532 Set_Flag146
(Id
, V
);
2533 end Set_Elaborate_All_Desirable
;
2535 procedure Set_Elaboration_Entity
(Id
: E
; V
: E
) is
2540 Ekind
(Id
) = E_Package
2542 Is_Generic_Unit
(Id
));
2544 end Set_Elaboration_Entity
;
2546 procedure Set_Elaboration_Entity_Required
(Id
: E
; V
: B
:= True) is
2551 Ekind
(Id
) = E_Package
2553 Is_Generic_Unit
(Id
));
2554 Set_Flag174
(Id
, V
);
2555 end Set_Elaboration_Entity_Required
;
2557 procedure Set_Enclosing_Scope
(Id
: E
; V
: E
) is
2560 end Set_Enclosing_Scope
;
2562 procedure Set_Entry_Accepted
(Id
: E
; V
: B
:= True) is
2564 pragma Assert
(Is_Entry
(Id
));
2565 Set_Flag152
(Id
, V
);
2566 end Set_Entry_Accepted
;
2568 procedure Set_Entry_Bodies_Array
(Id
: E
; V
: E
) is
2571 end Set_Entry_Bodies_Array
;
2573 procedure Set_Entry_Cancel_Parameter
(Id
: E
; V
: E
) is
2576 end Set_Entry_Cancel_Parameter
;
2578 procedure Set_Entry_Component
(Id
: E
; V
: E
) is
2581 end Set_Entry_Component
;
2583 procedure Set_Entry_Formal
(Id
: E
; V
: E
) is
2586 end Set_Entry_Formal
;
2588 procedure Set_Entry_Index_Constant
(Id
: E
; V
: E
) is
2590 pragma Assert
(Ekind
(Id
) = E_Entry_Index_Parameter
);
2592 end Set_Entry_Index_Constant
;
2594 procedure Set_Entry_Parameters_Type
(Id
: E
; V
: E
) is
2597 end Set_Entry_Parameters_Type
;
2599 procedure Set_Enum_Pos_To_Rep
(Id
: E
; V
: E
) is
2601 pragma Assert
(Ekind
(Id
) = E_Enumeration_Type
);
2603 end Set_Enum_Pos_To_Rep
;
2605 procedure Set_Enumeration_Pos
(Id
: E
; V
: U
) is
2607 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
2609 end Set_Enumeration_Pos
;
2611 procedure Set_Enumeration_Rep
(Id
: E
; V
: U
) is
2613 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
2615 end Set_Enumeration_Rep
;
2617 procedure Set_Enumeration_Rep_Expr
(Id
: E
; V
: N
) is
2619 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
2621 end Set_Enumeration_Rep_Expr
;
2623 procedure Set_Equivalent_Type
(Id
: E
; V
: E
) is
2626 (Ekind
(Id
) = E_Class_Wide_Type
or else
2627 Ekind
(Id
) = E_Class_Wide_Subtype
or else
2628 Ekind
(Id
) = E_Access_Protected_Subprogram_Type
or else
2629 Ekind
(Id
) = E_Access_Subprogram_Type
or else
2630 Ekind
(Id
) = E_Exception_Type
);
2632 end Set_Equivalent_Type
;
2634 procedure Set_Esize
(Id
: E
; V
: U
) is
2639 procedure Set_Exception_Code
(Id
: E
; V
: U
) is
2641 pragma Assert
(Ekind
(Id
) = E_Exception
);
2643 end Set_Exception_Code
;
2645 procedure Set_Extra_Accessibility
(Id
: E
; V
: E
) is
2647 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
2649 end Set_Extra_Accessibility
;
2651 procedure Set_Extra_Constrained
(Id
: E
; V
: E
) is
2653 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
2655 end Set_Extra_Constrained
;
2657 procedure Set_Extra_Formal
(Id
: E
; V
: E
) is
2660 end Set_Extra_Formal
;
2662 procedure Set_Finalization_Chain_Entity
(Id
: E
; V
: E
) is
2665 end Set_Finalization_Chain_Entity
;
2667 procedure Set_Finalize_Storage_Only
(Id
: E
; V
: B
:= True) is
2669 pragma Assert
(Is_Type
(Id
));
2670 Set_Flag158
(Base_Type
(Id
), V
);
2671 end Set_Finalize_Storage_Only
;
2673 procedure Set_First_Entity
(Id
: E
; V
: E
) is
2676 end Set_First_Entity
;
2678 procedure Set_First_Index
(Id
: E
; V
: N
) is
2681 end Set_First_Index
;
2683 procedure Set_First_Literal
(Id
: E
; V
: E
) is
2686 end Set_First_Literal
;
2688 procedure Set_First_Optional_Parameter
(Id
: E
; V
: E
) is
2691 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
2693 end Set_First_Optional_Parameter
;
2695 procedure Set_First_Private_Entity
(Id
: E
; V
: E
) is
2697 pragma Assert
(Nkind
(Id
) in N_Entity
);
2699 end Set_First_Private_Entity
;
2701 procedure Set_First_Rep_Item
(Id
: E
; V
: N
) is
2704 end Set_First_Rep_Item
;
2706 procedure Set_Freeze_Node
(Id
: E
; V
: N
) is
2709 end Set_Freeze_Node
;
2711 procedure Set_From_With_Type
(Id
: E
; V
: B
:= True) is
2715 or else Ekind
(Id
) = E_Package
);
2716 Set_Flag159
(Id
, V
);
2717 end Set_From_With_Type
;
2719 procedure Set_Full_View
(Id
: E
; V
: E
) is
2721 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Constant
);
2725 procedure Set_Function_Returns_With_DSP
(Id
: E
; V
: B
:= True) is
2728 (Is_Subprogram
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
2729 Set_Flag169
(Id
, V
);
2730 end Set_Function_Returns_With_DSP
;
2732 procedure Set_Generic_Renamings
(Id
: E
; V
: L
) is
2734 Set_Elist23
(Id
, V
);
2735 end Set_Generic_Renamings
;
2737 procedure Set_Girder_Constraint
(Id
: E
; V
: L
) is
2739 pragma Assert
(Nkind
(Id
) in N_Entity
);
2740 Set_Elist23
(Id
, V
);
2741 end Set_Girder_Constraint
;
2743 procedure Set_Handler_Records
(Id
: E
; V
: S
) is
2746 end Set_Handler_Records
;
2748 procedure Set_Has_Aliased_Components
(Id
: E
; V
: B
:= True) is
2750 pragma Assert
(Base_Type
(Id
) = Id
);
2751 Set_Flag135
(Id
, V
);
2752 end Set_Has_Aliased_Components
;
2754 procedure Set_Has_Alignment_Clause
(Id
: E
; V
: B
:= True) is
2757 end Set_Has_Alignment_Clause
;
2759 procedure Set_Has_All_Calls_Remote
(Id
: E
; V
: B
:= True) is
2762 end Set_Has_All_Calls_Remote
;
2764 procedure Set_Has_Atomic_Components
(Id
: E
; V
: B
:= True) is
2766 pragma Assert
(not Is_Type
(Id
) or else Base_Type
(Id
) = Id
);
2768 end Set_Has_Atomic_Components
;
2770 procedure Set_Has_Biased_Representation
(Id
: E
; V
: B
:= True) is
2773 ((V
= False) or else (Is_Discrete_Type
(Id
) or Is_Object
(Id
)));
2774 Set_Flag139
(Id
, V
);
2775 end Set_Has_Biased_Representation
;
2777 procedure Set_Has_Completion
(Id
: E
; V
: B
:= True) is
2780 end Set_Has_Completion
;
2782 procedure Set_Has_Completion_In_Body
(Id
: E
; V
: B
:= True) is
2784 pragma Assert
(Ekind
(Id
) = E_Incomplete_Type
);
2786 end Set_Has_Completion_In_Body
;
2788 procedure Set_Has_Complex_Representation
(Id
: E
; V
: B
:= True) is
2790 pragma Assert
(Is_Record_Type
(Id
));
2791 Set_Flag140
(Implementation_Base_Type
(Id
), V
);
2792 end Set_Has_Complex_Representation
;
2794 procedure Set_Has_Component_Size_Clause
(Id
: E
; V
: B
:= True) is
2796 pragma Assert
(Is_Array_Type
(Id
));
2797 Set_Flag68
(Implementation_Base_Type
(Id
), V
);
2798 end Set_Has_Component_Size_Clause
;
2800 procedure Set_Has_Controlled_Component
(Id
: E
; V
: B
:= True) is
2802 pragma Assert
(Base_Type
(Id
) = Id
);
2804 end Set_Has_Controlled_Component
;
2806 procedure Set_Has_Controlling_Result
(Id
: E
; V
: B
:= True) is
2809 end Set_Has_Controlling_Result
;
2811 procedure Set_Has_Convention_Pragma
(Id
: E
; V
: B
:= True) is
2813 Set_Flag119
(Id
, V
);
2814 end Set_Has_Convention_Pragma
;
2816 procedure Set_Has_Delayed_Freeze
(Id
: E
; V
: B
:= True) is
2818 pragma Assert
(Nkind
(Id
) in N_Entity
);
2820 end Set_Has_Delayed_Freeze
;
2822 procedure Set_Has_Discriminants
(Id
: E
; V
: B
:= True) is
2824 pragma Assert
(Nkind
(Id
) in N_Entity
);
2826 end Set_Has_Discriminants
;
2828 procedure Set_Has_Enumeration_Rep_Clause
(Id
: E
; V
: B
:= True) is
2830 pragma Assert
(Is_Enumeration_Type
(Id
));
2832 end Set_Has_Enumeration_Rep_Clause
;
2834 procedure Set_Has_Exit
(Id
: E
; V
: B
:= True) is
2839 procedure Set_Has_External_Tag_Rep_Clause
(Id
: E
; V
: B
:= True) is
2841 pragma Assert
(Is_Tagged_Type
(Id
));
2842 Set_Flag110
(Id
, V
);
2843 end Set_Has_External_Tag_Rep_Clause
;
2845 procedure Set_Has_Forward_Instantiation
(Id
: E
; V
: B
:= True) is
2847 Set_Flag175
(Id
, V
);
2848 end Set_Has_Forward_Instantiation
;
2850 procedure Set_Has_Fully_Qualified_Name
(Id
: E
; V
: B
:= True) is
2852 Set_Flag173
(Id
, V
);
2853 end Set_Has_Fully_Qualified_Name
;
2855 procedure Set_Has_Gigi_Rep_Item
(Id
: E
; V
: B
:= True) is
2858 end Set_Has_Gigi_Rep_Item
;
2860 procedure Set_Has_Homonym
(Id
: E
; V
: B
:= True) is
2863 end Set_Has_Homonym
;
2865 procedure Set_Has_Machine_Radix_Clause
(Id
: E
; V
: B
:= True) is
2867 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
2869 end Set_Has_Machine_Radix_Clause
;
2871 procedure Set_Has_Master_Entity
(Id
: E
; V
: B
:= True) is
2874 end Set_Has_Master_Entity
;
2876 procedure Set_Has_Missing_Return
(Id
: E
; V
: B
:= True) is
2879 (Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Generic_Function
);
2880 Set_Flag142
(Id
, V
);
2881 end Set_Has_Missing_Return
;
2883 procedure Set_Has_Nested_Block_With_Handler
(Id
: E
; V
: B
:= True) is
2885 Set_Flag101
(Id
, V
);
2886 end Set_Has_Nested_Block_With_Handler
;
2888 procedure Set_Has_Non_Standard_Rep
(Id
: E
; V
: B
:= True) is
2890 pragma Assert
(Base_Type
(Id
) = Id
);
2892 end Set_Has_Non_Standard_Rep
;
2894 procedure Set_Has_Object_Size_Clause
(Id
: E
; V
: B
:= True) is
2896 pragma Assert
(Is_Type
(Id
));
2897 Set_Flag172
(Id
, V
);
2898 end Set_Has_Object_Size_Clause
;
2900 procedure Set_Has_Per_Object_Constraint
(Id
: E
; V
: B
:= True) is
2902 Set_Flag154
(Id
, V
);
2903 end Set_Has_Per_Object_Constraint
;
2905 procedure Set_Has_Pragma_Controlled
(Id
: E
; V
: B
:= True) is
2907 pragma Assert
(Is_Access_Type
(Id
));
2908 Set_Flag27
(Base_Type
(Id
), V
);
2909 end Set_Has_Pragma_Controlled
;
2911 procedure Set_Has_Pragma_Elaborate_Body
(Id
: E
; V
: B
:= True) is
2913 Set_Flag150
(Id
, V
);
2914 end Set_Has_Pragma_Elaborate_Body
;
2916 procedure Set_Has_Pragma_Inline
(Id
: E
; V
: B
:= True) is
2918 Set_Flag157
(Id
, V
);
2919 end Set_Has_Pragma_Inline
;
2921 procedure Set_Has_Pragma_Pack
(Id
: E
; V
: B
:= True) is
2923 pragma Assert
(Is_Array_Type
(Id
) or else Is_Record_Type
(Id
));
2924 Set_Flag121
(Implementation_Base_Type
(Id
), V
);
2925 end Set_Has_Pragma_Pack
;
2927 procedure Set_Has_Primitive_Operations
(Id
: E
; V
: B
:= True) is
2929 pragma Assert
(Is_Type
(Id
));
2930 Set_Flag120
(Base_Type
(Id
), V
);
2931 end Set_Has_Primitive_Operations
;
2933 procedure Set_Has_Private_Declaration
(Id
: E
; V
: B
:= True) is
2935 Set_Flag155
(Id
, V
);
2936 end Set_Has_Private_Declaration
;
2938 procedure Set_Has_Qualified_Name
(Id
: E
; V
: B
:= True) is
2940 Set_Flag161
(Id
, V
);
2941 end Set_Has_Qualified_Name
;
2943 procedure Set_Has_Record_Rep_Clause
(Id
: E
; V
: B
:= True) is
2945 pragma Assert
(Is_Record_Type
(Id
));
2947 end Set_Has_Record_Rep_Clause
;
2949 procedure Set_Has_Recursive_Call
(Id
: E
; V
: B
:= True) is
2951 pragma Assert
(Is_Subprogram
(Id
));
2952 Set_Flag143
(Id
, V
);
2953 end Set_Has_Recursive_Call
;
2955 procedure Set_Has_Size_Clause
(Id
: E
; V
: B
:= True) is
2958 end Set_Has_Size_Clause
;
2960 procedure Set_Has_Small_Clause
(Id
: E
; V
: B
:= True) is
2963 end Set_Has_Small_Clause
;
2965 procedure Set_Has_Specified_Layout
(Id
: E
; V
: B
:= True) is
2967 pragma Assert
(Is_Type
(Id
));
2968 Set_Flag100
(Id
, V
);
2969 end Set_Has_Specified_Layout
;
2971 procedure Set_Has_Storage_Size_Clause
(Id
: E
; V
: B
:= True) is
2973 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
2974 pragma Assert
(Base_Type
(Id
) = Id
);
2976 end Set_Has_Storage_Size_Clause
;
2978 procedure Set_Has_Subprogram_Descriptor
(Id
: E
; V
: B
:= True) is
2981 end Set_Has_Subprogram_Descriptor
;
2983 procedure Set_Has_Task
(Id
: E
; V
: B
:= True) is
2985 pragma Assert
(Base_Type
(Id
) = Id
);
2989 procedure Set_Has_Unchecked_Union
(Id
: E
; V
: B
:= True) is
2991 pragma Assert
(Base_Type
(Id
) = Id
);
2992 Set_Flag123
(Id
, V
);
2993 end Set_Has_Unchecked_Union
;
2995 procedure Set_Has_Unknown_Discriminants
(Id
: E
; V
: B
:= True) is
2997 pragma Assert
(Is_Type
(Id
));
2999 end Set_Has_Unknown_Discriminants
;
3001 procedure Set_Has_Volatile_Components
(Id
: E
; V
: B
:= True) is
3003 pragma Assert
(not Is_Type
(Id
) or else Base_Type
(Id
) = Id
);
3005 end Set_Has_Volatile_Components
;
3007 procedure Set_Hiding_Loop_Variable
(Id
: E
; V
: E
) is
3009 pragma Assert
(Ekind
(Id
) = E_Variable
);
3011 end Set_Hiding_Loop_Variable
;
3013 procedure Set_Homonym
(Id
: E
; V
: E
) is
3015 pragma Assert
(Id
/= V
);
3018 procedure Set_In_Package_Body
(Id
: E
; V
: B
:= True) is
3021 end Set_In_Package_Body
;
3023 procedure Set_In_Private_Part
(Id
: E
; V
: B
:= True) is
3026 end Set_In_Private_Part
;
3028 procedure Set_In_Use
(Id
: E
; V
: B
:= True) is
3030 pragma Assert
(Nkind
(Id
) in N_Entity
);
3034 procedure Set_Inner_Instances
(Id
: E
; V
: L
) is
3036 Set_Elist23
(Id
, V
);
3037 end Set_Inner_Instances
;
3039 procedure Set_Interface_Name
(Id
: E
; V
: N
) is
3042 end Set_Interface_Name
;
3044 procedure Set_Is_Abstract
(Id
: E
; V
: B
:= True) is
3047 end Set_Is_Abstract
;
3049 procedure Set_Is_Access_Constant
(Id
: E
; V
: B
:= True) is
3051 pragma Assert
(Is_Access_Type
(Id
));
3053 end Set_Is_Access_Constant
;
3055 procedure Set_Is_Aliased
(Id
: E
; V
: B
:= True) is
3057 pragma Assert
(Nkind
(Id
) in N_Entity
);
3061 procedure Set_Is_AST_Entry
(Id
: E
; V
: B
:= True) is
3063 pragma Assert
(Is_Entry
(Id
));
3064 Set_Flag132
(Id
, V
);
3065 end Set_Is_AST_Entry
;
3067 procedure Set_Is_Asynchronous
(Id
: E
; V
: B
:= True) is
3070 (Ekind
(Id
) = E_Procedure
or else Is_Type
(Id
));
3072 end Set_Is_Asynchronous
;
3074 procedure Set_Is_Atomic
(Id
: E
; V
: B
:= True) is
3079 procedure Set_Is_Bit_Packed_Array
(Id
: E
; V
: B
:= True) is
3081 Set_Flag122
(Implementation_Base_Type
(Id
), V
);
3082 end Set_Is_Bit_Packed_Array
;
3084 procedure Set_Is_Called
(Id
: E
; V
: B
:= True) is
3087 (Ekind
(Id
) = E_Procedure
or else Ekind
(Id
) = E_Function
);
3088 Set_Flag102
(Id
, V
);
3091 procedure Set_Is_Character_Type
(Id
: E
; V
: B
:= True) is
3094 end Set_Is_Character_Type
;
3096 procedure Set_Is_Child_Unit
(Id
: E
; V
: B
:= True) is
3099 end Set_Is_Child_Unit
;
3101 procedure Set_Is_Compilation_Unit
(Id
: E
; V
: B
:= True) is
3103 Set_Flag149
(Id
, V
);
3104 end Set_Is_Compilation_Unit
;
3106 procedure Set_Is_Completely_Hidden
(Id
: E
; V
: B
:= True) is
3108 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
3109 Set_Flag103
(Id
, V
);
3110 end Set_Is_Completely_Hidden
;
3112 procedure Set_Is_Concurrent_Record_Type
(Id
: E
; V
: B
:= True) is
3115 end Set_Is_Concurrent_Record_Type
;
3117 procedure Set_Is_Constr_Subt_For_U_Nominal
(Id
: E
; V
: B
:= True) is
3120 end Set_Is_Constr_Subt_For_U_Nominal
;
3122 procedure Set_Is_Constr_Subt_For_UN_Aliased
(Id
: E
; V
: B
:= True) is
3124 Set_Flag141
(Id
, V
);
3125 end Set_Is_Constr_Subt_For_UN_Aliased
;
3127 procedure Set_Is_Constrained
(Id
: E
; V
: B
:= True) is
3129 pragma Assert
(Nkind
(Id
) in N_Entity
);
3131 end Set_Is_Constrained
;
3133 procedure Set_Is_Constructor
(Id
: E
; V
: B
:= True) is
3136 end Set_Is_Constructor
;
3138 procedure Set_Is_Controlled
(Id
: E
; V
: B
:= True) is
3140 pragma Assert
(Id
= Base_Type
(Id
));
3142 end Set_Is_Controlled
;
3144 procedure Set_Is_Controlling_Formal
(Id
: E
; V
: B
:= True) is
3146 pragma Assert
(Is_Formal
(Id
));
3148 end Set_Is_Controlling_Formal
;
3150 procedure Set_Is_CPP_Class
(Id
: E
; V
: B
:= True) is
3153 end Set_Is_CPP_Class
;
3155 procedure Set_Is_Destructor
(Id
: E
; V
: B
:= True) is
3158 end Set_Is_Destructor
;
3160 procedure Set_Is_Discrim_SO_Function
(Id
: E
; V
: B
:= True) is
3162 Set_Flag176
(Id
, V
);
3163 end Set_Is_Discrim_SO_Function
;
3165 procedure Set_Is_Dispatching_Operation
(Id
: E
; V
: B
:= True) is
3170 Is_Overloadable
(Id
)
3172 Ekind
(Id
) = E_Subprogram_Type
);
3175 end Set_Is_Dispatching_Operation
;
3177 procedure Set_Is_Eliminated
(Id
: E
; V
: B
:= True) is
3179 Set_Flag124
(Id
, V
);
3180 end Set_Is_Eliminated
;
3182 procedure Set_Is_Entry_Formal
(Id
: E
; V
: B
:= True) is
3185 end Set_Is_Entry_Formal
;
3187 procedure Set_Is_Exported
(Id
: E
; V
: B
:= True) is
3190 end Set_Is_Exported
;
3192 procedure Set_Is_First_Subtype
(Id
: E
; V
: B
:= True) is
3195 end Set_Is_First_Subtype
;
3197 procedure Set_Is_For_Access_Subtype
(Id
: E
; V
: B
:= True) is
3200 (Ekind
(Id
) = E_Record_Subtype
3202 Ekind
(Id
) = E_Private_Subtype
);
3203 Set_Flag118
(Id
, V
);
3204 end Set_Is_For_Access_Subtype
;
3206 procedure Set_Is_Formal_Subprogram
(Id
: E
; V
: B
:= True) is
3208 Set_Flag111
(Id
, V
);
3209 end Set_Is_Formal_Subprogram
;
3211 procedure Set_Is_Frozen
(Id
: E
; V
: B
:= True) is
3213 pragma Assert
(Nkind
(Id
) in N_Entity
);
3217 procedure Set_Is_Generic_Actual_Type
(Id
: E
; V
: B
:= True) is
3219 pragma Assert
(Is_Type
(Id
));
3221 end Set_Is_Generic_Actual_Type
;
3223 procedure Set_Is_Generic_Instance
(Id
: E
; V
: B
:= True) is
3225 Set_Flag130
(Id
, V
);
3226 end Set_Is_Generic_Instance
;
3228 procedure Set_Is_Generic_Type
(Id
: E
; V
: B
:= True) is
3230 pragma Assert
(Nkind
(Id
) in N_Entity
);
3232 end Set_Is_Generic_Type
;
3234 procedure Set_Is_Hidden
(Id
: E
; V
: B
:= True) is
3239 procedure Set_Is_Hidden_Open_Scope
(Id
: E
; V
: B
:= True) is
3241 Set_Flag171
(Id
, V
);
3242 end Set_Is_Hidden_Open_Scope
;
3244 procedure Set_Is_Immediately_Visible
(Id
: E
; V
: B
:= True) is
3246 pragma Assert
(Nkind
(Id
) in N_Entity
);
3248 end Set_Is_Immediately_Visible
;
3250 procedure Set_Is_Imported
(Id
: E
; V
: B
:= True) is
3253 end Set_Is_Imported
;
3255 procedure Set_Is_Inlined
(Id
: E
; V
: B
:= True) is
3260 procedure Set_Is_Instantiated
(Id
: E
; V
: B
:= True) is
3262 Set_Flag126
(Id
, V
);
3263 end Set_Is_Instantiated
;
3265 procedure Set_Is_Internal
(Id
: E
; V
: B
:= True) is
3267 pragma Assert
(Nkind
(Id
) in N_Entity
);
3269 end Set_Is_Internal
;
3271 procedure Set_Is_Interrupt_Handler
(Id
: E
; V
: B
:= True) is
3273 pragma Assert
(Nkind
(Id
) in N_Entity
);
3275 end Set_Is_Interrupt_Handler
;
3277 procedure Set_Is_Intrinsic_Subprogram
(Id
: E
; V
: B
:= True) is
3280 end Set_Is_Intrinsic_Subprogram
;
3282 procedure Set_Is_Itype
(Id
: E
; V
: B
:= True) is
3287 procedure Set_Is_Known_Valid
(Id
: E
; V
: B
:= True) is
3289 Set_Flag170
(Id
, V
);
3290 end Set_Is_Known_Valid
;
3292 procedure Set_Is_Limited_Composite
(Id
: E
; V
: B
:= True) is
3294 pragma Assert
(Is_Type
(Id
));
3295 Set_Flag106
(Id
, V
);
3296 end Set_Is_Limited_Composite
;
3298 procedure Set_Is_Limited_Record
(Id
: E
; V
: B
:= True) is
3301 end Set_Is_Limited_Record
;
3303 procedure Set_Is_Machine_Code_Subprogram
(Id
: E
; V
: B
:= True) is
3305 pragma Assert
(Is_Subprogram
(Id
));
3306 Set_Flag137
(Id
, V
);
3307 end Set_Is_Machine_Code_Subprogram
;
3309 procedure Set_Is_Non_Static_Subtype
(Id
: E
; V
: B
:= True) is
3311 pragma Assert
(Is_Type
(Id
));
3312 Set_Flag109
(Id
, V
);
3313 end Set_Is_Non_Static_Subtype
;
3315 procedure Set_Is_Null_Init_Proc
(Id
: E
; V
: B
:= True) is
3317 pragma Assert
(Ekind
(Id
) = E_Procedure
);
3318 Set_Flag178
(Id
, V
);
3319 end Set_Is_Null_Init_Proc
;
3321 procedure Set_Is_Optional_Parameter
(Id
: E
; V
: B
:= True) is
3323 pragma Assert
(Is_Formal
(Id
));
3324 Set_Flag134
(Id
, V
);
3325 end Set_Is_Optional_Parameter
;
3327 procedure Set_Is_Package_Body_Entity
(Id
: E
; V
: B
:= True) is
3329 Set_Flag160
(Id
, V
);
3330 end Set_Is_Package_Body_Entity
;
3332 procedure Set_Is_Packed
(Id
: E
; V
: B
:= True) is
3334 pragma Assert
(Base_Type
(Id
) = Id
);
3338 procedure Set_Is_Packed_Array_Type
(Id
: E
; V
: B
:= True) is
3340 Set_Flag138
(Id
, V
);
3341 end Set_Is_Packed_Array_Type
;
3343 procedure Set_Is_Potentially_Use_Visible
(Id
: E
; V
: B
:= True) is
3345 pragma Assert
(Nkind
(Id
) in N_Entity
);
3347 end Set_Is_Potentially_Use_Visible
;
3349 procedure Set_Is_Preelaborated
(Id
: E
; V
: B
:= True) is
3352 end Set_Is_Preelaborated
;
3354 procedure Set_Is_Private_Composite
(Id
: E
; V
: B
:= True) is
3356 pragma Assert
(Is_Type
(Id
));
3357 Set_Flag107
(Id
, V
);
3358 end Set_Is_Private_Composite
;
3360 procedure Set_Is_Private_Descendant
(Id
: E
; V
: B
:= True) is
3363 end Set_Is_Private_Descendant
;
3365 procedure Set_Is_Psected
(Id
: E
; V
: B
:= True) is
3367 Set_Flag153
(Id
, V
);
3370 procedure Set_Is_Public
(Id
: E
; V
: B
:= True) is
3372 pragma Assert
(Nkind
(Id
) in N_Entity
);
3376 procedure Set_Is_Pure
(Id
: E
; V
: B
:= True) is
3381 procedure Set_Is_Remote_Call_Interface
(Id
: E
; V
: B
:= True) is
3384 end Set_Is_Remote_Call_Interface
;
3386 procedure Set_Is_Remote_Types
(Id
: E
; V
: B
:= True) is
3389 end Set_Is_Remote_Types
;
3391 procedure Set_Is_Renaming_Of_Object
(Id
: E
; V
: B
:= True) is
3393 Set_Flag112
(Id
, V
);
3394 end Set_Is_Renaming_Of_Object
;
3396 procedure Set_Is_Shared_Passive
(Id
: E
; V
: B
:= True) is
3399 end Set_Is_Shared_Passive
;
3401 procedure Set_Is_Statically_Allocated
(Id
: E
; V
: B
:= True) is
3404 (Ekind
(Id
) = E_Exception
3405 or else Ekind
(Id
) = E_Variable
3406 or else Ekind
(Id
) = E_Constant
3407 or else Is_Type
(Id
)
3408 or else Ekind
(Id
) = E_Void
);
3410 end Set_Is_Statically_Allocated
;
3412 procedure Set_Is_Tag
(Id
: E
; V
: B
:= True) is
3414 pragma Assert
(Nkind
(Id
) in N_Entity
);
3418 procedure Set_Is_Tagged_Type
(Id
: E
; V
: B
:= True) is
3421 end Set_Is_Tagged_Type
;
3423 procedure Set_Is_True_Constant
(Id
: E
; V
: B
:= True) is
3425 Set_Flag163
(Id
, V
);
3426 end Set_Is_True_Constant
;
3428 procedure Set_Is_Unchecked_Union
(Id
: E
; V
: B
:= True) is
3430 pragma Assert
(Base_Type
(Id
) = Id
);
3431 Set_Flag117
(Id
, V
);
3432 end Set_Is_Unchecked_Union
;
3434 procedure Set_Is_Unsigned_Type
(Id
: E
; V
: B
:= True) is
3436 pragma Assert
(Is_Discrete_Or_Fixed_Point_Type
(Id
));
3437 Set_Flag144
(Id
, V
);
3438 end Set_Is_Unsigned_Type
;
3440 procedure Set_Is_Valued_Procedure
(Id
: E
; V
: B
:= True) is
3442 pragma Assert
(Ekind
(Id
) = E_Procedure
);
3443 Set_Flag127
(Id
, V
);
3444 end Set_Is_Valued_Procedure
;
3446 procedure Set_Is_Visible_Child_Unit
(Id
: E
; V
: B
:= True) is
3448 pragma Assert
(Is_Child_Unit
(Id
));
3449 Set_Flag116
(Id
, V
);
3450 end Set_Is_Visible_Child_Unit
;
3452 procedure Set_Is_VMS_Exception
(Id
: E
; V
: B
:= True) is
3454 pragma Assert
(Ekind
(Id
) = E_Exception
);
3455 Set_Flag133
(Id
, V
);
3456 end Set_Is_VMS_Exception
;
3458 procedure Set_Is_Volatile
(Id
: E
; V
: B
:= True) is
3460 pragma Assert
(Nkind
(Id
) in N_Entity
);
3462 end Set_Is_Volatile
;
3464 procedure Set_Last_Entity
(Id
: E
; V
: E
) is
3467 end Set_Last_Entity
;
3469 procedure Set_Lit_Indexes
(Id
: E
; V
: E
) is
3471 pragma Assert
(Is_Enumeration_Type
(Id
) and then Root_Type
(Id
) = Id
);
3473 end Set_Lit_Indexes
;
3475 procedure Set_Lit_Strings
(Id
: E
; V
: E
) is
3477 pragma Assert
(Is_Enumeration_Type
(Id
) and then Root_Type
(Id
) = Id
);
3479 end Set_Lit_Strings
;
3481 procedure Set_Machine_Radix_10
(Id
: E
; V
: B
:= True) is
3483 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
3485 end Set_Machine_Radix_10
;
3487 procedure Set_Master_Id
(Id
: E
; V
: E
) is
3492 procedure Set_Materialize_Entity
(Id
: E
; V
: B
:= True) is
3494 Set_Flag168
(Id
, V
);
3495 end Set_Materialize_Entity
;
3497 procedure Set_Mechanism
(Id
: E
; V
: M
) is
3499 pragma Assert
(Ekind
(Id
) = E_Function
or else Is_Formal
(Id
));
3500 Set_Uint8
(Id
, UI_From_Int
(V
));
3503 procedure Set_Modulus
(Id
: E
; V
: U
) is
3505 pragma Assert
(Ekind
(Id
) = E_Modular_Integer_Type
);
3509 procedure Set_Needs_Debug_Info
(Id
: E
; V
: B
:= True) is
3511 Set_Flag147
(Id
, V
);
3512 end Set_Needs_Debug_Info
;
3514 procedure Set_Needs_No_Actuals
(Id
: E
; V
: B
:= True) is
3517 (Is_Overloadable
(Id
)
3518 or else Ekind
(Id
) = E_Subprogram_Type
3519 or else Ekind
(Id
) = E_Entry_Family
);
3521 end Set_Needs_No_Actuals
;
3523 procedure Set_Next_Inlined_Subprogram
(Id
: E
; V
: E
) is
3526 end Set_Next_Inlined_Subprogram
;
3528 procedure Set_No_Pool_Assigned
(Id
: E
; V
: B
:= True) is
3530 pragma Assert
(Is_Access_Type
(Id
) and then Root_Type
(Id
) = Id
);
3531 Set_Flag131
(Id
, V
);
3532 end Set_No_Pool_Assigned
;
3534 procedure Set_No_Return
(Id
: E
; V
: B
:= True) is
3537 (Ekind
(Id
) = E_Procedure
or else Ekind
(Id
) = E_Generic_Procedure
);
3538 Set_Flag113
(Id
, V
);
3541 procedure Set_Non_Binary_Modulus
(Id
: E
; V
: B
:= True) is
3543 pragma Assert
(Ekind
(Id
) = E_Modular_Integer_Type
);
3545 end Set_Non_Binary_Modulus
;
3547 procedure Set_Nonzero_Is_True
(Id
: E
; V
: B
:= True) is
3550 (Root_Type
(Id
) = Standard_Boolean
3551 and then Ekind
(Id
) = E_Enumeration_Type
);
3552 Set_Flag162
(Id
, V
);
3553 end Set_Nonzero_Is_True
;
3555 procedure Set_Normalized_First_Bit
(Id
: E
; V
: U
) is
3558 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
3560 end Set_Normalized_First_Bit
;
3562 procedure Set_Normalized_Position
(Id
: E
; V
: U
) is
3565 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
3567 end Set_Normalized_Position
;
3569 procedure Set_Normalized_Position_Max
(Id
: E
; V
: U
) is
3572 (Ekind
(Id
) = E_Component
or else Ekind
(Id
) = E_Discriminant
);
3574 end Set_Normalized_Position_Max
;
3576 procedure Set_Not_Source_Assigned
(Id
: E
; V
: B
:= True) is
3578 Set_Flag115
(Id
, V
);
3579 end Set_Not_Source_Assigned
;
3581 procedure Set_Object_Ref
(Id
: E
; V
: E
) is
3583 pragma Assert
(Ekind
(Id
) = E_Protected_Body
);
3587 procedure Set_Original_Record_Component
(Id
: E
; V
: E
) is
3590 end Set_Original_Record_Component
;
3592 procedure Set_Packed_Array_Type
(Id
: E
; V
: E
) is
3594 pragma Assert
(Is_Array_Type
(Id
));
3596 end Set_Packed_Array_Type
;
3598 procedure Set_Parent_Subtype
(Id
: E
; V
: E
) is
3600 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
3602 end Set_Parent_Subtype
;
3604 procedure Set_Primitive_Operations
(Id
: E
; V
: L
) is
3606 pragma Assert
(Is_Tagged_Type
(Id
));
3607 Set_Elist15
(Id
, V
);
3608 end Set_Primitive_Operations
;
3610 procedure Set_Prival
(Id
: E
; V
: E
) is
3612 pragma Assert
(Is_Protected_Private
(Id
));
3616 procedure Set_Privals_Chain
(Id
: E
; V
: L
) is
3618 pragma Assert
(Is_Overloadable
(Id
)
3619 or else Ekind
(Id
) = E_Entry_Family
);
3620 Set_Elist23
(Id
, V
);
3621 end Set_Privals_Chain
;
3623 procedure Set_Private_Dependents
(Id
: E
; V
: L
) is
3625 pragma Assert
(Is_Incomplete_Or_Private_Type
(Id
));
3626 Set_Elist18
(Id
, V
);
3627 end Set_Private_Dependents
;
3629 procedure Set_Private_View
(Id
: E
; V
: N
) is
3631 pragma Assert
(Is_Private_Type
(Id
));
3633 end Set_Private_View
;
3635 procedure Set_Protected_Body_Subprogram
(Id
: E
; V
: E
) is
3637 pragma Assert
(Is_Subprogram
(Id
) or else Is_Entry
(Id
));
3639 end Set_Protected_Body_Subprogram
;
3641 procedure Set_Protected_Formal
(Id
: E
; V
: E
) is
3643 pragma Assert
(Is_Formal
(Id
));
3645 end Set_Protected_Formal
;
3647 procedure Set_Protected_Operation
(Id
: E
; V
: N
) is
3649 pragma Assert
(Is_Protected_Private
(Id
));
3651 end Set_Protected_Operation
;
3653 procedure Set_Reachable
(Id
: E
; V
: B
:= True) is
3658 procedure Set_Referenced
(Id
: E
; V
: B
:= True) is
3660 Set_Flag156
(Id
, V
);
3663 procedure Set_Referenced_Object
(Id
: E
; V
: N
) is
3665 pragma Assert
(Is_Type
(Id
));
3667 end Set_Referenced_Object
;
3669 procedure Set_Register_Exception_Call
(Id
: E
; V
: N
) is
3671 pragma Assert
(Ekind
(Id
) = E_Exception
);
3673 end Set_Register_Exception_Call
;
3675 procedure Set_Related_Array_Object
(Id
: E
; V
: E
) is
3677 pragma Assert
(Is_Array_Type
(Id
));
3679 end Set_Related_Array_Object
;
3681 procedure Set_Related_Instance
(Id
: E
; V
: E
) is
3683 pragma Assert
(Ekind
(Id
) = E_Package
);
3685 end Set_Related_Instance
;
3687 procedure Set_Renamed_Entity
(Id
: E
; V
: N
) is
3690 end Set_Renamed_Entity
;
3692 procedure Set_Renamed_Object
(Id
: E
; V
: N
) is
3695 end Set_Renamed_Object
;
3697 procedure Set_Renaming_Map
(Id
: E
; V
: U
) is
3700 end Set_Renaming_Map
;
3702 procedure Set_Return_Present
(Id
: E
; V
: B
:= True) is
3705 end Set_Return_Present
;
3707 procedure Set_Returns_By_Ref
(Id
: E
; V
: B
:= True) is
3710 end Set_Returns_By_Ref
;
3712 procedure Set_Reverse_Bit_Order
(Id
: E
; V
: B
:= True) is
3715 (Is_Record_Type
(Id
) and then Id
= Base_Type
(Id
));
3716 Set_Flag164
(Id
, V
);
3717 end Set_Reverse_Bit_Order
;
3719 procedure Set_RM_Size
(Id
: E
; V
: U
) is
3721 pragma Assert
(Is_Type
(Id
));
3725 procedure Set_Scalar_Range
(Id
: E
; V
: N
) is
3728 end Set_Scalar_Range
;
3730 procedure Set_Scale_Value
(Id
: E
; V
: U
) is
3733 end Set_Scale_Value
;
3735 procedure Set_Scope_Depth_Value
(Id
: E
; V
: U
) is
3737 pragma Assert
(not Is_Record_Type
(Id
));
3739 end Set_Scope_Depth_Value
;
3741 procedure Set_Sec_Stack_Needed_For_Return
(Id
: E
; V
: B
:= True) is
3743 Set_Flag167
(Id
, V
);
3744 end Set_Sec_Stack_Needed_For_Return
;
3746 procedure Set_Shadow_Entities
(Id
: E
; V
: S
) is
3749 (Ekind
(Id
) = E_Package
or else Ekind
(Id
) = E_Generic_Package
);
3751 end Set_Shadow_Entities
;
3753 procedure Set_Shared_Var_Assign_Proc
(Id
: E
; V
: E
) is
3755 pragma Assert
(Ekind
(Id
) = E_Variable
);
3757 end Set_Shared_Var_Assign_Proc
;
3759 procedure Set_Shared_Var_Read_Proc
(Id
: E
; V
: E
) is
3761 pragma Assert
(Ekind
(Id
) = E_Variable
);
3763 end Set_Shared_Var_Read_Proc
;
3765 procedure Set_Size_Check_Code
(Id
: E
; V
: N
) is
3767 pragma Assert
(Ekind
(Id
) = E_Constant
or else Ekind
(Id
) = E_Variable
);
3769 end Set_Size_Check_Code
;
3771 procedure Set_Size_Depends_On_Discriminant
(Id
: E
; V
: B
:= True) is
3773 Set_Flag177
(Id
, V
);
3774 end Set_Size_Depends_On_Discriminant
;
3776 procedure Set_Size_Known_At_Compile_Time
(Id
: E
; V
: B
:= True) is
3779 end Set_Size_Known_At_Compile_Time
;
3781 procedure Set_Small_Value
(Id
: E
; V
: R
) is
3783 pragma Assert
(Is_Fixed_Point_Type
(Id
));
3784 Set_Ureal21
(Id
, V
);
3785 end Set_Small_Value
;
3787 procedure Set_Spec_Entity
(Id
: E
; V
: E
) is
3789 pragma Assert
(Ekind
(Id
) = E_Package_Body
or else Is_Formal
(Id
));
3791 end Set_Spec_Entity
;
3793 procedure Set_Storage_Size_Variable
(Id
: E
; V
: E
) is
3795 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
3796 pragma Assert
(Base_Type
(Id
) = Id
);
3798 end Set_Storage_Size_Variable
;
3800 procedure Set_Strict_Alignment
(Id
: E
; V
: B
:= True) is
3802 pragma Assert
(Base_Type
(Id
) = Id
);
3803 Set_Flag145
(Id
, V
);
3804 end Set_Strict_Alignment
;
3806 procedure Set_String_Literal_Length
(Id
: E
; V
: U
) is
3808 pragma Assert
(Ekind
(Id
) = E_String_Literal_Subtype
);
3810 end Set_String_Literal_Length
;
3812 procedure Set_String_Literal_Low_Bound
(Id
: E
; V
: N
) is
3814 pragma Assert
(Ekind
(Id
) = E_String_Literal_Subtype
);
3816 end Set_String_Literal_Low_Bound
;
3818 procedure Set_Suppress_Access_Checks
(Id
: E
; V
: B
:= True) is
3821 end Set_Suppress_Access_Checks
;
3823 procedure Set_Suppress_Accessibility_Checks
(Id
: E
; V
: B
:= True) is
3826 end Set_Suppress_Accessibility_Checks
;
3828 procedure Set_Suppress_Discriminant_Checks
(Id
: E
; V
: B
:= True) is
3831 end Set_Suppress_Discriminant_Checks
;
3833 procedure Set_Suppress_Division_Checks
(Id
: E
; V
: B
:= True) is
3836 end Set_Suppress_Division_Checks
;
3838 procedure Set_Suppress_Elaboration_Checks
(Id
: E
; V
: B
:= True) is
3841 end Set_Suppress_Elaboration_Checks
;
3843 procedure Set_Suppress_Elaboration_Warnings
(Id
: E
; V
: B
:= True) is
3845 Set_Flag148
(Id
, V
);
3846 end Set_Suppress_Elaboration_Warnings
;
3848 procedure Set_Suppress_Index_Checks
(Id
: E
; V
: B
:= True) is
3851 end Set_Suppress_Index_Checks
;
3853 procedure Set_Suppress_Init_Proc
(Id
: E
; V
: B
:= True) is
3855 Set_Flag105
(Id
, V
);
3856 end Set_Suppress_Init_Proc
;
3858 procedure Set_Suppress_Length_Checks
(Id
: E
; V
: B
:= True) is
3861 end Set_Suppress_Length_Checks
;
3863 procedure Set_Suppress_Overflow_Checks
(Id
: E
; V
: B
:= True) is
3866 end Set_Suppress_Overflow_Checks
;
3868 procedure Set_Suppress_Range_Checks
(Id
: E
; V
: B
:= True) is
3871 end Set_Suppress_Range_Checks
;
3873 procedure Set_Suppress_Storage_Checks
(Id
: E
; V
: B
:= True) is
3876 end Set_Suppress_Storage_Checks
;
3878 procedure Set_Suppress_Style_Checks
(Id
: E
; V
: B
:= True) is
3880 Set_Flag165
(Id
, V
);
3881 end Set_Suppress_Style_Checks
;
3883 procedure Set_Suppress_Tag_Checks
(Id
: E
; V
: B
:= True) is
3886 end Set_Suppress_Tag_Checks
;
3888 procedure Set_Underlying_Full_View
(Id
: E
; V
: E
) is
3890 pragma Assert
(Ekind
(Id
) in Private_Kind
);
3892 end Set_Underlying_Full_View
;
3894 procedure Set_Unset_Reference
(Id
: E
; V
: N
) is
3897 end Set_Unset_Reference
;
3899 procedure Set_Uses_Sec_Stack
(Id
: E
; V
: B
:= True) is
3902 end Set_Uses_Sec_Stack
;
3904 procedure Set_Vax_Float
(Id
: E
; V
: B
:= True) is
3906 pragma Assert
(Id
= Base_Type
(Id
));
3907 Set_Flag151
(Id
, V
);
3910 procedure Set_Warnings_Off
(Id
: E
; V
: B
:= True) is
3913 end Set_Warnings_Off
;
3915 -----------------------------------
3916 -- Field Initialization Routines --
3917 -----------------------------------
3919 procedure Init_Alignment
(Id
: E
) is
3921 Set_Uint14
(Id
, Uint_0
);
3924 procedure Init_Alignment
(Id
: E
; V
: Int
) is
3926 Set_Uint14
(Id
, UI_From_Int
(V
));
3929 procedure Init_Component_Bit_Offset
(Id
: E
) is
3931 Set_Uint11
(Id
, No_Uint
);
3932 end Init_Component_Bit_Offset
;
3934 procedure Init_Component_Bit_Offset
(Id
: E
; V
: Int
) is
3936 Set_Uint11
(Id
, UI_From_Int
(V
));
3937 end Init_Component_Bit_Offset
;
3939 procedure Init_Component_Size
(Id
: E
) is
3941 Set_Uint22
(Id
, Uint_0
);
3942 end Init_Component_Size
;
3944 procedure Init_Component_Size
(Id
: E
; V
: Int
) is
3946 Set_Uint22
(Id
, UI_From_Int
(V
));
3947 end Init_Component_Size
;
3949 procedure Init_Digits_Value
(Id
: E
) is
3951 Set_Uint17
(Id
, Uint_0
);
3952 end Init_Digits_Value
;
3954 procedure Init_Digits_Value
(Id
: E
; V
: Int
) is
3956 Set_Uint17
(Id
, UI_From_Int
(V
));
3957 end Init_Digits_Value
;
3959 procedure Init_Esize
(Id
: E
) is
3961 Set_Uint12
(Id
, Uint_0
);
3964 procedure Init_Esize
(Id
: E
; V
: Int
) is
3966 Set_Uint12
(Id
, UI_From_Int
(V
));
3969 procedure Init_Normalized_First_Bit
(Id
: E
) is
3971 Set_Uint8
(Id
, No_Uint
);
3972 end Init_Normalized_First_Bit
;
3974 procedure Init_Normalized_First_Bit
(Id
: E
; V
: Int
) is
3976 Set_Uint8
(Id
, UI_From_Int
(V
));
3977 end Init_Normalized_First_Bit
;
3979 procedure Init_Normalized_Position
(Id
: E
) is
3981 Set_Uint9
(Id
, No_Uint
);
3982 end Init_Normalized_Position
;
3984 procedure Init_Normalized_Position
(Id
: E
; V
: Int
) is
3986 Set_Uint9
(Id
, UI_From_Int
(V
));
3987 end Init_Normalized_Position
;
3989 procedure Init_Normalized_Position_Max
(Id
: E
) is
3991 Set_Uint10
(Id
, No_Uint
);
3992 end Init_Normalized_Position_Max
;
3994 procedure Init_Normalized_Position_Max
(Id
: E
; V
: Int
) is
3996 Set_Uint10
(Id
, UI_From_Int
(V
));
3997 end Init_Normalized_Position_Max
;
3999 procedure Init_RM_Size
(Id
: E
) is
4001 Set_Uint13
(Id
, Uint_0
);
4004 procedure Init_RM_Size
(Id
: E
; V
: Int
) is
4006 Set_Uint13
(Id
, UI_From_Int
(V
));
4009 -----------------------------
4010 -- Init_Component_Location --
4011 -----------------------------
4013 procedure Init_Component_Location
(Id
: E
) is
4015 Set_Uint8
(Id
, No_Uint
); -- Normalized_First_Bit
4016 Set_Uint9
(Id
, No_Uint
); -- Normalized_Position
4017 Set_Uint11
(Id
, No_Uint
); -- Component_First_Bit
4018 Set_Uint12
(Id
, Uint_0
); -- Esize
4019 Set_Uint10
(Id
, No_Uint
); -- Normalized_Position_Max
4020 end Init_Component_Location
;
4026 procedure Init_Size
(Id
: E
; V
: Int
) is
4028 Set_Uint12
(Id
, UI_From_Int
(V
)); -- Esize
4029 Set_Uint13
(Id
, UI_From_Int
(V
)); -- RM_Size
4032 ---------------------
4033 -- Init_Size_Align --
4034 ---------------------
4036 procedure Init_Size_Align
(Id
: E
) is
4038 Set_Uint12
(Id
, Uint_0
); -- Esize
4039 Set_Uint13
(Id
, Uint_0
); -- RM_Size
4040 Set_Uint14
(Id
, Uint_0
); -- Alignment
4041 end Init_Size_Align
;
4043 ----------------------------------------------
4044 -- Type Representation Attribute Predicates --
4045 ----------------------------------------------
4047 function Known_Alignment
(E
: Entity_Id
) return B
is
4049 return Uint14
(E
) /= Uint_0
;
4050 end Known_Alignment
;
4052 function Known_Component_Bit_Offset
(E
: Entity_Id
) return B
is
4054 return Uint11
(E
) /= No_Uint
;
4055 end Known_Component_Bit_Offset
;
4057 function Known_Component_Size
(E
: Entity_Id
) return B
is
4059 return Uint22
(Base_Type
(E
)) /= Uint_0
;
4060 end Known_Component_Size
;
4062 function Known_Esize
(E
: Entity_Id
) return B
is
4064 return Uint12
(E
) /= Uint_0
;
4067 function Known_Normalized_First_Bit
(E
: Entity_Id
) return B
is
4069 return Uint8
(E
) /= No_Uint
;
4070 end Known_Normalized_First_Bit
;
4072 function Known_Normalized_Position
(E
: Entity_Id
) return B
is
4074 return Uint9
(E
) /= No_Uint
;
4075 end Known_Normalized_Position
;
4077 function Known_Normalized_Position_Max
(E
: Entity_Id
) return B
is
4079 return Uint10
(E
) /= No_Uint
;
4080 end Known_Normalized_Position_Max
;
4082 function Known_RM_Size
(E
: Entity_Id
) return B
is
4084 return Uint13
(E
) /= Uint_0
4085 or else Is_Discrete_Type
(E
);
4088 function Known_Static_Component_Bit_Offset
(E
: Entity_Id
) return B
is
4090 return Uint11
(E
) /= No_Uint
4091 and then Uint11
(E
) >= Uint_0
;
4092 end Known_Static_Component_Bit_Offset
;
4094 function Known_Static_Component_Size
(E
: Entity_Id
) return B
is
4096 return Uint22
(Base_Type
(E
)) > Uint_0
;
4097 end Known_Static_Component_Size
;
4099 function Known_Static_Esize
(E
: Entity_Id
) return B
is
4101 return Uint12
(E
) > Uint_0
;
4102 end Known_Static_Esize
;
4104 function Known_Static_Normalized_Position
(E
: Entity_Id
) return B
is
4106 return Uint9
(E
) /= No_Uint
4107 and then Uint9
(E
) >= Uint_0
;
4108 end Known_Static_Normalized_Position
;
4110 function Known_Static_Normalized_Position_Max
(E
: Entity_Id
) return B
is
4112 return Uint10
(E
) /= No_Uint
4113 and then Uint10
(E
) >= Uint_0
;
4114 end Known_Static_Normalized_Position_Max
;
4116 function Known_Static_RM_Size
(E
: Entity_Id
) return B
is
4118 return Uint13
(E
) > Uint_0
4119 or else Is_Discrete_Type
(E
);
4120 end Known_Static_RM_Size
;
4122 function Unknown_Alignment
(E
: Entity_Id
) return B
is
4124 return Uint14
(E
) = Uint_0
;
4125 end Unknown_Alignment
;
4127 function Unknown_Component_Bit_Offset
(E
: Entity_Id
) return B
is
4129 return Uint11
(E
) = No_Uint
;
4130 end Unknown_Component_Bit_Offset
;
4132 function Unknown_Component_Size
(E
: Entity_Id
) return B
is
4134 return Uint22
(Base_Type
(E
)) = Uint_0
;
4135 end Unknown_Component_Size
;
4137 function Unknown_Esize
(E
: Entity_Id
) return B
is
4139 return Uint12
(E
) = Uint_0
;
4142 function Unknown_Normalized_First_Bit
(E
: Entity_Id
) return B
is
4144 return Uint8
(E
) = No_Uint
;
4145 end Unknown_Normalized_First_Bit
;
4147 function Unknown_Normalized_Position
(E
: Entity_Id
) return B
is
4149 return Uint9
(E
) = No_Uint
;
4150 end Unknown_Normalized_Position
;
4152 function Unknown_Normalized_Position_Max
(E
: Entity_Id
) return B
is
4154 return Uint10
(E
) = No_Uint
;
4155 end Unknown_Normalized_Position_Max
;
4157 function Unknown_RM_Size
(E
: Entity_Id
) return B
is
4159 return Uint13
(E
) = Uint_0
4160 and then not Is_Discrete_Type
(E
);
4161 end Unknown_RM_Size
;
4163 --------------------
4164 -- Address_Clause --
4165 --------------------
4167 function Address_Clause
(Id
: E
) return N
is
4171 Ritem
:= First_Rep_Item
(Id
);
4172 while Present
(Ritem
) loop
4173 if Nkind
(Ritem
) = N_Attribute_Definition_Clause
4174 and then Chars
(Ritem
) = Name_Address
4178 Ritem
:= Next_Rep_Item
(Ritem
);
4185 ----------------------
4186 -- Alignment_Clause --
4187 ----------------------
4189 function Alignment_Clause
(Id
: E
) return N
is
4193 Ritem
:= First_Rep_Item
(Id
);
4194 while Present
(Ritem
) loop
4195 if Nkind
(Ritem
) = N_Attribute_Definition_Clause
4196 and then Chars
(Ritem
) = Name_Alignment
4200 Ritem
:= Next_Rep_Item
(Ritem
);
4205 end Alignment_Clause
;
4207 ----------------------
4208 -- Ancestor_Subtype --
4209 ----------------------
4211 function Ancestor_Subtype
(Id
: E
) return E
is
4213 -- If this is first subtype, or is a base type, then there is no
4214 -- ancestor subtype, so we return Empty to indicate this fact.
4216 if Is_First_Subtype
(Id
)
4217 or else Id
= Base_Type
(Id
)
4223 D
: constant Node_Id
:= Declaration_Node
(Id
);
4226 -- If we have a subtype declaration, get the ancestor subtype
4228 if Nkind
(D
) = N_Subtype_Declaration
then
4229 if Nkind
(Subtype_Indication
(D
)) = N_Subtype_Indication
then
4230 return Entity
(Subtype_Mark
(Subtype_Indication
(D
)));
4232 return Entity
(Subtype_Indication
(D
));
4235 -- If not, then no subtype indication is available
4241 end Ancestor_Subtype
;
4247 procedure Append_Entity
(Id
: Entity_Id
; V
: Entity_Id
) is
4249 if Last_Entity
(V
) = Empty
then
4250 Set_First_Entity
(V
, Id
);
4252 Set_Next_Entity
(Last_Entity
(V
), Id
);
4255 Set_Next_Entity
(Id
, Empty
);
4257 Set_Last_Entity
(V
, Id
);
4264 function Base_Type
(Id
: E
) return E
is
4267 when E_Enumeration_Subtype |
4268 E_Signed_Integer_Subtype |
4269 E_Modular_Integer_Subtype |
4270 E_Floating_Point_Subtype |
4271 E_Ordinary_Fixed_Point_Subtype |
4272 E_Decimal_Fixed_Point_Subtype |
4277 E_Record_Subtype_With_Private |
4278 E_Limited_Private_Subtype |
4280 E_Protected_Subtype |
4282 E_String_Literal_Subtype |
4283 E_Class_Wide_Subtype
=>
4286 when E_Incomplete_Type
=>
4287 if Present
(Etype
(Id
)) then
4298 -------------------------
4299 -- Component_Alignment --
4300 -------------------------
4302 -- Component Alignment is encoded using two flags, Flag128/129 as
4303 -- follows. Note that both flags False = Align_Default, so that the
4304 -- default initialization of flags to False initializes component
4305 -- alignment to the default value as required.
4307 -- Flag128 Flag129 Value
4308 -- ------- ------- -----
4309 -- False False Calign_Default
4310 -- False True Calign_Component_Size
4311 -- True False Calign_Component_Size_4
4312 -- True True Calign_Storage_Unit
4314 function Component_Alignment
(Id
: E
) return C
is
4315 BT
: Node_Id
:= Base_Type
(Id
);
4318 pragma Assert
(Is_Array_Type
(Id
) or else Is_Record_Type
(Id
));
4320 if Flag128
(BT
) then
4321 if Flag129
(BT
) then
4322 return Calign_Storage_Unit
;
4324 return Calign_Component_Size_4
;
4328 if Flag129
(BT
) then
4329 return Calign_Component_Size
;
4331 return Calign_Default
;
4334 end Component_Alignment
;
4336 --------------------
4337 -- Constant_Value --
4338 --------------------
4340 function Constant_Value
(Id
: E
) return N
is
4341 D
: constant Node_Id
:= Declaration_Node
(Id
);
4345 -- If we have no declaration node, then return no constant value.
4346 -- Not clear how this can happen, but it does sometimes ???
4347 -- To investigate, remove this check and compile discrim_po.adb.
4352 -- Normal case where a declaration node is present
4354 elsif Nkind
(D
) = N_Object_Renaming_Declaration
then
4355 return Renamed_Object
(Id
);
4357 -- If this is a component declaration whose entity is constant, it
4358 -- is a prival within a protected function. It does not have
4359 -- a constant value.
4361 elsif Nkind
(D
) = N_Component_Declaration
then
4365 if Present
(Expression
(D
)) then
4366 return (Expression
(D
));
4368 elsif Present
(Full_View
(Id
)) then
4369 Full_D
:= Parent
(Full_View
(Id
));
4371 -- The full view may have been rewritten as an object renaming.
4373 if Nkind
(Full_D
) = N_Object_Renaming_Declaration
then
4374 return Name
(Full_D
);
4376 return Expression
(Full_D
);
4384 ----------------------
4385 -- Declaration_Node --
4386 ----------------------
4388 function Declaration_Node
(Id
: E
) return N
is
4392 if Ekind
(Id
) = E_Incomplete_Type
4393 and then Present
(Full_View
(Id
))
4395 P
:= Parent
(Full_View
(Id
));
4401 if Nkind
(P
) /= N_Selected_Component
4402 and then Nkind
(P
) /= N_Expanded_Name
4404 not (Nkind
(P
) = N_Defining_Program_Unit_Name
4405 and then Is_Child_Unit
(Id
))
4413 end Declaration_Node
;
4415 ---------------------
4416 -- Designated_Type --
4417 ---------------------
4419 function Designated_Type
(Id
: E
) return E
is
4423 Desig_Type
:= Directly_Designated_Type
(Id
);
4425 if (Ekind
(Desig_Type
) = E_Incomplete_Type
4426 and then Present
(Full_View
(Desig_Type
)))
4428 return Full_View
(Desig_Type
);
4430 elsif Is_Class_Wide_Type
(Desig_Type
)
4431 and then Ekind
(Etype
(Desig_Type
)) = E_Incomplete_Type
4432 and then Present
(Full_View
(Etype
(Desig_Type
)))
4433 and then Present
(Class_Wide_Type
(Full_View
(Etype
(Desig_Type
))))
4435 return Class_Wide_Type
(Full_View
(Etype
(Desig_Type
)));
4440 end Designated_Type
;
4442 -----------------------------
4443 -- Enclosing_Dynamic_Scope --
4444 -----------------------------
4446 function Enclosing_Dynamic_Scope
(Id
: E
) return E
is
4451 while S
/= Standard_Standard
4452 and then not Is_Dynamic_Scope
(S
)
4458 end Enclosing_Dynamic_Scope
;
4460 ----------------------
4461 -- Entry_Index_Type --
4462 ----------------------
4464 function Entry_Index_Type
(Id
: E
) return N
is
4466 pragma Assert
(Ekind
(Id
) = E_Entry_Family
);
4467 return Etype
(Discrete_Subtype_Definition
(Parent
(Id
)));
4468 end Entry_Index_Type
;
4470 ---------------------
4471 -- First_Component --
4472 ---------------------
4474 function First_Component
(Id
: E
) return E
is
4479 (Is_Record_Type
(Id
) or else Is_Incomplete_Or_Private_Type
(Id
));
4481 Comp_Id
:= First_Entity
(Id
);
4483 while Present
(Comp_Id
) loop
4484 exit when Ekind
(Comp_Id
) = E_Component
;
4485 Comp_Id
:= Next_Entity
(Comp_Id
);
4489 end First_Component
;
4491 ------------------------
4492 -- First_Discriminant --
4493 ------------------------
4495 function First_Discriminant
(Id
: E
) return E
is
4500 (Has_Discriminants
(Id
)
4501 or else Has_Unknown_Discriminants
(Id
));
4503 Ent
:= First_Entity
(Id
);
4505 -- The discriminants are not necessarily contiguous, because access
4506 -- discriminants will generate itypes. They are not the first entities
4507 -- either, because tag and controller record must be ahead of them.
4509 if Chars
(Ent
) = Name_uTag
then
4510 Ent
:= Next_Entity
(Ent
);
4513 if Chars
(Ent
) = Name_uController
then
4514 Ent
:= Next_Entity
(Ent
);
4517 -- Skip all hidden girder discriminants if any.
4519 while Present
(Ent
) loop
4520 exit when Ekind
(Ent
) = E_Discriminant
4521 and then not Is_Completely_Hidden
(Ent
);
4523 Ent
:= Next_Entity
(Ent
);
4526 pragma Assert
(Ekind
(Ent
) = E_Discriminant
);
4529 end First_Discriminant
;
4535 function First_Formal
(Id
: E
) return E
is
4540 (Is_Overloadable
(Id
)
4541 or else Ekind
(Id
) = E_Entry_Family
4542 or else Ekind
(Id
) = E_Subprogram_Body
4543 or else Ekind
(Id
) = E_Subprogram_Type
);
4545 if Ekind
(Id
) = E_Enumeration_Literal
then
4549 Formal
:= First_Entity
(Id
);
4551 if Present
(Formal
) and then Is_Formal
(Formal
) then
4559 -------------------------------
4560 -- First_Girder_Discriminant --
4561 -------------------------------
4563 function First_Girder_Discriminant
(Id
: E
) return E
is
4566 function Has_Completely_Hidden_Discriminant
(Id
: E
) return Boolean;
4567 -- Scans the Discriminants to see whether any are Completely_Hidden
4568 -- (the mechanism for describing non-specified girder discriminants)
4570 function Has_Completely_Hidden_Discriminant
(Id
: E
) return Boolean is
4571 Ent
: Entity_Id
:= Id
;
4574 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
4576 while Present
(Ent
) and then Ekind
(Ent
) = E_Discriminant
loop
4578 if Is_Completely_Hidden
(Ent
) then
4582 Ent
:= Next_Entity
(Ent
);
4586 end Has_Completely_Hidden_Discriminant
;
4588 -- Start of processing for First_Girder_Discriminant
4592 (Has_Discriminants
(Id
)
4593 or else Has_Unknown_Discriminants
(Id
));
4595 Ent
:= First_Entity
(Id
);
4597 if Chars
(Ent
) = Name_uTag
then
4598 Ent
:= Next_Entity
(Ent
);
4601 if Chars
(Ent
) = Name_uController
then
4602 Ent
:= Next_Entity
(Ent
);
4605 if Has_Completely_Hidden_Discriminant
(Ent
) then
4607 while Present
(Ent
) loop
4608 exit when Is_Completely_Hidden
(Ent
);
4609 Ent
:= Next_Entity
(Ent
);
4614 pragma Assert
(Ekind
(Ent
) = E_Discriminant
);
4617 end First_Girder_Discriminant
;
4623 function First_Subtype
(Id
: E
) return E
is
4624 B
: constant Entity_Id
:= Base_Type
(Id
);
4625 F
: constant Node_Id
:= Freeze_Node
(B
);
4629 -- If the base type has no freeze node, it is a type in standard,
4630 -- and always acts as its own first subtype unless it is one of
4631 -- the predefined integer types. If the type is formal, it is also
4632 -- a first subtype, and its base type has no freeze node. On the other
4633 -- hand, a subtype of a generic formal is not its own first_subtype.
4634 -- Its base type, if anonymous, is attached to the formal type decl.
4635 -- from which the first subtype is obtained.
4639 if B
= Base_Type
(Standard_Integer
) then
4640 return Standard_Integer
;
4642 elsif B
= Base_Type
(Standard_Long_Integer
) then
4643 return Standard_Long_Integer
;
4645 elsif B
= Base_Type
(Standard_Short_Short_Integer
) then
4646 return Standard_Short_Short_Integer
;
4648 elsif B
= Base_Type
(Standard_Short_Integer
) then
4649 return Standard_Short_Integer
;
4651 elsif B
= Base_Type
(Standard_Long_Long_Integer
) then
4652 return Standard_Long_Long_Integer
;
4654 elsif Is_Generic_Type
(Id
) then
4655 if Present
(Parent
(B
)) then
4656 return Defining_Identifier
(Parent
(B
));
4658 return Defining_Identifier
(Associated_Node_For_Itype
(B
));
4665 -- Otherwise we check the freeze node, if it has a First_Subtype_Link
4666 -- then we use that link, otherwise (happens with some Itypes), we use
4667 -- the base type itself.
4670 Ent
:= First_Subtype_Link
(F
);
4672 if Present
(Ent
) then
4680 ------------------------
4681 -- Has_Attach_Handler --
4682 ------------------------
4684 function Has_Attach_Handler
(Id
: E
) return B
is
4688 pragma Assert
(Is_Protected_Type
(Id
));
4690 Ritem
:= First_Rep_Item
(Id
);
4691 while Present
(Ritem
) loop
4692 if Nkind
(Ritem
) = N_Pragma
4693 and then Chars
(Ritem
) = Name_Attach_Handler
4697 Ritem
:= Next_Rep_Item
(Ritem
);
4702 end Has_Attach_Handler
;
4708 function Has_Entries
(Id
: E
) return B
is
4709 Result
: Boolean := False;
4713 pragma Assert
(Is_Concurrent_Type
(Id
));
4714 Ent
:= First_Entity
(Id
);
4716 while Present
(Ent
) loop
4717 if Is_Entry
(Ent
) then
4722 Ent
:= Next_Entity
(Ent
);
4728 ----------------------------
4729 -- Has_Foreign_Convention --
4730 ----------------------------
4732 function Has_Foreign_Convention
(Id
: E
) return B
is
4734 return Convention
(Id
) >= Foreign_Convention
'First;
4735 end Has_Foreign_Convention
;
4737 ---------------------------
4738 -- Has_Interrupt_Handler --
4739 ---------------------------
4741 function Has_Interrupt_Handler
(Id
: E
) return B
is
4745 pragma Assert
(Is_Protected_Type
(Id
));
4747 Ritem
:= First_Rep_Item
(Id
);
4748 while Present
(Ritem
) loop
4749 if Nkind
(Ritem
) = N_Pragma
4750 and then Chars
(Ritem
) = Name_Interrupt_Handler
4754 Ritem
:= Next_Rep_Item
(Ritem
);
4759 end Has_Interrupt_Handler
;
4761 --------------------------
4762 -- Has_Private_Ancestor --
4763 --------------------------
4765 function Has_Private_Ancestor
(Id
: E
) return B
is
4766 R
: constant Entity_Id
:= Root_Type
(Id
);
4767 T1
: Entity_Id
:= Id
;
4771 if Is_Private_Type
(T1
) then
4781 end Has_Private_Ancestor
;
4783 ------------------------------
4784 -- Implementation_Base_Type --
4785 ------------------------------
4787 function Implementation_Base_Type
(Id
: E
) return E
is
4792 Bastyp
:= Base_Type
(Id
);
4794 if Is_Incomplete_Or_Private_Type
(Bastyp
) then
4795 Imptyp
:= Underlying_Type
(Bastyp
);
4797 -- If we have an implementation type, then just return it,
4798 -- otherwise we return the Base_Type anyway. This can only
4799 -- happen in error situations and should avoid some error bombs.
4801 if Present
(Imptyp
) then
4810 end Implementation_Base_Type
;
4812 -----------------------
4813 -- Is_Always_Inlined --
4814 -----------------------
4816 function Is_Always_Inlined
(Id
: E
) return B
is
4820 Item
:= First_Rep_Item
(Id
);
4822 while Present
(Item
) loop
4823 if Nkind
(Item
) = N_Pragma
4824 and then Get_Pragma_Id
(Chars
(Item
)) = Pragma_Inline_Always
4829 Next_Rep_Item
(Item
);
4833 end Is_Always_Inlined
;
4835 ---------------------
4836 -- Is_Boolean_Type --
4837 ---------------------
4839 function Is_Boolean_Type
(Id
: E
) return B
is
4841 return Root_Type
(Id
) = Standard_Boolean
;
4842 end Is_Boolean_Type
;
4844 ---------------------
4845 -- Is_By_Copy_Type --
4846 ---------------------
4848 function Is_By_Copy_Type
(Id
: E
) return B
is
4850 -- If Id is a private type whose full declaration has not been seen,
4851 -- we assume for now that it is not a By_Copy type. Clearly this
4852 -- attribute should not be used before the type is frozen, but it is
4853 -- needed to build the associated record of a protected type. Another
4854 -- place where some lookahead for a full view is needed ???
4857 Is_Elementary_Type
(Id
)
4858 or else (Is_Private_Type
(Id
)
4859 and then Present
(Underlying_Type
(Id
))
4860 and then Is_Elementary_Type
(Underlying_Type
(Id
)));
4861 end Is_By_Copy_Type
;
4863 --------------------------
4864 -- Is_By_Reference_Type --
4865 --------------------------
4867 function Is_By_Reference_Type
(Id
: E
) return B
is
4868 Btype
: constant Entity_Id
:= Base_Type
(Id
);
4871 if Error_Posted
(Id
)
4872 or else Error_Posted
(Btype
)
4876 elsif Is_Private_Type
(Btype
) then
4878 Utyp
: constant Entity_Id
:= Underlying_Type
(Btype
);
4884 return Is_By_Reference_Type
(Utyp
);
4888 elsif Is_Concurrent_Type
(Btype
) then
4891 elsif Is_Record_Type
(Btype
) then
4893 if Is_Limited_Record
(Btype
)
4894 or else Is_Tagged_Type
(Btype
)
4895 or else Is_Volatile
(Btype
)
4901 C
: Entity_Id
:= First_Component
(Btype
);
4904 while Present
(C
) loop
4905 if Is_By_Reference_Type
(Etype
(C
))
4906 or else Is_Volatile
(Etype
(C
))
4911 C
:= Next_Component
(C
);
4918 elsif Is_Array_Type
(Btype
) then
4921 or else Is_By_Reference_Type
(Component_Type
(Btype
))
4922 or else Is_Volatile
(Component_Type
(Btype
))
4923 or else Has_Volatile_Components
(Btype
);
4928 end Is_By_Reference_Type
;
4930 ---------------------
4931 -- Is_Derived_Type --
4932 ---------------------
4934 function Is_Derived_Type
(Id
: E
) return B
is
4938 if Base_Type
(Id
) /= Root_Type
(Id
)
4939 and then not Is_Generic_Type
(Id
)
4940 and then not Is_Class_Wide_Type
(Id
)
4942 if not Is_Numeric_Type
(Root_Type
(Id
)) then
4946 Par
:= Parent
(First_Subtype
(Id
));
4948 return Present
(Par
)
4949 and then Nkind
(Par
) = N_Full_Type_Declaration
4950 and then Nkind
(Type_Definition
(Par
))
4951 = N_Derived_Type_Definition
;
4957 end Is_Derived_Type
;
4959 ----------------------
4960 -- Is_Dynamic_Scope --
4961 ----------------------
4963 function Is_Dynamic_Scope
(Id
: E
) return B
is
4966 Ekind
(Id
) = E_Block
4968 Ekind
(Id
) = E_Function
4970 Ekind
(Id
) = E_Procedure
4972 Ekind
(Id
) = E_Subprogram_Body
4974 Ekind
(Id
) = E_Task_Type
4976 Ekind
(Id
) = E_Entry
4978 Ekind
(Id
) = E_Entry_Family
;
4979 end Is_Dynamic_Scope
;
4981 --------------------
4982 -- Is_Entity_Name --
4983 --------------------
4985 function Is_Entity_Name
(N
: Node_Id
) return Boolean is
4986 Kind
: constant Node_Kind
:= Nkind
(N
);
4989 -- Identifiers, operator symbols, expanded names are entity names
4991 return Kind
= N_Identifier
4992 or else Kind
= N_Operator_Symbol
4993 or else Kind
= N_Expanded_Name
4995 -- Attribute references are entity names if they refer to an entity.
4996 -- Note that we don't do this by testing for the presence of the
4997 -- Entity field in the N_Attribute_Reference node, since it may not
4998 -- have been set yet.
5000 or else (Kind
= N_Attribute_Reference
5001 and then Is_Entity_Attribute_Name
(Attribute_Name
(N
)));
5004 ---------------------------
5005 -- Is_Indefinite_Subtype --
5006 ---------------------------
5008 function Is_Indefinite_Subtype
(Id
: Entity_Id
) return B
is
5009 K
: constant Entity_Kind
:= Ekind
(Id
);
5012 if Is_Constrained
(Id
) then
5015 elsif K
in Array_Kind
5016 or else K
in Class_Wide_Kind
5017 or else Has_Unknown_Discriminants
(Id
)
5021 -- Known discriminants: indefinite if there are no default values
5023 elsif K
in Record_Kind
5024 or else Is_Incomplete_Or_Private_Type
(Id
)
5025 or else Is_Concurrent_Type
(Id
)
5027 return (Has_Discriminants
(Id
)
5028 and then No
(Discriminant_Default_Value
(First_Discriminant
(Id
))));
5033 end Is_Indefinite_Subtype
;
5035 ---------------------
5036 -- Is_Limited_Type --
5037 ---------------------
5039 function Is_Limited_Type
(Id
: E
) return B
is
5040 Btype
: constant E
:= Base_Type
(Id
);
5043 if not Is_Type
(Id
) then
5046 elsif Ekind
(Btype
) = E_Limited_Private_Type
5047 or else Is_Limited_Composite
(Btype
)
5051 elsif Is_Concurrent_Type
(Btype
) then
5054 -- Otherwise we will look around to see if there is some other reason
5055 -- for it to be limited, except that if an error was posted on the
5056 -- entity, then just assume it is non-limited, because it can cause
5057 -- trouble to recurse into a murky erroneous entity!
5059 elsif Error_Posted
(Id
) then
5062 elsif Is_Record_Type
(Btype
) then
5063 if Is_Limited_Record
(Root_Type
(Btype
)) then
5066 elsif Is_Class_Wide_Type
(Btype
) then
5067 return Is_Limited_Type
(Root_Type
(Btype
));
5071 C
: E
:= First_Component
(Btype
);
5074 while Present
(C
) loop
5075 if Is_Limited_Type
(Etype
(C
)) then
5079 C
:= Next_Component
(C
);
5086 elsif Is_Array_Type
(Btype
) then
5087 return Is_Limited_Type
(Component_Type
(Btype
));
5092 end Is_Limited_Type
;
5098 function Is_Package
(Id
: E
) return B
is
5101 Ekind
(Id
) = E_Package
5103 Ekind
(Id
) = E_Generic_Package
;
5106 --------------------------
5107 -- Is_Protected_Private --
5108 --------------------------
5110 function Is_Protected_Private
(Id
: E
) return B
is
5113 pragma Assert
(Ekind
(Id
) = E_Component
);
5114 return Is_Protected_Type
(Scope
(Id
));
5115 end Is_Protected_Private
;
5117 ------------------------------
5118 -- Is_Protected_Record_Type --
5119 ------------------------------
5121 function Is_Protected_Record_Type
(Id
: E
) return B
is
5124 Is_Concurrent_Record_Type
(Id
)
5125 and then Is_Protected_Type
(Corresponding_Concurrent_Type
(Id
));
5126 end Is_Protected_Record_Type
;
5128 ---------------------------------
5129 -- Is_Return_By_Reference_Type --
5130 ---------------------------------
5132 function Is_Return_By_Reference_Type
(Id
: E
) return B
is
5133 Btype
: constant Entity_Id
:= Base_Type
(Id
);
5136 if Is_Private_Type
(Btype
) then
5138 Utyp
: constant Entity_Id
:= Underlying_Type
(Btype
);
5144 return Is_Return_By_Reference_Type
(Utyp
);
5148 elsif Is_Concurrent_Type
(Btype
) then
5151 elsif Is_Record_Type
(Btype
) then
5152 if Is_Limited_Record
(Btype
) then
5155 elsif Is_Class_Wide_Type
(Btype
) then
5156 return Is_Return_By_Reference_Type
(Root_Type
(Btype
));
5160 C
: Entity_Id
:= First_Component
(Btype
);
5163 while Present
(C
) loop
5164 if Is_Return_By_Reference_Type
(Etype
(C
)) then
5168 C
:= Next_Component
(C
);
5175 elsif Is_Array_Type
(Btype
) then
5176 return Is_Return_By_Reference_Type
(Component_Type
(Btype
));
5181 end Is_Return_By_Reference_Type
;
5183 --------------------
5184 -- Is_String_Type --
5185 --------------------
5187 function Is_String_Type
(Id
: E
) return B
is
5189 return Ekind
(Id
) in String_Kind
5190 or else (Is_Array_Type
(Id
)
5191 and then Number_Dimensions
(Id
) = 1
5192 and then Is_Character_Type
(Component_Type
(Id
)));
5195 -------------------------
5196 -- Is_Task_Record_Type --
5197 -------------------------
5199 function Is_Task_Record_Type
(Id
: E
) return B
is
5202 Is_Concurrent_Record_Type
(Id
)
5203 and then Is_Task_Type
(Corresponding_Concurrent_Type
(Id
));
5204 end Is_Task_Record_Type
;
5206 ------------------------
5207 -- Is_Wrapper_Package --
5208 ------------------------
5210 function Is_Wrapper_Package
(Id
: E
) return B
is
5212 return (Ekind
(Id
) = E_Package
5213 and then Present
(Related_Instance
(Id
)));
5214 end Is_Wrapper_Package
;
5216 --------------------
5217 -- Next_Component --
5218 --------------------
5220 function Next_Component
(Id
: E
) return E
is
5224 Comp_Id
:= Next_Entity
(Id
);
5226 while Present
(Comp_Id
) loop
5227 exit when Ekind
(Comp_Id
) = E_Component
;
5228 Comp_Id
:= Next_Entity
(Comp_Id
);
5234 -----------------------
5235 -- Next_Discriminant --
5236 -----------------------
5238 -- This function actually implements both Next_Discriminant and
5239 -- Next_Girder_Discriminant by making sure that the Discriminant
5240 -- returned is of the same variety as Id.
5242 function Next_Discriminant
(Id
: E
) return E
is
5244 -- Derived Tagged types with private extensions look like this...
5246 -- E_Discriminant d1
5247 -- E_Discriminant d2
5249 -- E_Discriminant d1
5250 -- E_Discriminant d2
5252 -- so it is critical not to go past the leading discriminants.
5257 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
5260 D
:= Next_Entity
(D
);
5262 or else (Ekind
(D
) /= E_Discriminant
5263 and then not Is_Itype
(D
))
5268 exit when Ekind
(D
) = E_Discriminant
5269 and then (Is_Completely_Hidden
(D
) = Is_Completely_Hidden
(Id
));
5273 end Next_Discriminant
;
5279 function Next_Formal
(Id
: E
) return E
is
5283 -- Follow the chain of declared entities as long as the kind of
5284 -- the entity corresponds to a formal parameter. Skip internal
5285 -- entities that may have been created for implicit subtypes,
5286 -- in the process of analyzing default expressions.
5291 P
:= Next_Entity
(P
);
5293 if No
(P
) or else Is_Formal
(P
) then
5295 elsif not Is_Internal
(P
) then
5301 -----------------------------
5302 -- Next_Formal_With_Extras --
5303 -----------------------------
5305 function Next_Formal_With_Extras
(Id
: E
) return E
is
5307 if Present
(Extra_Formal
(Id
)) then
5308 return Extra_Formal
(Id
);
5311 return Next_Formal
(Id
);
5313 end Next_Formal_With_Extras
;
5315 ------------------------------
5316 -- Next_Girder_Discriminant --
5317 ------------------------------
5319 function Next_Girder_Discriminant
(Id
: E
) return E
is
5321 -- See comment in Next_Discriminant
5323 return Next_Discriminant
(Id
);
5324 end Next_Girder_Discriminant
;
5330 function Next_Index
(Id
: Node_Id
) return Node_Id
is
5339 function Next_Literal
(Id
: E
) return E
is
5341 pragma Assert
(Nkind
(Id
) in N_Entity
);
5345 -----------------------
5346 -- Number_Dimensions --
5347 -----------------------
5349 function Number_Dimensions
(Id
: E
) return Pos
is
5354 if Ekind
(Id
) in String_Kind
then
5359 T
:= First_Index
(Id
);
5361 while Present
(T
) loop
5368 end Number_Dimensions
;
5370 --------------------------
5371 -- Number_Discriminants --
5372 --------------------------
5374 function Number_Discriminants
(Id
: E
) return Pos
is
5380 Discr
:= First_Discriminant
(Id
);
5382 while Present
(Discr
) loop
5384 Discr
:= Next_Discriminant
(Discr
);
5388 end Number_Discriminants
;
5390 --------------------
5391 -- Number_Entries --
5392 --------------------
5394 function Number_Entries
(Id
: E
) return Nat
is
5399 pragma Assert
(Is_Concurrent_Type
(Id
));
5401 Ent
:= First_Entity
(Id
);
5403 while Present
(Ent
) loop
5404 if Is_Entry
(Ent
) then
5408 Ent
:= Next_Entity
(Ent
);
5414 --------------------
5415 -- Number_Formals --
5416 --------------------
5418 function Number_Formals
(Id
: E
) return Pos
is
5424 Formal
:= First_Formal
(Id
);
5426 while Present
(Formal
) loop
5428 Formal
:= Next_Formal
(Formal
);
5434 --------------------
5435 -- Parameter_Mode --
5436 --------------------
5438 function Parameter_Mode
(Id
: E
) return Formal_Kind
is
5447 function Root_Type
(Id
: E
) return E
is
5451 pragma Assert
(Nkind
(Id
) in N_Entity
);
5453 T
:= Base_Type
(Id
);
5455 if Ekind
(T
) = E_Class_Wide_Type
then
5467 elsif Is_Private_Type
(T
) and then Etyp
= Full_View
(T
) then
5470 elsif Is_Private_Type
(Etyp
) and then Full_View
(Etyp
) = T
then
5478 raise Program_Error
;
5485 function Scope_Depth
(Id
: E
) return Uint
is
5486 Scop
: Entity_Id
:= Id
;
5489 while Is_Record_Type
(Scop
) loop
5490 Scop
:= Scope
(Scop
);
5493 return Scope_Depth_Value
(Scop
);
5496 ---------------------
5497 -- Scope_Depth_Set --
5498 ---------------------
5500 function Scope_Depth_Set
(Id
: E
) return B
is
5502 return not Is_Record_Type
(Id
)
5503 and then Field22
(Id
) /= Union_Id
(Empty
);
5504 end Scope_Depth_Set
;
5506 -----------------------------
5507 -- Set_Component_Alignment --
5508 -----------------------------
5510 -- Component Alignment is encoded using two flags, Flag128/129 as
5511 -- follows. Note that both flags False = Align_Default, so that the
5512 -- default initialization of flags to False initializes component
5513 -- alignment to the default value as required.
5515 -- Flag128 Flag129 Value
5516 -- ------- ------- -----
5517 -- False False Calign_Default
5518 -- False True Calign_Component_Size
5519 -- True False Calign_Component_Size_4
5520 -- True True Calign_Storage_Unit
5522 procedure Set_Component_Alignment
(Id
: E
; V
: C
) is
5524 pragma Assert
((Is_Array_Type
(Id
) or else Is_Record_Type
(Id
))
5525 and then Id
= Base_Type
(Id
));
5528 when Calign_Default
=>
5529 Set_Flag128
(Id
, False);
5530 Set_Flag129
(Id
, False);
5532 when Calign_Component_Size
=>
5533 Set_Flag128
(Id
, False);
5534 Set_Flag129
(Id
, True);
5536 when Calign_Component_Size_4
=>
5537 Set_Flag128
(Id
, True);
5538 Set_Flag129
(Id
, False);
5540 when Calign_Storage_Unit
=>
5541 Set_Flag128
(Id
, True);
5542 Set_Flag129
(Id
, True);
5544 end Set_Component_Alignment
;
5550 function Size_Clause
(Id
: E
) return N
is
5554 Ritem
:= First_Rep_Item
(Id
);
5555 while Present
(Ritem
) loop
5556 if Nkind
(Ritem
) = N_Attribute_Definition_Clause
5557 and then Chars
(Ritem
) = Name_Size
5561 Ritem
:= Next_Rep_Item
(Ritem
);
5572 function Subtype_Kind
(K
: Entity_Kind
) return Entity_Kind
is
5578 Kind
:= E_Access_Subtype
;
5582 Kind
:= E_Array_Subtype
;
5584 when E_Class_Wide_Type |
5585 E_Class_Wide_Subtype
=>
5586 Kind
:= E_Class_Wide_Subtype
;
5588 when E_Decimal_Fixed_Point_Type |
5589 E_Decimal_Fixed_Point_Subtype
=>
5590 Kind
:= E_Decimal_Fixed_Point_Subtype
;
5592 when E_Ordinary_Fixed_Point_Type |
5593 E_Ordinary_Fixed_Point_Subtype
=>
5594 Kind
:= E_Ordinary_Fixed_Point_Subtype
;
5596 when E_Private_Type |
5597 E_Private_Subtype
=>
5598 Kind
:= E_Private_Subtype
;
5600 when E_Limited_Private_Type |
5601 E_Limited_Private_Subtype
=>
5602 Kind
:= E_Limited_Private_Subtype
;
5604 when E_Record_Type_With_Private |
5605 E_Record_Subtype_With_Private
=>
5606 Kind
:= E_Record_Subtype_With_Private
;
5608 when E_Record_Type |
5610 Kind
:= E_Record_Subtype
;
5612 when E_String_Type |
5614 Kind
:= E_String_Subtype
;
5616 when Enumeration_Kind
=>
5617 Kind
:= E_Enumeration_Subtype
;
5620 Kind
:= E_Floating_Point_Subtype
;
5622 when Signed_Integer_Kind
=>
5623 Kind
:= E_Signed_Integer_Subtype
;
5625 when Modular_Integer_Kind
=>
5626 Kind
:= E_Modular_Integer_Subtype
;
5628 when Protected_Kind
=>
5629 Kind
:= E_Protected_Subtype
;
5632 Kind
:= E_Task_Subtype
;
5636 raise Program_Error
;
5646 function Tag_Component
(Id
: E
) return E
is
5648 Typ
: Entity_Id
:= Id
;
5651 pragma Assert
(Is_Tagged_Type
(Typ
));
5653 if Is_Class_Wide_Type
(Typ
) then
5654 Typ
:= Root_Type
(Typ
);
5657 if Is_Private_Type
(Typ
) then
5658 Typ
:= Underlying_Type
(Typ
);
5661 Comp
:= First_Entity
(Typ
);
5662 while Present
(Comp
) loop
5663 if Is_Tag
(Comp
) then
5667 Comp
:= Next_Entity
(Comp
);
5670 -- No tag component found
5675 ---------------------
5676 -- Type_High_Bound --
5677 ---------------------
5679 function Type_High_Bound
(Id
: E
) return Node_Id
is
5681 if Nkind
(Scalar_Range
(Id
)) = N_Subtype_Indication
then
5682 return High_Bound
(Range_Expression
(Constraint
(Scalar_Range
(Id
))));
5684 return High_Bound
(Scalar_Range
(Id
));
5686 end Type_High_Bound
;
5688 --------------------
5689 -- Type_Low_Bound --
5690 --------------------
5692 function Type_Low_Bound
(Id
: E
) return Node_Id
is
5694 if Nkind
(Scalar_Range
(Id
)) = N_Subtype_Indication
then
5695 return Low_Bound
(Range_Expression
(Constraint
(Scalar_Range
(Id
))));
5697 return Low_Bound
(Scalar_Range
(Id
));
5701 ---------------------
5702 -- Underlying_Type --
5703 ---------------------
5705 function Underlying_Type
(Id
: E
) return E
is
5708 -- For record_with_private the underlying type is always the direct
5709 -- full view. Never try to take the full view of the parent it
5710 -- doesn't make sense.
5712 if Ekind
(Id
) = E_Record_Type_With_Private
then
5713 return Full_View
(Id
);
5715 elsif Ekind
(Id
) in Incomplete_Or_Private_Kind
then
5717 -- If we have an incomplete or private type with a full view,
5718 -- then we return the Underlying_Type of this full view
5720 if Present
(Full_View
(Id
)) then
5721 return Underlying_Type
(Full_View
(Id
));
5723 -- Otherwise check for the case where we have a derived type or
5724 -- subtype, and if so get the Underlying_Type of the parent type.
5726 elsif Etype
(Id
) /= Id
then
5727 return Underlying_Type
(Etype
(Id
));
5729 -- Otherwise we have an incomplete or private type that has
5730 -- no full view, which means that we have not encountered the
5731 -- completion, so return Empty to indicate the underlying type
5732 -- is not yet known.
5738 -- For non-incomplete, non-private types, return the type itself
5739 -- Also for entities that are not types at all return the entity
5745 end Underlying_Type
;
5747 ------------------------
5748 -- Write_Entity_Flags --
5749 ------------------------
5751 procedure Write_Entity_Flags
(Id
: Entity_Id
; Prefix
: String) is
5753 procedure W
(Flag_Name
: String; Flag
: Boolean);
5754 -- Write out given flag if it is set
5756 procedure W
(Flag_Name
: String; Flag
: Boolean) is
5760 Write_Str
(Flag_Name
);
5761 Write_Str
(" = True");
5766 -- Start of processing for Write_Entity_Flags
5769 if (Is_Array_Type
(Id
) or else Is_Record_Type
(Id
))
5770 and then Base_Type
(Id
) = Id
5773 Write_Str
("Component_Alignment = ");
5775 case Component_Alignment
(Id
) is
5776 when Calign_Default
=>
5777 Write_Str
("Calign_Default");
5779 when Calign_Component_Size
=>
5780 Write_Str
("Calign_Component_Size");
5782 when Calign_Component_Size_4
=>
5783 Write_Str
("Calign_Component_Size_4");
5785 when Calign_Storage_Unit
=>
5786 Write_Str
("Calign_Storage_Unit");
5792 W
("Address_Taken", Flag104
(Id
));
5793 W
("C_Pass_By_Copy", Flag125
(Id
));
5794 W
("Debug_Info_Off", Flag166
(Id
));
5795 W
("Default_Expressions_Processed", Flag108
(Id
));
5796 W
("Delay_Cleanups", Flag114
(Id
));
5797 W
("Delay_Subprogram_Descriptors", Flag50
(Id
));
5798 W
("Depends_On_Private", Flag14
(Id
));
5799 W
("Discard_Names", Flag88
(Id
));
5800 W
("Elaborate_All_Desirable", Flag146
(Id
));
5801 W
("Elaboration_Entity_Required", Flag175
(Id
));
5802 W
("Entry_Accepted", Flag152
(Id
));
5803 W
("Finalize_Storage_Only", Flag158
(Id
));
5804 W
("From_With_Type", Flag159
(Id
));
5805 W
("Function_Returns_With_DSP", Flag169
(Id
));
5806 W
("Has_Aliased_Components", Flag135
(Id
));
5807 W
("Has_Alignment_Clause", Flag46
(Id
));
5808 W
("Has_All_Calls_Remote", Flag79
(Id
));
5809 W
("Has_Atomic_Components", Flag86
(Id
));
5810 W
("Has_Biased_Representation", Flag139
(Id
));
5811 W
("Has_Completion", Flag26
(Id
));
5812 W
("Has_Completion_In_Body", Flag71
(Id
));
5813 W
("Has_Complex_Representation", Flag140
(Id
));
5814 W
("Has_Component_Size_Clause", Flag68
(Id
));
5815 W
("Has_Controlled_Component", Flag43
(Id
));
5816 W
("Has_Controlling_Result", Flag98
(Id
));
5817 W
("Has_Convention_Pragma", Flag119
(Id
));
5818 W
("Has_Delayed_Freeze", Flag18
(Id
));
5819 W
("Has_Discriminants", Flag5
(Id
));
5820 W
("Has_Enumeration_Rep_Clause", Flag66
(Id
));
5821 W
("Has_Exit", Flag47
(Id
));
5822 W
("Has_External_Tag_Rep_Clause", Flag110
(Id
));
5823 W
("Has_Forward_Instantiation", Flag175
(Id
));
5824 W
("Has_Fully_Qualified_Name", Flag173
(Id
));
5825 W
("Has_Gigi_Rep_Item", Flag82
(Id
));
5826 W
("Has_Homonym", Flag56
(Id
));
5827 W
("Has_Machine_Radix_Clause", Flag83
(Id
));
5828 W
("Has_Master_Entity", Flag21
(Id
));
5829 W
("Has_Missing_Return", Flag142
(Id
));
5830 W
("Has_Nested_Block_With_Handler", Flag101
(Id
));
5831 W
("Has_Non_Standard_Rep", Flag75
(Id
));
5832 W
("Has_Object_Size_Clause", Flag172
(Id
));
5833 W
("Has_Per_Object_Constraint", Flag154
(Id
));
5834 W
("Has_Pragma_Controlled", Flag27
(Id
));
5835 W
("Has_Pragma_Elaborate_Body", Flag150
(Id
));
5836 W
("Has_Pragma_Inline", Flag157
(Id
));
5837 W
("Has_Pragma_Pack", Flag121
(Id
));
5838 W
("Has_Primitive_Operations", Flag120
(Id
));
5839 W
("Has_Private_Declaration", Flag155
(Id
));
5840 W
("Has_Qualified_Name", Flag161
(Id
));
5841 W
("Has_Record_Rep_Clause", Flag65
(Id
));
5842 W
("Has_Recursive_Call", Flag143
(Id
));
5843 W
("Has_Size_Clause", Flag29
(Id
));
5844 W
("Has_Small_Clause", Flag67
(Id
));
5845 W
("Has_Specified_Layout", Flag100
(Id
));
5846 W
("Has_Storage_Size_Clause", Flag23
(Id
));
5847 W
("Has_Subprogram_Descriptor", Flag93
(Id
));
5848 W
("Has_Task", Flag30
(Id
));
5849 W
("Has_Unchecked_Union", Flag123
(Id
));
5850 W
("Has_Unknown_Discriminants", Flag72
(Id
));
5851 W
("Has_Volatile_Components", Flag87
(Id
));
5852 W
("In_Package_Body", Flag48
(Id
));
5853 W
("In_Private_Part", Flag45
(Id
));
5854 W
("In_Use", Flag8
(Id
));
5855 W
("Is_AST_Entry", Flag132
(Id
));
5856 W
("Is_Abstract", Flag19
(Id
));
5857 W
("Is_Access_Constant", Flag69
(Id
));
5858 W
("Is_Aliased", Flag15
(Id
));
5859 W
("Is_Asynchronous", Flag81
(Id
));
5860 W
("Is_Atomic", Flag85
(Id
));
5861 W
("Is_Bit_Packed_Array", Flag122
(Id
));
5862 W
("Is_CPP_Class", Flag74
(Id
));
5863 W
("Is_Called", Flag102
(Id
));
5864 W
("Is_Character_Type", Flag63
(Id
));
5865 W
("Is_Child_Unit", Flag73
(Id
));
5866 W
("Is_Compilation_Unit", Flag149
(Id
));
5867 W
("Is_Completely_Hidden", Flag103
(Id
));
5868 W
("Is_Concurrent_Record_Type", Flag20
(Id
));
5869 W
("Is_Constr_Subt_For_UN_Aliased", Flag141
(Id
));
5870 W
("Is_Constr_Subt_For_U_Nominal", Flag80
(Id
));
5871 W
("Is_Constrained", Flag12
(Id
));
5872 W
("Is_Constructor", Flag76
(Id
));
5873 W
("Is_Controlled", Flag42
(Id
));
5874 W
("Is_Controlling_Formal", Flag97
(Id
));
5875 W
("Is_Destructor", Flag77
(Id
));
5876 W
("Is_Discrim_SO_Function", Flag176
(Id
));
5877 W
("Is_Dispatching_Operation", Flag6
(Id
));
5878 W
("Is_Eliminated", Flag124
(Id
));
5879 W
("Is_Entry_Formal", Flag52
(Id
));
5880 W
("Is_Exported", Flag99
(Id
));
5881 W
("Is_First_Subtype", Flag70
(Id
));
5882 W
("Is_For_Access_Subtype", Flag118
(Id
));
5883 W
("Is_Formal_Subprogram", Flag111
(Id
));
5884 W
("Is_Frozen", Flag4
(Id
));
5885 W
("Is_Generic_Actual_Type", Flag94
(Id
));
5886 W
("Is_Generic_Instance", Flag130
(Id
));
5887 W
("Is_Generic_Type", Flag13
(Id
));
5888 W
("Is_Hidden", Flag57
(Id
));
5889 W
("Is_Hidden_Open_Scope", Flag171
(Id
));
5890 W
("Is_Immediately_Visible", Flag7
(Id
));
5891 W
("Is_Imported", Flag24
(Id
));
5892 W
("Is_Inlined", Flag11
(Id
));
5893 W
("Is_Instantiated", Flag126
(Id
));
5894 W
("Is_Internal", Flag17
(Id
));
5895 W
("Is_Interrupt_Handler", Flag89
(Id
));
5896 W
("Is_Intrinsic_Subprogram", Flag64
(Id
));
5897 W
("Is_Itype", Flag91
(Id
));
5898 W
("Is_Known_Valid", Flag170
(Id
));
5899 W
("Is_Limited_Composite", Flag106
(Id
));
5900 W
("Is_Limited_Record", Flag25
(Id
));
5901 W
("Is_Non_Static_Subtype", Flag109
(Id
));
5902 W
("Is_Null_Init_Proc", Flag178
(Id
));
5903 W
("Is_Optional_Parameter", Flag134
(Id
));
5904 W
("Is_Package_Body_Entity", Flag160
(Id
));
5905 W
("Is_Packed", Flag51
(Id
));
5906 W
("Is_Packed_Array_Type", Flag138
(Id
));
5907 W
("Is_Potentially_Use_Visible", Flag9
(Id
));
5908 W
("Is_Preelaborated", Flag59
(Id
));
5909 W
("Is_Private_Composite", Flag107
(Id
));
5910 W
("Is_Private_Descendant", Flag53
(Id
));
5911 W
("Is_Psected", Flag153
(Id
));
5912 W
("Is_Public", Flag10
(Id
));
5913 W
("Is_Pure", Flag44
(Id
));
5914 W
("Is_Remote_Call_Interface", Flag62
(Id
));
5915 W
("Is_Remote_Types", Flag61
(Id
));
5916 W
("Is_Renaming_Of_Object", Flag112
(Id
));
5917 W
("Is_Shared_Passive", Flag60
(Id
));
5918 W
("Is_Statically_Allocated", Flag28
(Id
));
5919 W
("Is_Tag", Flag78
(Id
));
5920 W
("Is_Tagged_Type", Flag55
(Id
));
5921 W
("Is_True_Constant", Flag163
(Id
));
5922 W
("Is_Unchecked_Union", Flag117
(Id
));
5923 W
("Is_Unsigned_Type", Flag144
(Id
));
5924 W
("Is_VMS_Exception", Flag133
(Id
));
5925 W
("Is_Valued_Procedure", Flag127
(Id
));
5926 W
("Is_Visible_Child_Unit", Flag116
(Id
));
5927 W
("Is_Volatile", Flag16
(Id
));
5928 W
("Machine_Radix_10", Flag84
(Id
));
5929 W
("Materialize_Entity", Flag168
(Id
));
5930 W
("Needs_Debug_Info", Flag147
(Id
));
5931 W
("Needs_No_Actuals", Flag22
(Id
));
5932 W
("No_Pool_Assigned", Flag131
(Id
));
5933 W
("No_Return", Flag113
(Id
));
5934 W
("Non_Binary_Modulus", Flag58
(Id
));
5935 W
("Nonzero_Is_True", Flag162
(Id
));
5936 W
("Not_Source_Assigned", Flag115
(Id
));
5937 W
("Reachable", Flag49
(Id
));
5938 W
("Referenced", Flag156
(Id
));
5939 W
("Return_Present", Flag54
(Id
));
5940 W
("Returns_By_Ref", Flag90
(Id
));
5941 W
("Reverse_Bit_Order", Flag164
(Id
));
5942 W
("Sec_Stack_Needed_For_Return", Flag167
(Id
));
5943 W
("Size_Depends_On_Discriminant", Flag177
(Id
));
5944 W
("Size_Known_At_Compile_Time", Flag92
(Id
));
5945 W
("Strict_Alignment", Flag145
(Id
));
5946 W
("Suppress_Access_Checks", Flag31
(Id
));
5947 W
("Suppress_Accessibility_Checks", Flag32
(Id
));
5948 W
("Suppress_Discriminant_Checks", Flag33
(Id
));
5949 W
("Suppress_Division_Checks", Flag34
(Id
));
5950 W
("Suppress_Elaboration_Checks", Flag35
(Id
));
5951 W
("Suppress_Elaboration_Warnings", Flag148
(Id
));
5952 W
("Suppress_Index_Checks", Flag36
(Id
));
5953 W
("Suppress_Init_Proc", Flag105
(Id
));
5954 W
("Suppress_Length_Checks", Flag37
(Id
));
5955 W
("Suppress_Overflow_Checks", Flag38
(Id
));
5956 W
("Suppress_Range_Checks", Flag39
(Id
));
5957 W
("Suppress_Storage_Checks", Flag40
(Id
));
5958 W
("Suppress_Style_Checks", Flag165
(Id
));
5959 W
("Suppress_Tag_Checks", Flag41
(Id
));
5960 W
("Uses_Sec_Stack", Flag95
(Id
));
5961 W
("Vax_Float", Flag151
(Id
));
5962 W
("Warnings_Off", Flag96
(Id
));
5964 end Write_Entity_Flags
;
5966 -----------------------
5967 -- Write_Entity_Info --
5968 -----------------------
5970 procedure Write_Entity_Info
(Id
: Entity_Id
; Prefix
: String) is
5972 procedure Write_Attribute
(Which
: String; Nam
: E
);
5973 -- Write attribute value with given string name
5975 procedure Write_Kind
(Id
: Entity_Id
);
5976 -- Write Ekind field of entity
5978 procedure Write_Attribute
(Which
: String; Nam
: E
) is
5982 Write_Int
(Int
(Nam
));
5984 Write_Name
(Chars
(Nam
));
5986 end Write_Attribute
;
5988 procedure Write_Kind
(Id
: Entity_Id
) is
5989 K
: constant String := Entity_Kind
'Image (Ekind
(Id
));
5993 Write_Str
(" Kind ");
5995 if Is_Type
(Id
) and then Is_Tagged_Type
(Id
) then
5996 Write_Str
("TAGGED ");
5999 Write_Str
(K
(3 .. K
'Length));
6002 if Is_Type
(Id
) and then Depends_On_Private
(Id
) then
6003 Write_Str
("Depends_On_Private ");
6007 -- Start of processing for Write_Entity_Info
6011 Write_Attribute
("Name ", Id
);
6012 Write_Int
(Int
(Id
));
6016 Write_Attribute
(" Type ", Etype
(Id
));
6018 Write_Attribute
(" Scope ", Scope
(Id
));
6023 when Discrete_Kind
=>
6024 Write_Str
("Bounds: Id = ");
6026 if Present
(Scalar_Range
(Id
)) then
6027 Write_Int
(Int
(Type_Low_Bound
(Id
)));
6028 Write_Str
(" .. Id = ");
6029 Write_Int
(Int
(Type_High_Bound
(Id
)));
6031 Write_Str
("Empty");
6041 Write_Attribute
(" Component Type ",
6042 Component_Type
(Id
));
6045 Write_Str
(" Indices ");
6047 Index
:= First_Index
(Id
);
6049 while Present
(Index
) loop
6050 Write_Attribute
(" ", Etype
(Index
));
6051 Index
:= Next_Index
(Index
);
6059 (" Directly Designated Type ",
6060 Directly_Designated_Type
(Id
));
6063 when Overloadable_Kind
=>
6064 if Present
(Homonym
(Id
)) then
6065 Write_Str
(" Homonym ");
6066 Write_Name
(Chars
(Homonym
(Id
)));
6068 Write_Int
(Int
(Homonym
(Id
)));
6075 if Ekind
(Scope
(Id
)) in Record_Kind
then
6077 " Original_Record_Component ",
6078 Original_Record_Component
(Id
));
6079 Write_Int
(Int
(Original_Record_Component
(Id
)));
6083 when others => null;
6085 end Write_Entity_Info
;
6087 -----------------------
6088 -- Write_Field6_Name --
6089 -----------------------
6091 procedure Write_Field6_Name
(Id
: Entity_Id
) is
6093 Write_Str
("First_Rep_Item");
6094 end Write_Field6_Name
;
6096 -----------------------
6097 -- Write_Field7_Name --
6098 -----------------------
6100 procedure Write_Field7_Name
(Id
: Entity_Id
) is
6102 Write_Str
("Freeze_Node");
6103 end Write_Field7_Name
;
6105 -----------------------
6106 -- Write_Field8_Name --
6107 -----------------------
6109 procedure Write_Field8_Name
(Id
: Entity_Id
) is
6114 Write_Str
("Normalized_First_Bit");
6118 Write_Str
("Mechanism");
6121 Write_Str
("Associated_Node_For_Itype");
6124 Write_Str
("Dependent_Instances");
6127 Write_Str
("Hiding_Loop_Variable");
6130 Write_Str
("Field8??");
6132 end Write_Field8_Name
;
6134 -----------------------
6135 -- Write_Field9_Name --
6136 -----------------------
6138 procedure Write_Field9_Name
(Id
: Entity_Id
) is
6142 Write_Str
("Class_Wide_Type");
6144 when E_Constant | E_Variable
=>
6145 Write_Str
("Size_Check_Code");
6148 E_Generic_Function |
6150 E_Generic_Procedure |
6153 Write_Str
("Renaming_Map");
6157 Write_Str
("Normalized_Position");
6160 Write_Str
("Field9??");
6162 end Write_Field9_Name
;
6164 ------------------------
6165 -- Write_Field10_Name --
6166 ------------------------
6168 procedure Write_Field10_Name
(Id
: Entity_Id
) is
6172 Write_Str
("Referenced_Object");
6174 when E_In_Parameter |
6176 Write_Str
("Discriminal_Link");
6182 Write_Str
("Handler_Records");
6186 Write_Str
("Normalized_Position_Max");
6189 Write_Str
("Field10??");
6191 end Write_Field10_Name
;
6193 ------------------------
6194 -- Write_Field11_Name --
6195 ------------------------
6197 procedure Write_Field11_Name
(Id
: Entity_Id
) is
6201 Write_Str
("Entry_Component");
6205 Write_Str
("Component_Bit_Offset");
6208 Write_Str
("Full_View");
6210 when E_Enumeration_Literal
=>
6211 Write_Str
("Enumeration_Pos");
6214 Write_Str
("Block_Node");
6220 Write_Str
("Protected_Body_Subprogram");
6223 Write_Str
("Full_View");
6226 Write_Str
("Field11??");
6228 end Write_Field11_Name
;
6230 ------------------------
6231 -- Write_Field12_Name --
6232 ------------------------
6234 procedure Write_Field12_Name
(Id
: Entity_Id
) is
6238 Write_Str
("Barrier_Function");
6240 when E_Enumeration_Literal
=>
6241 Write_Str
("Enumeration_Rep");
6248 E_In_Out_Parameter |
6252 Write_Str
("Esize");
6256 Write_Str
("Next_Inlined_Subprogram");
6259 Write_Str
("Associated_Formal_Package");
6262 Write_Str
("Field12??");
6264 end Write_Field12_Name
;
6266 ------------------------
6267 -- Write_Field13_Name --
6268 ------------------------
6270 procedure Write_Field13_Name
(Id
: Entity_Id
) is
6274 Write_Str
("RM_Size");
6278 Write_Str
("Component_Clause");
6280 when E_Enumeration_Literal
=>
6281 Write_Str
("Debug_Renaming_Link");
6284 if not Comes_From_Source
(Id
)
6286 Chars
(Id
) = Name_Op_Ne
6288 Write_Str
("Corresponding_Equality");
6290 elsif Comes_From_Source
(Id
) then
6291 Write_Str
("Elaboration_Entity");
6294 Write_Str
("Field13??");
6299 Write_Str
("Extra_Accessibility");
6303 Generic_Unit_Kind
=>
6304 Write_Str
("Elaboration_Entity");
6307 Write_Str
("Field13??");
6309 end Write_Field13_Name
;
6311 -----------------------
6312 -- Write_Field14_Name --
6313 -----------------------
6315 procedure Write_Field14_Name
(Id
: Entity_Id
) is
6320 Write_Str
("Alignment");
6324 Write_Str
("First_Optional_Parameter");
6327 E_Generic_Package
=>
6328 Write_Str
("Shadow_Entities");
6331 Write_Str
("Field14??");
6333 end Write_Field14_Name
;
6335 ------------------------
6336 -- Write_Field15_Name --
6337 ------------------------
6339 procedure Write_Field15_Name
(Id
: Entity_Id
) is
6344 Write_Str
("Storage_Size_Variable");
6346 when Class_Wide_Kind |
6350 Write_Str
("Primitive_Operations");
6353 Write_Str
("DT_Entry_Count");
6355 when Decimal_Fixed_Point_Kind
=>
6356 Write_Str
("Scale_Value");
6358 when E_Discriminant
=>
6359 Write_Str
("Discriminant_Number");
6362 Write_Str
("Extra_Formal");
6366 Write_Str
("DT_Position");
6369 Write_Str
("Entry_Parameters_Type");
6371 when Enumeration_Kind
=>
6372 Write_Str
("Lit_Indexes");
6375 Write_Str
("Related_Instance");
6377 when E_Protected_Type
=>
6378 Write_Str
("Entry_Bodies_Array");
6380 when E_String_Literal_Subtype
=>
6381 Write_Str
("String_Literal_Low_Bound");
6384 Write_Str
("Shared_Var_Read_Proc");
6387 Write_Str
("Field15??");
6389 end Write_Field15_Name
;
6391 ------------------------
6392 -- Write_Field16_Name --
6393 ------------------------
6395 procedure Write_Field16_Name
(Id
: Entity_Id
) is
6399 Write_Str
("Entry_Formal");
6403 Write_Str
("DTC_Entity");
6408 Write_Str
("First_Private_Entity");
6410 when E_Record_Type |
6411 E_Record_Type_With_Private
=>
6412 Write_Str
("Access_Disp_Table");
6414 when E_String_Literal_Subtype
=>
6415 Write_Str
("String_Literal_Length");
6417 when Enumeration_Kind
=>
6418 Write_Str
("Lit_Strings");
6422 Write_Str
("Unset_Reference");
6424 when E_Record_Subtype |
6425 E_Class_Wide_Subtype
=>
6426 Write_Str
("Cloned_Subtype");
6429 Write_Str
("Field16??");
6431 end Write_Field16_Name
;
6433 ------------------------
6434 -- Write_Field17_Name --
6435 ------------------------
6437 procedure Write_Field17_Name
(Id
: Entity_Id
) is
6441 Write_Str
("Digits_Value");
6444 Write_Str
("Prival");
6446 when E_Discriminant
=>
6447 Write_Str
("Discriminal");
6456 E_Generic_Function |
6458 E_Generic_Procedure |
6467 E_Subprogram_Type
=>
6468 Write_Str
("First_Entity");
6471 Write_Str
("First_Index");
6473 when E_Protected_Body
=>
6474 Write_Str
("Object_Ref");
6476 when Enumeration_Kind
=>
6477 Write_Str
("First_Literal");
6480 Write_Str
("Master_Id");
6482 when Modular_Integer_Kind
=>
6483 Write_Str
("Modulus");
6487 E_Generic_In_Out_Parameter |
6489 Write_Str
("Actual_Subtype");
6492 Write_Str
("Field17??");
6494 end Write_Field17_Name
;
6496 -----------------------
6497 -- Write_Field18_Name --
6498 -----------------------
6500 procedure Write_Field18_Name
(Id
: Entity_Id
) is
6503 when E_Enumeration_Literal |
6507 Write_Str
("Alias");
6509 when E_Record_Type
=>
6510 Write_Str
("Corresponding_Concurrent_Type");
6512 when E_Entry_Index_Parameter
=>
6513 Write_Str
("Entry_Index_Constant");
6515 when E_Class_Wide_Subtype |
6516 E_Access_Protected_Subprogram_Type |
6517 E_Access_Subprogram_Type |
6519 Write_Str
("Equivalent_Type");
6521 when Fixed_Point_Kind
=>
6522 Write_Str
("Delta_Value");
6526 Write_Str
("Renamed_Object");
6530 E_Generic_Function |
6531 E_Generic_Procedure |
6532 E_Generic_Package
=>
6533 Write_Str
("Renamed_Entity");
6535 when Incomplete_Or_Private_Kind
=>
6536 Write_Str
("Private_Dependents");
6538 when Concurrent_Kind
=>
6539 Write_Str
("Corresponding_Record_Type");
6544 Write_Str
("Enclosing_Scope");
6547 Write_Str
("Field18??");
6549 end Write_Field18_Name
;
6551 -----------------------
6552 -- Write_Field19_Name --
6553 -----------------------
6555 procedure Write_Field19_Name
(Id
: Entity_Id
) is
6560 Write_Str
("Related_Array_Object");
6567 Write_Str
("Finalization_Chain_Entity");
6569 when E_Discriminant
=>
6570 Write_Str
("Corresponding_Discriminant");
6573 Write_Str
("Body_Entity");
6575 when E_Package_Body |
6577 Write_Str
("Spec_Entity");
6579 when Private_Kind
=>
6580 Write_Str
("Underlying_Full_View");
6582 when E_Record_Type
=>
6583 Write_Str
("Parent_Subtype");
6586 Write_Str
("Field19??");
6588 end Write_Field19_Name
;
6590 -----------------------
6591 -- Write_Field20_Name --
6592 -----------------------
6594 procedure Write_Field20_Name
(Id
: Entity_Id
) is
6598 Write_Str
("Component_Type");
6600 when E_In_Parameter |
6601 E_Generic_In_Parameter
=>
6602 Write_Str
("Default_Value");
6605 Write_Str
("Directly_Designated_Type");
6608 Write_Str
("Discriminant_Checking_Func");
6610 when E_Discriminant
=>
6611 Write_Str
("Discriminant_Default_Value");
6620 E_Generic_Function |
6622 E_Generic_Procedure |
6631 E_Subprogram_Type
=>
6633 Write_Str
("Last_Entity");
6636 Write_Str
("Scalar_Range");
6639 Write_Str
("Register_Exception_Call");
6642 Write_Str
("Field20??");
6644 end Write_Field20_Name
;
6646 -----------------------
6647 -- Write_Field21_Name --
6648 -----------------------
6650 procedure Write_Field21_Name
(Id
: Entity_Id
) is
6656 E_Generic_Function |
6658 E_Generic_Procedure |
6660 Write_Str
("Interface_Name");
6662 when Concurrent_Kind |
6663 Incomplete_Or_Private_Kind |
6667 Write_Str
("Discriminant_Constraint");
6670 Write_Str
("Accept_Address");
6672 when Fixed_Point_Kind
=>
6673 Write_Str
("Small_Value");
6675 when E_In_Parameter
=>
6676 Write_Str
("Default_Expr_Function");
6679 Write_Str
("Field21??");
6681 end Write_Field21_Name
;
6683 -----------------------
6684 -- Write_Field22_Name --
6685 -----------------------
6687 procedure Write_Field22_Name
(Id
: Entity_Id
) is
6691 Write_Str
("Associated_Storage_Pool");
6694 Write_Str
("Component_Size");
6698 Write_Str
("Original_Record_Component");
6700 when E_Enumeration_Literal
=>
6701 Write_Str
("Enumeration_Rep_Expr");
6704 Write_Str
("Exception_Code");
6707 Write_Str
("Protected_Formal");
6709 when E_Record_Type
=>
6710 Write_Str
("Corresponding_Remote_Type");
6720 E_Generic_Function |
6721 E_Generic_Procedure |
6726 Write_Str
("Scope_Depth_Value");
6728 when E_Record_Type_With_Private |
6729 E_Record_Subtype_With_Private |
6732 E_Limited_Private_Type |
6733 E_Limited_Private_Subtype
=>
6734 Write_Str
("Private_View");
6737 Write_Str
("Shared_Var_Assign_Proc");
6740 Write_Str
("Field22??");
6742 end Write_Field22_Name
;
6744 ------------------------
6745 -- Write_Field23_Name --
6746 ------------------------
6748 procedure Write_Field23_Name
(Id
: Entity_Id
) is
6752 Write_Str
("Associated_Final_Chain");
6755 Write_Str
("Packed_Array_Type");
6758 Write_Str
("Entry_Cancel_Parameter");
6761 Write_Str
("Protected_Operation");
6763 when E_Discriminant
=>
6764 Write_Str
("CR_Discriminant");
6766 when E_Enumeration_Type
=>
6767 Write_Str
("Enum_Pos_To_Rep");
6771 Write_Str
("Extra_Constrained");
6773 when E_Generic_Function |
6775 E_Generic_Procedure
=>
6776 Write_Str
("Inner_Instances");
6778 when Concurrent_Kind |
6779 Incomplete_Or_Private_Kind |
6783 Write_Str
("Girder_Constraint");
6788 Write_Str
("Generic_Renamings");
6790 -- What about Privals_Chain for protected operations ???
6793 Write_Str
("Privals_Chain");
6796 Write_Str
("Field23??");
6798 end Write_Field23_Name
;
6800 -------------------------
6801 -- Iterator Procedures --
6802 -------------------------
6804 procedure Proc_Next_Component
(N
: in out Node_Id
) is
6806 N
:= Next_Component
(N
);
6807 end Proc_Next_Component
;
6809 procedure Proc_Next_Discriminant
(N
: in out Node_Id
) is
6811 N
:= Next_Discriminant
(N
);
6812 end Proc_Next_Discriminant
;
6814 procedure Proc_Next_Formal
(N
: in out Node_Id
) is
6816 N
:= Next_Formal
(N
);
6817 end Proc_Next_Formal
;
6819 procedure Proc_Next_Formal_With_Extras
(N
: in out Node_Id
) is
6821 N
:= Next_Formal_With_Extras
(N
);
6822 end Proc_Next_Formal_With_Extras
;
6824 procedure Proc_Next_Girder_Discriminant
(N
: in out Node_Id
) is
6826 N
:= Next_Girder_Discriminant
(N
);
6827 end Proc_Next_Girder_Discriminant
;
6829 procedure Proc_Next_Index
(N
: in out Node_Id
) is
6831 N
:= Next_Index
(N
);
6832 end Proc_Next_Index
;
6834 procedure Proc_Next_Inlined_Subprogram
(N
: in out Node_Id
) is
6836 N
:= Next_Inlined_Subprogram
(N
);
6837 end Proc_Next_Inlined_Subprogram
;
6839 procedure Proc_Next_Literal
(N
: in out Node_Id
) is
6841 N
:= Next_Literal
(N
);
6842 end Proc_Next_Literal
;