[multiple changes]
[gcc.git] / gcc / ada / einfo.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E I N F O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 pragma Style_Checks (All_Checks);
33 -- Turn off subprogram ordering, not used for this unit
34
35 with Atree; use Atree;
36 with Elists; use Elists;
37 with Namet; use Namet;
38 with Nlists; use Nlists;
39 with Output; use Output;
40 with Sinfo; use Sinfo;
41 with Stand; use Stand;
42
43 package body Einfo is
44
45 use Atree.Unchecked_Access;
46 -- This is one of the packages that is allowed direct untyped access to
47 -- the fields in a node, since it provides the next level abstraction
48 -- which incorporates appropriate checks.
49
50 ----------------------------------------------
51 -- Usage of Fields in Defining Entity Nodes --
52 ----------------------------------------------
53
54 -- Four of these fields are defined in Sinfo, since they in are the base
55 -- part of the node. The access routines for these four fields and the
56 -- corresponding set procedures are defined in Sinfo. These fields are
57 -- present in all entities. Note that Homonym is also in the base part of
58 -- the node, but has access routines that are more properly part of Einfo,
59 -- which is why they are defined here.
60
61 -- Chars Name1
62 -- Next_Entity Node2
63 -- Scope Node3
64 -- Etype Node5
65
66 -- Remaining fields are present only in extended nodes (i.e. entities)
67
68 -- The following fields are present in all entities
69
70 -- Homonym Node4
71 -- First_Rep_Item Node6
72 -- Freeze_Node Node7
73
74 -- The usage of other fields (and the entity kinds to which it applies)
75 -- depends on the particular field (see Einfo spec for details).
76
77 -- Associated_Node_For_Itype Node8
78 -- Dependent_Instances Elist8
79 -- Hiding_Loop_Variable Node8
80 -- Mechanism Uint8 (but returns Mechanism_Type)
81 -- Normalized_First_Bit Uint8
82 -- Postcondition_Proc Node8
83 -- Refined_State_Pragma Node8
84 -- Return_Applies_To Node8
85 -- First_Exit_Statement Node8
86
87 -- Class_Wide_Type Node9
88 -- Current_Value Node9
89 -- Renaming_Map Uint9
90
91 -- Direct_Primitive_Operations Elist10
92 -- Discriminal_Link Node10
93 -- Float_Rep Uint10 (but returns Float_Rep_Kind)
94 -- Handler_Records List10
95 -- Normalized_Position_Max Uint10
96
97 -- Component_Bit_Offset Uint11
98 -- Full_View Node11
99 -- Entry_Component Node11
100 -- Enumeration_Pos Uint11
101 -- Generic_Homonym Node11
102 -- Protected_Body_Subprogram Node11
103 -- Block_Node Node11
104
105 -- Barrier_Function Node12
106 -- Enumeration_Rep Uint12
107 -- Esize Uint12
108 -- Next_Inlined_Subprogram Node12
109
110 -- Component_Clause Node13
111 -- Elaboration_Entity Node13
112 -- Extra_Accessibility Node13
113 -- RM_Size Uint13
114
115 -- Alignment Uint14
116 -- First_Optional_Parameter Node14
117 -- Normalized_Position Uint14
118 -- Shadow_Entities List14
119
120 -- Discriminant_Number Uint15
121 -- DT_Position Uint15
122 -- DT_Entry_Count Uint15
123 -- Entry_Bodies_Array Node15
124 -- Entry_Parameters_Type Node15
125 -- Extra_Formal Node15
126 -- Lit_Indexes Node15
127 -- Related_Instance Node15
128 -- Status_Flag_Or_Transient_Decl Node15
129 -- Scale_Value Uint15
130 -- Storage_Size_Variable Node15
131 -- String_Literal_Low_Bound Node15
132
133 -- Access_Disp_Table Elist16
134 -- Cloned_Subtype Node16
135 -- DTC_Entity Node16
136 -- Entry_Formal Node16
137 -- First_Private_Entity Node16
138 -- Lit_Strings Node16
139 -- String_Literal_Length Uint16
140 -- Unset_Reference Node16
141
142 -- Actual_Subtype Node17
143 -- Digits_Value Uint17
144 -- Discriminal Node17
145 -- First_Entity Node17
146 -- First_Index Node17
147 -- First_Literal Node17
148 -- Master_Id Node17
149 -- Modulus Uint17
150 -- Non_Limited_View Node17
151 -- Prival Node17
152
153 -- Alias Node18
154 -- Corresponding_Concurrent_Type Node18
155 -- Corresponding_Protected_Entry Node18
156 -- Corresponding_Record_Type Node18
157 -- Delta_Value Ureal18
158 -- Enclosing_Scope Node18
159 -- Equivalent_Type Node18
160 -- Private_Dependents Elist18
161 -- Renamed_Entity Node18
162 -- Renamed_Object Node18
163
164 -- Body_Entity Node19
165 -- Corresponding_Discriminant Node19
166 -- Default_Aspect_Component_Value Node19
167 -- Default_Aspect_Value Node19
168 -- Extra_Accessibility_Of_Result Node19
169 -- Parent_Subtype Node19
170 -- Size_Check_Code Node19
171 -- Spec_Entity Node19
172 -- Underlying_Full_View Node19
173
174 -- Component_Type Node20
175 -- Default_Value Node20
176 -- Directly_Designated_Type Node20
177 -- Discriminant_Checking_Func Node20
178 -- Discriminant_Default_Value Node20
179 -- Last_Entity Node20
180 -- Prival_Link Node20
181 -- Register_Exception_Call Node20
182 -- Scalar_Range Node20
183
184 -- Accept_Address Elist21
185 -- Default_Expr_Function Node21
186 -- Discriminant_Constraint Elist21
187 -- Interface_Name Node21
188 -- Original_Array_Type Node21
189 -- Small_Value Ureal21
190
191 -- Associated_Storage_Pool Node22
192 -- Component_Size Uint22
193 -- Corresponding_Remote_Type Node22
194 -- Enumeration_Rep_Expr Node22
195 -- Exception_Code Uint22
196 -- Original_Record_Component Node22
197 -- Private_View Node22
198 -- Protected_Formal Node22
199 -- Scope_Depth_Value Uint22
200 -- Shared_Var_Procs_Instance Node22
201
202 -- CR_Discriminant Node23
203 -- Entry_Cancel_Parameter Node23
204 -- Enum_Pos_To_Rep Node23
205 -- Extra_Constrained Node23
206 -- Finalization_Master Node23
207 -- Generic_Renamings Elist23
208 -- Inner_Instances Elist23
209 -- Limited_View Node23
210 -- Packed_Array_Type Node23
211 -- Protection_Object Node23
212 -- Stored_Constraint Elist23
213
214 -- Finalizer Node24
215 -- Related_Expression Node24
216 -- Contract Node24
217
218 -- Interface_Alias Node25
219 -- Interfaces Elist25
220 -- Debug_Renaming_Link Node25
221 -- DT_Offset_To_Top_Func Node25
222 -- PPC_Wrapper Node25
223 -- Related_Array_Object Node25
224 -- Static_Predicate List25
225 -- Task_Body_Procedure Node25
226
227 -- Dispatch_Table_Wrappers Elist26
228 -- Last_Assignment Node26
229 -- Original_Access_Type Node26
230 -- Overridden_Operation Node26
231 -- Package_Instantiation Node26
232 -- Relative_Deadline_Variable Node26
233
234 -- Current_Use_Clause Node27
235 -- Related_Type Node27
236 -- Wrapped_Entity Node27
237
238 -- Extra_Formals Node28
239 -- Initialization_Statements Node28
240 -- Underlying_Record_View Node28
241
242 -- Subprograms_For_Type Node29
243
244 -- Corresponding_Equality Node30
245 -- Static_Initialization Node30
246
247 -- Thunk_Entity Node31
248
249 -- SPARK_Mode_Pragmas Node32
250
251 -- (unused) Node33
252
253 -- (unused) Node34
254
255 -- (unused) Node35
256
257 ---------------------------------------------
258 -- Usage of Flags in Defining Entity Nodes --
259 ---------------------------------------------
260
261 -- All flags are unique, there is no overlaying, so each flag is physically
262 -- present in every entity. However, for many of the flags, it only makes
263 -- sense for them to be set true for certain subsets of entity kinds. See
264 -- the spec of Einfo for further details.
265
266 -- Note: Flag1-Flag3 are not used, for historical reasons
267
268 -- Is_Frozen Flag4
269 -- Has_Discriminants Flag5
270 -- Is_Dispatching_Operation Flag6
271 -- Is_Immediately_Visible Flag7
272 -- In_Use Flag8
273 -- Is_Potentially_Use_Visible Flag9
274 -- Is_Public Flag10
275
276 -- Is_Inlined Flag11
277 -- Is_Constrained Flag12
278 -- Is_Generic_Type Flag13
279 -- Depends_On_Private Flag14
280 -- Is_Aliased Flag15
281 -- Is_Volatile Flag16
282 -- Is_Internal Flag17
283 -- Has_Delayed_Freeze Flag18
284 -- Is_Abstract_Subprogram Flag19
285 -- Is_Concurrent_Record_Type Flag20
286
287 -- Has_Master_Entity Flag21
288 -- Needs_No_Actuals Flag22
289 -- Has_Storage_Size_Clause Flag23
290 -- Is_Imported Flag24
291 -- Is_Limited_Record Flag25
292 -- Has_Completion Flag26
293 -- Has_Pragma_Controlled Flag27
294 -- Is_Statically_Allocated Flag28
295 -- Has_Size_Clause Flag29
296 -- Has_Task Flag30
297
298 -- Checks_May_Be_Suppressed Flag31
299 -- Kill_Elaboration_Checks Flag32
300 -- Kill_Range_Checks Flag33
301 -- Has_Independent_Components Flag34
302 -- Is_Class_Wide_Equivalent_Type Flag35
303 -- Referenced_As_LHS Flag36
304 -- Is_Known_Non_Null Flag37
305 -- Can_Never_Be_Null Flag38
306 -- Has_Default_Aspect Flag39
307 -- Body_Needed_For_SAL Flag40
308
309 -- Treat_As_Volatile Flag41
310 -- Is_Controlled Flag42
311 -- Has_Controlled_Component Flag43
312 -- Is_Pure Flag44
313 -- In_Private_Part Flag45
314 -- Has_Alignment_Clause Flag46
315 -- Has_Exit Flag47
316 -- In_Package_Body Flag48
317 -- Reachable Flag49
318 -- Delay_Subprogram_Descriptors Flag50
319
320 -- Is_Packed Flag51
321 -- Is_Entry_Formal Flag52
322 -- Is_Private_Descendant Flag53
323 -- Return_Present Flag54
324 -- Is_Tagged_Type Flag55
325 -- Has_Homonym Flag56
326 -- Is_Hidden Flag57
327 -- Non_Binary_Modulus Flag58
328 -- Is_Preelaborated Flag59
329 -- Is_Shared_Passive Flag60
330
331 -- Is_Remote_Types Flag61
332 -- Is_Remote_Call_Interface Flag62
333 -- Is_Character_Type Flag63
334 -- Is_Intrinsic_Subprogram Flag64
335 -- Has_Record_Rep_Clause Flag65
336 -- Has_Enumeration_Rep_Clause Flag66
337 -- Has_Small_Clause Flag67
338 -- Has_Component_Size_Clause Flag68
339 -- Is_Access_Constant Flag69
340 -- Is_First_Subtype Flag70
341
342 -- Has_Completion_In_Body Flag71
343 -- Has_Unknown_Discriminants Flag72
344 -- Is_Child_Unit Flag73
345 -- Is_CPP_Class Flag74
346 -- Has_Non_Standard_Rep Flag75
347 -- Is_Constructor Flag76
348 -- Static_Elaboration_Desired Flag77
349 -- Is_Tag Flag78
350 -- Has_All_Calls_Remote Flag79
351 -- Is_Constr_Subt_For_U_Nominal Flag80
352
353 -- Is_Asynchronous Flag81
354 -- Has_Gigi_Rep_Item Flag82
355 -- Has_Machine_Radix_Clause Flag83
356 -- Machine_Radix_10 Flag84
357 -- Is_Atomic Flag85
358 -- Has_Atomic_Components Flag86
359 -- Has_Volatile_Components Flag87
360 -- Discard_Names Flag88
361 -- Is_Interrupt_Handler Flag89
362 -- Returns_By_Ref Flag90
363
364 -- Is_Itype Flag91
365 -- Size_Known_At_Compile_Time Flag92
366 -- Reverse_Storage_Order Flag93
367 -- Is_Generic_Actual_Type Flag94
368 -- Uses_Sec_Stack Flag95
369 -- Warnings_Off Flag96
370 -- Is_Controlling_Formal Flag97
371 -- Has_Controlling_Result Flag98
372 -- Is_Exported Flag99
373 -- Has_Specified_Layout Flag100
374
375 -- Has_Nested_Block_With_Handler Flag101
376 -- Is_Called Flag102
377 -- Is_Completely_Hidden Flag103
378 -- Address_Taken Flag104
379 -- Suppress_Initialization Flag105
380 -- Is_Limited_Composite Flag106
381 -- Is_Private_Composite Flag107
382 -- Default_Expressions_Processed Flag108
383 -- Is_Non_Static_Subtype Flag109
384 -- Has_External_Tag_Rep_Clause Flag110
385
386 -- Is_Formal_Subprogram Flag111
387 -- Is_Renaming_Of_Object Flag112
388 -- No_Return Flag113
389 -- Delay_Cleanups Flag114
390 -- Never_Set_In_Source Flag115
391 -- Is_Visible_Lib_Unit Flag116
392 -- Is_Unchecked_Union Flag117
393 -- Is_For_Access_Subtype Flag118
394 -- Has_Convention_Pragma Flag119
395 -- Has_Primitive_Operations Flag120
396
397 -- Has_Pragma_Pack Flag121
398 -- Is_Bit_Packed_Array Flag122
399 -- Has_Unchecked_Union Flag123
400 -- Is_Eliminated Flag124
401 -- C_Pass_By_Copy Flag125
402 -- Is_Instantiated Flag126
403 -- Is_Valued_Procedure Flag127
404 -- (used for Component_Alignment) Flag128
405 -- (used for Component_Alignment) Flag129
406 -- Is_Generic_Instance Flag130
407
408 -- No_Pool_Assigned Flag131
409 -- Is_AST_Entry Flag132
410 -- Is_VMS_Exception Flag133
411 -- Is_Optional_Parameter Flag134
412 -- Has_Aliased_Components Flag135
413 -- No_Strict_Aliasing Flag136
414 -- Is_Machine_Code_Subprogram Flag137
415 -- Is_Packed_Array_Type Flag138
416 -- Has_Biased_Representation Flag139
417 -- Has_Complex_Representation Flag140
418
419 -- Is_Constr_Subt_For_UN_Aliased Flag141
420 -- Has_Missing_Return Flag142
421 -- Has_Recursive_Call Flag143
422 -- Is_Unsigned_Type Flag144
423 -- Strict_Alignment Flag145
424 -- Is_Abstract_Type Flag146
425 -- Needs_Debug_Info Flag147
426 -- Suppress_Elaboration_Warnings Flag148
427 -- Is_Compilation_Unit Flag149
428 -- Has_Pragma_Elaborate_Body Flag150
429
430 -- Has_Private_Ancestor Flag151
431 -- Entry_Accepted Flag152
432 -- Is_Obsolescent Flag153
433 -- Has_Per_Object_Constraint Flag154
434 -- Has_Private_Declaration Flag155
435 -- Referenced Flag156
436 -- Has_Pragma_Inline Flag157
437 -- Finalize_Storage_Only Flag158
438 -- From_With_Type Flag159
439 -- Is_Package_Body_Entity Flag160
440
441 -- Has_Qualified_Name Flag161
442 -- Nonzero_Is_True Flag162
443 -- Is_True_Constant Flag163
444 -- Reverse_Bit_Order Flag164
445 -- Suppress_Style_Checks Flag165
446 -- Debug_Info_Off Flag166
447 -- Sec_Stack_Needed_For_Return Flag167
448 -- Materialize_Entity Flag168
449 -- Has_Pragma_Thread_Local_Storage Flag169
450 -- Is_Known_Valid Flag170
451
452 -- Is_Hidden_Open_Scope Flag171
453 -- Has_Object_Size_Clause Flag172
454 -- Has_Fully_Qualified_Name Flag173
455 -- Elaboration_Entity_Required Flag174
456 -- Has_Forward_Instantiation Flag175
457 -- Is_Discrim_SO_Function Flag176
458 -- Size_Depends_On_Discriminant Flag177
459 -- Is_Null_Init_Proc Flag178
460 -- Has_Pragma_Pure_Function Flag179
461 -- Has_Pragma_Unreferenced Flag180
462
463 -- Has_Contiguous_Rep Flag181
464 -- Has_Xref_Entry Flag182
465 -- Must_Be_On_Byte_Boundary Flag183
466 -- Has_Stream_Size_Clause Flag184
467 -- Is_Ada_2005_Only Flag185
468 -- Is_Interface Flag186
469 -- Has_Constrained_Partial_View Flag187
470 -- Uses_Lock_Free Flag188
471 -- Is_Pure_Unit_Access_Type Flag189
472 -- Has_Specified_Stream_Input Flag190
473
474 -- Has_Specified_Stream_Output Flag191
475 -- Has_Specified_Stream_Read Flag192
476 -- Has_Specified_Stream_Write Flag193
477 -- Is_Local_Anonymous_Access Flag194
478 -- Is_Primitive_Wrapper Flag195
479 -- Was_Hidden Flag196
480 -- Is_Limited_Interface Flag197
481 -- Has_Pragma_Ordered Flag198
482 -- Is_Ada_2012_Only Flag199
483
484 -- Has_Delayed_Aspects Flag200
485 -- Has_Pragma_No_Inline Flag201
486 -- Itype_Printed Flag202
487 -- Has_Pragma_Pure Flag203
488 -- Is_Known_Null Flag204
489 -- Low_Bound_Tested Flag205
490 -- Is_Visible_Formal Flag206
491 -- Known_To_Have_Preelab_Init Flag207
492 -- Must_Have_Preelab_Init Flag208
493 -- Is_Return_Object Flag209
494 -- Elaborate_Body_Desirable Flag210
495
496 -- Has_Static_Discriminants Flag211
497 -- Has_Pragma_Unreferenced_Objects Flag212
498 -- Requires_Overriding Flag213
499 -- Has_RACW Flag214
500 -- Has_Up_Level_Access Flag215
501 -- Universal_Aliasing Flag216
502 -- Suppress_Value_Tracking_On_Call Flag217
503 -- Is_Primitive Flag218
504 -- Has_Initial_Value Flag219
505 -- Has_Dispatch_Table Flag220
506
507 -- Has_Pragma_Preelab_Init Flag221
508 -- Used_As_Generic_Actual Flag222
509 -- Is_Descendent_Of_Address Flag223
510 -- Is_Raised Flag224
511 -- Is_Thunk Flag225
512 -- Is_Only_Out_Parameter Flag226
513 -- Referenced_As_Out_Parameter Flag227
514 -- Has_Thunks Flag228
515 -- Can_Use_Internal_Rep Flag229
516 -- Has_Pragma_Inline_Always Flag230
517
518 -- Renamed_In_Spec Flag231
519 -- Has_Invariants Flag232
520 -- Has_Pragma_Unmodified Flag233
521 -- Is_Dispatch_Table_Entity Flag234
522 -- Is_Trivial_Subprogram Flag235
523 -- Warnings_Off_Used Flag236
524 -- Warnings_Off_Used_Unmodified Flag237
525 -- Warnings_Off_Used_Unreferenced Flag238
526 -- OK_To_Reorder_Components Flag239
527 -- Has_Postconditions Flag240
528
529 -- Optimize_Alignment_Space Flag241
530 -- Optimize_Alignment_Time Flag242
531 -- Overlays_Constant Flag243
532 -- Is_RACW_Stub_Type Flag244
533 -- Is_Private_Primitive Flag245
534 -- Is_Underlying_Record_View Flag246
535 -- OK_To_Rename Flag247
536 -- Has_Inheritable_Invariants Flag248
537 -- Is_Safe_To_Reevaluate Flag249
538 -- Has_Predicates Flag250
539
540 -- Has_Implicit_Dereference Flag251
541 -- Is_Processed_Transient Flag252
542 -- Has_Anonymous_Master Flag253
543 -- Is_Implementation_Defined Flag254
544 -- Is_Predicate_Function Flag255
545 -- Is_Predicate_Function_M Flag256
546 -- Is_Invariant_Procedure Flag257
547 -- Has_Dynamic_Predicate_Aspect Flag258
548 -- Has_Static_Predicate_Aspect Flag259
549 -- Has_Loop_Entry_Attributes Flag260
550
551 -- Has_Delayed_Rep_Aspects Flag261
552 -- May_Inherit_Delayed_Rep_Aspects Flag262
553
554 -- (unused) Flag263
555 -- (unused) Flag264
556 -- (unused) Flag265
557 -- (unused) Flag266
558 -- (unused) Flag267
559 -- (unused) Flag268
560 -- (unused) Flag269
561 -- (unused) Flag270
562
563 -- (unused) Flag271
564 -- (unused) Flag272
565 -- (unused) Flag273
566 -- (unused) Flag274
567 -- (unused) Flag275
568 -- (unused) Flag276
569 -- (unused) Flag277
570 -- (unused) Flag278
571 -- (unused) Flag279
572 -- (unused) Flag280
573
574 -- (unused) Flag281
575 -- (unused) Flag282
576 -- (unused) Flag283
577 -- (unused) Flag284
578 -- (unused) Flag285
579 -- (unused) Flag286
580
581 -- Note: Flag287-317 are defined in atree.ads/adb, but not yet in atree.h
582
583 -----------------------
584 -- Local subprograms --
585 -----------------------
586
587 function Has_Option
588 (State : Entity_Id;
589 Opt_Nam : Name_Id) return Boolean;
590 -- Determine whether abstract state State has a particular option denoted
591 -- by the name Opt_Nam.
592
593 ---------------
594 -- Float_Rep --
595 ---------------
596
597 function Float_Rep (Id : E) return F is
598 pragma Assert (Is_Floating_Point_Type (Id));
599 begin
600 return F'Val (UI_To_Int (Uint10 (Base_Type (Id))));
601 end Float_Rep;
602
603 ----------------
604 -- Has_Option --
605 ----------------
606
607 function Has_Option
608 (State : Entity_Id;
609 Opt_Nam : Name_Id) return Boolean
610 is
611 Par : constant Node_Id := Parent (State);
612 Opt : Node_Id;
613
614 begin
615 pragma Assert (Ekind (State) = E_Abstract_State);
616
617 -- States with options appear as extension aggregates in the tree
618
619 if Nkind (Par) = N_Extension_Aggregate then
620 if Opt_Nam = Name_Part_Of then
621 return Present (Component_Associations (Par));
622
623 else
624 Opt := First (Expressions (Par));
625 while Present (Opt) loop
626 if Chars (Opt) = Opt_Nam then
627 return True;
628 end if;
629
630 Next (Opt);
631 end loop;
632 end if;
633 end if;
634
635 return False;
636 end Has_Option;
637
638 --------------------------------
639 -- Attribute Access Functions --
640 --------------------------------
641
642 function Abstract_States (Id : E) return L is
643 begin
644 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
645 return Elist25 (Id);
646 end Abstract_States;
647
648 function Accept_Address (Id : E) return L is
649 begin
650 return Elist21 (Id);
651 end Accept_Address;
652
653 function Access_Disp_Table (Id : E) return L is
654 begin
655 pragma Assert (Ekind_In (Id, E_Record_Type,
656 E_Record_Subtype));
657 return Elist16 (Implementation_Base_Type (Id));
658 end Access_Disp_Table;
659
660 function Actual_Subtype (Id : E) return E is
661 begin
662 pragma Assert
663 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
664 or else Is_Formal (Id));
665 return Node17 (Id);
666 end Actual_Subtype;
667
668 function Address_Taken (Id : E) return B is
669 begin
670 return Flag104 (Id);
671 end Address_Taken;
672
673 function Alias (Id : E) return E is
674 begin
675 pragma Assert
676 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
677 return Node18 (Id);
678 end Alias;
679
680 function Alignment (Id : E) return U is
681 begin
682 pragma Assert (Is_Type (Id)
683 or else Is_Formal (Id)
684 or else Ekind_In (Id, E_Loop_Parameter,
685 E_Constant,
686 E_Exception,
687 E_Variable));
688 return Uint14 (Id);
689 end Alignment;
690
691 function Associated_Formal_Package (Id : E) return E is
692 begin
693 pragma Assert (Ekind (Id) = E_Package);
694 return Node12 (Id);
695 end Associated_Formal_Package;
696
697 function Associated_Node_For_Itype (Id : E) return N is
698 begin
699 return Node8 (Id);
700 end Associated_Node_For_Itype;
701
702 function Associated_Storage_Pool (Id : E) return E is
703 begin
704 pragma Assert (Is_Access_Type (Id));
705 return Node22 (Root_Type (Id));
706 end Associated_Storage_Pool;
707
708 function Barrier_Function (Id : E) return N is
709 begin
710 pragma Assert (Is_Entry (Id));
711 return Node12 (Id);
712 end Barrier_Function;
713
714 function Block_Node (Id : E) return N is
715 begin
716 pragma Assert (Ekind (Id) = E_Block);
717 return Node11 (Id);
718 end Block_Node;
719
720 function Body_Entity (Id : E) return E is
721 begin
722 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
723 return Node19 (Id);
724 end Body_Entity;
725
726 function Body_Needed_For_SAL (Id : E) return B is
727 begin
728 pragma Assert
729 (Ekind (Id) = E_Package
730 or else Is_Subprogram (Id)
731 or else Is_Generic_Unit (Id));
732 return Flag40 (Id);
733 end Body_Needed_For_SAL;
734
735 function C_Pass_By_Copy (Id : E) return B is
736 begin
737 pragma Assert (Is_Record_Type (Id));
738 return Flag125 (Implementation_Base_Type (Id));
739 end C_Pass_By_Copy;
740
741 function Can_Never_Be_Null (Id : E) return B is
742 begin
743 return Flag38 (Id);
744 end Can_Never_Be_Null;
745
746 function Checks_May_Be_Suppressed (Id : E) return B is
747 begin
748 return Flag31 (Id);
749 end Checks_May_Be_Suppressed;
750
751 function Class_Wide_Type (Id : E) return E is
752 begin
753 pragma Assert (Is_Type (Id));
754 return Node9 (Id);
755 end Class_Wide_Type;
756
757 function Cloned_Subtype (Id : E) return E is
758 begin
759 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
760 return Node16 (Id);
761 end Cloned_Subtype;
762
763 function Component_Bit_Offset (Id : E) return U is
764 begin
765 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
766 return Uint11 (Id);
767 end Component_Bit_Offset;
768
769 function Component_Clause (Id : E) return N is
770 begin
771 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
772 return Node13 (Id);
773 end Component_Clause;
774
775 function Component_Size (Id : E) return U is
776 begin
777 pragma Assert (Is_Array_Type (Id));
778 return Uint22 (Implementation_Base_Type (Id));
779 end Component_Size;
780
781 function Component_Type (Id : E) return E is
782 begin
783 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
784 return Node20 (Implementation_Base_Type (Id));
785 end Component_Type;
786
787 function Corresponding_Concurrent_Type (Id : E) return E is
788 begin
789 pragma Assert (Ekind (Id) = E_Record_Type);
790 return Node18 (Id);
791 end Corresponding_Concurrent_Type;
792
793 function Corresponding_Discriminant (Id : E) return E is
794 begin
795 pragma Assert (Ekind (Id) = E_Discriminant);
796 return Node19 (Id);
797 end Corresponding_Discriminant;
798
799 function Corresponding_Equality (Id : E) return E is
800 begin
801 pragma Assert
802 (Ekind (Id) = E_Function
803 and then not Comes_From_Source (Id)
804 and then Chars (Id) = Name_Op_Ne);
805 return Node30 (Id);
806 end Corresponding_Equality;
807
808 function Corresponding_Protected_Entry (Id : E) return E is
809 begin
810 pragma Assert (Ekind (Id) = E_Subprogram_Body);
811 return Node18 (Id);
812 end Corresponding_Protected_Entry;
813
814 function Corresponding_Record_Type (Id : E) return E is
815 begin
816 pragma Assert (Is_Concurrent_Type (Id));
817 return Node18 (Id);
818 end Corresponding_Record_Type;
819
820 function Corresponding_Remote_Type (Id : E) return E is
821 begin
822 return Node22 (Id);
823 end Corresponding_Remote_Type;
824
825 function Current_Use_Clause (Id : E) return E is
826 begin
827 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
828 return Node27 (Id);
829 end Current_Use_Clause;
830
831 function Current_Value (Id : E) return N is
832 begin
833 pragma Assert (Ekind (Id) in Object_Kind);
834 return Node9 (Id);
835 end Current_Value;
836
837 function CR_Discriminant (Id : E) return E is
838 begin
839 return Node23 (Id);
840 end CR_Discriminant;
841
842 function Debug_Info_Off (Id : E) return B is
843 begin
844 return Flag166 (Id);
845 end Debug_Info_Off;
846
847 function Debug_Renaming_Link (Id : E) return E is
848 begin
849 return Node25 (Id);
850 end Debug_Renaming_Link;
851
852 function Default_Aspect_Component_Value (Id : E) return N is
853 begin
854 pragma Assert (Is_Array_Type (Id));
855 return Node19 (Id);
856 end Default_Aspect_Component_Value;
857
858 function Default_Aspect_Value (Id : E) return N is
859 begin
860 pragma Assert (Is_Scalar_Type (Id));
861 return Node19 (Id);
862 end Default_Aspect_Value;
863
864 function Default_Expr_Function (Id : E) return E is
865 begin
866 pragma Assert (Is_Formal (Id));
867 return Node21 (Id);
868 end Default_Expr_Function;
869
870 function Default_Expressions_Processed (Id : E) return B is
871 begin
872 return Flag108 (Id);
873 end Default_Expressions_Processed;
874
875 function Default_Value (Id : E) return N is
876 begin
877 pragma Assert (Is_Formal (Id));
878 return Node20 (Id);
879 end Default_Value;
880
881 function Delay_Cleanups (Id : E) return B is
882 begin
883 return Flag114 (Id);
884 end Delay_Cleanups;
885
886 function Delay_Subprogram_Descriptors (Id : E) return B is
887 begin
888 return Flag50 (Id);
889 end Delay_Subprogram_Descriptors;
890
891 function Delta_Value (Id : E) return R is
892 begin
893 pragma Assert (Is_Fixed_Point_Type (Id));
894 return Ureal18 (Id);
895 end Delta_Value;
896
897 function Dependent_Instances (Id : E) return L is
898 begin
899 pragma Assert (Is_Generic_Instance (Id));
900 return Elist8 (Id);
901 end Dependent_Instances;
902
903 function Depends_On_Private (Id : E) return B is
904 begin
905 pragma Assert (Nkind (Id) in N_Entity);
906 return Flag14 (Id);
907 end Depends_On_Private;
908
909 function Digits_Value (Id : E) return U is
910 begin
911 pragma Assert
912 (Is_Floating_Point_Type (Id)
913 or else Is_Decimal_Fixed_Point_Type (Id));
914 return Uint17 (Id);
915 end Digits_Value;
916
917 function Direct_Primitive_Operations (Id : E) return L is
918 begin
919 pragma Assert (Is_Tagged_Type (Id));
920 return Elist10 (Id);
921 end Direct_Primitive_Operations;
922
923 function Directly_Designated_Type (Id : E) return E is
924 begin
925 pragma Assert (Is_Access_Type (Id));
926 return Node20 (Id);
927 end Directly_Designated_Type;
928
929 function Discard_Names (Id : E) return B is
930 begin
931 return Flag88 (Id);
932 end Discard_Names;
933
934 function Discriminal (Id : E) return E is
935 begin
936 pragma Assert (Ekind (Id) = E_Discriminant);
937 return Node17 (Id);
938 end Discriminal;
939
940 function Discriminal_Link (Id : E) return N is
941 begin
942 return Node10 (Id);
943 end Discriminal_Link;
944
945 function Discriminant_Checking_Func (Id : E) return E is
946 begin
947 pragma Assert (Ekind (Id) = E_Component);
948 return Node20 (Id);
949 end Discriminant_Checking_Func;
950
951 function Discriminant_Constraint (Id : E) return L is
952 begin
953 pragma Assert (Is_Composite_Type (Id) and then Has_Discriminants (Id));
954 return Elist21 (Id);
955 end Discriminant_Constraint;
956
957 function Discriminant_Default_Value (Id : E) return N is
958 begin
959 pragma Assert (Ekind (Id) = E_Discriminant);
960 return Node20 (Id);
961 end Discriminant_Default_Value;
962
963 function Discriminant_Number (Id : E) return U is
964 begin
965 pragma Assert (Ekind (Id) = E_Discriminant);
966 return Uint15 (Id);
967 end Discriminant_Number;
968
969 function Dispatch_Table_Wrappers (Id : E) return L is
970 begin
971 pragma Assert (Ekind_In (Id, E_Record_Type,
972 E_Record_Subtype));
973 return Elist26 (Implementation_Base_Type (Id));
974 end Dispatch_Table_Wrappers;
975
976 function DT_Entry_Count (Id : E) return U is
977 begin
978 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
979 return Uint15 (Id);
980 end DT_Entry_Count;
981
982 function DT_Offset_To_Top_Func (Id : E) return E is
983 begin
984 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
985 return Node25 (Id);
986 end DT_Offset_To_Top_Func;
987
988 function DT_Position (Id : E) return U is
989 begin
990 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
991 and then Present (DTC_Entity (Id)));
992 return Uint15 (Id);
993 end DT_Position;
994
995 function DTC_Entity (Id : E) return E is
996 begin
997 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
998 return Node16 (Id);
999 end DTC_Entity;
1000
1001 function Elaborate_Body_Desirable (Id : E) return B is
1002 begin
1003 pragma Assert (Ekind (Id) = E_Package);
1004 return Flag210 (Id);
1005 end Elaborate_Body_Desirable;
1006
1007 function Elaboration_Entity (Id : E) return E is
1008 begin
1009 pragma Assert
1010 (Is_Subprogram (Id)
1011 or else
1012 Ekind (Id) = E_Package
1013 or else
1014 Is_Generic_Unit (Id));
1015 return Node13 (Id);
1016 end Elaboration_Entity;
1017
1018 function Elaboration_Entity_Required (Id : E) return B is
1019 begin
1020 pragma Assert
1021 (Is_Subprogram (Id)
1022 or else
1023 Ekind (Id) = E_Package
1024 or else
1025 Is_Generic_Unit (Id));
1026 return Flag174 (Id);
1027 end Elaboration_Entity_Required;
1028
1029 function Enclosing_Scope (Id : E) return E is
1030 begin
1031 return Node18 (Id);
1032 end Enclosing_Scope;
1033
1034 function Entry_Accepted (Id : E) return B is
1035 begin
1036 pragma Assert (Is_Entry (Id));
1037 return Flag152 (Id);
1038 end Entry_Accepted;
1039
1040 function Entry_Bodies_Array (Id : E) return E is
1041 begin
1042 return Node15 (Id);
1043 end Entry_Bodies_Array;
1044
1045 function Entry_Cancel_Parameter (Id : E) return E is
1046 begin
1047 return Node23 (Id);
1048 end Entry_Cancel_Parameter;
1049
1050 function Entry_Component (Id : E) return E is
1051 begin
1052 return Node11 (Id);
1053 end Entry_Component;
1054
1055 function Entry_Formal (Id : E) return E is
1056 begin
1057 return Node16 (Id);
1058 end Entry_Formal;
1059
1060 function Entry_Index_Constant (Id : E) return N is
1061 begin
1062 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
1063 return Node18 (Id);
1064 end Entry_Index_Constant;
1065
1066 function Contract (Id : E) return N is
1067 begin
1068 pragma Assert
1069 (Ekind_In (Id, E_Entry, E_Entry_Family, E_Subprogram_Body)
1070 or else Is_Subprogram (Id)
1071 or else Is_Generic_Subprogram (Id));
1072 return Node24 (Id);
1073 end Contract;
1074
1075 function Entry_Parameters_Type (Id : E) return E is
1076 begin
1077 return Node15 (Id);
1078 end Entry_Parameters_Type;
1079
1080 function Enum_Pos_To_Rep (Id : E) return E is
1081 begin
1082 pragma Assert (Ekind (Id) = E_Enumeration_Type);
1083 return Node23 (Id);
1084 end Enum_Pos_To_Rep;
1085
1086 function Enumeration_Pos (Id : E) return Uint is
1087 begin
1088 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1089 return Uint11 (Id);
1090 end Enumeration_Pos;
1091
1092 function Enumeration_Rep (Id : E) return U is
1093 begin
1094 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1095 return Uint12 (Id);
1096 end Enumeration_Rep;
1097
1098 function Enumeration_Rep_Expr (Id : E) return N is
1099 begin
1100 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1101 return Node22 (Id);
1102 end Enumeration_Rep_Expr;
1103
1104 function Equivalent_Type (Id : E) return E is
1105 begin
1106 pragma Assert
1107 (Ekind_In (Id, E_Class_Wide_Type,
1108 E_Class_Wide_Subtype,
1109 E_Access_Protected_Subprogram_Type,
1110 E_Anonymous_Access_Protected_Subprogram_Type,
1111 E_Access_Subprogram_Type,
1112 E_Exception_Type));
1113 return Node18 (Id);
1114 end Equivalent_Type;
1115
1116 function Esize (Id : E) return Uint is
1117 begin
1118 return Uint12 (Id);
1119 end Esize;
1120
1121 function Exception_Code (Id : E) return Uint is
1122 begin
1123 pragma Assert (Ekind (Id) = E_Exception);
1124 return Uint22 (Id);
1125 end Exception_Code;
1126
1127 function Extra_Accessibility (Id : E) return E is
1128 begin
1129 pragma Assert
1130 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
1131 return Node13 (Id);
1132 end Extra_Accessibility;
1133
1134 function Extra_Accessibility_Of_Result (Id : E) return E is
1135 begin
1136 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
1137 return Node19 (Id);
1138 end Extra_Accessibility_Of_Result;
1139
1140 function Extra_Constrained (Id : E) return E is
1141 begin
1142 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
1143 return Node23 (Id);
1144 end Extra_Constrained;
1145
1146 function Extra_Formal (Id : E) return E is
1147 begin
1148 return Node15 (Id);
1149 end Extra_Formal;
1150
1151 function Extra_Formals (Id : E) return E is
1152 begin
1153 pragma Assert
1154 (Is_Overloadable (Id)
1155 or else Ekind_In (Id, E_Entry_Family,
1156 E_Subprogram_Body,
1157 E_Subprogram_Type));
1158 return Node28 (Id);
1159 end Extra_Formals;
1160
1161 function Can_Use_Internal_Rep (Id : E) return B is
1162 begin
1163 pragma Assert (Is_Access_Subprogram_Type (Base_Type (Id)));
1164 return Flag229 (Base_Type (Id));
1165 end Can_Use_Internal_Rep;
1166
1167 function Finalization_Master (Id : E) return E is
1168 begin
1169 pragma Assert (Is_Access_Type (Id));
1170 return Node23 (Root_Type (Id));
1171 end Finalization_Master;
1172
1173 function Finalize_Storage_Only (Id : E) return B is
1174 begin
1175 pragma Assert (Is_Type (Id));
1176 return Flag158 (Base_Type (Id));
1177 end Finalize_Storage_Only;
1178
1179 function Finalizer (Id : E) return E is
1180 begin
1181 pragma Assert
1182 (Ekind (Id) = E_Package
1183 or else Ekind (Id) = E_Package_Body);
1184 return Node24 (Id);
1185 end Finalizer;
1186
1187 function First_Entity (Id : E) return E is
1188 begin
1189 return Node17 (Id);
1190 end First_Entity;
1191
1192 function First_Exit_Statement (Id : E) return N is
1193 begin
1194 pragma Assert (Ekind (Id) = E_Loop);
1195 return Node8 (Id);
1196 end First_Exit_Statement;
1197
1198 function First_Index (Id : E) return N is
1199 begin
1200 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
1201 return Node17 (Id);
1202 end First_Index;
1203
1204 function First_Literal (Id : E) return E is
1205 begin
1206 pragma Assert (Is_Enumeration_Type (Id));
1207 return Node17 (Id);
1208 end First_Literal;
1209
1210 function First_Optional_Parameter (Id : E) return E is
1211 begin
1212 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
1213 return Node14 (Id);
1214 end First_Optional_Parameter;
1215
1216 function First_Private_Entity (Id : E) return E is
1217 begin
1218 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
1219 or else Ekind (Id) in Concurrent_Kind);
1220 return Node16 (Id);
1221 end First_Private_Entity;
1222
1223 function First_Rep_Item (Id : E) return E is
1224 begin
1225 return Node6 (Id);
1226 end First_Rep_Item;
1227
1228 function Freeze_Node (Id : E) return N is
1229 begin
1230 return Node7 (Id);
1231 end Freeze_Node;
1232
1233 function From_With_Type (Id : E) return B is
1234 begin
1235 return Flag159 (Id);
1236 end From_With_Type;
1237
1238 function Full_View (Id : E) return E is
1239 begin
1240 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
1241 return Node11 (Id);
1242 end Full_View;
1243
1244 function Generic_Homonym (Id : E) return E is
1245 begin
1246 pragma Assert (Ekind (Id) = E_Generic_Package);
1247 return Node11 (Id);
1248 end Generic_Homonym;
1249
1250 function Generic_Renamings (Id : E) return L is
1251 begin
1252 return Elist23 (Id);
1253 end Generic_Renamings;
1254
1255 function Handler_Records (Id : E) return S is
1256 begin
1257 return List10 (Id);
1258 end Handler_Records;
1259
1260 function Has_Aliased_Components (Id : E) return B is
1261 begin
1262 return Flag135 (Implementation_Base_Type (Id));
1263 end Has_Aliased_Components;
1264
1265 function Has_Alignment_Clause (Id : E) return B is
1266 begin
1267 return Flag46 (Id);
1268 end Has_Alignment_Clause;
1269
1270 function Has_All_Calls_Remote (Id : E) return B is
1271 begin
1272 return Flag79 (Id);
1273 end Has_All_Calls_Remote;
1274
1275 function Has_Anonymous_Master (Id : E) return B is
1276 begin
1277 pragma Assert
1278 (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
1279 return Flag253 (Id);
1280 end Has_Anonymous_Master;
1281
1282 function Has_Atomic_Components (Id : E) return B is
1283 begin
1284 return Flag86 (Implementation_Base_Type (Id));
1285 end Has_Atomic_Components;
1286
1287 function Has_Biased_Representation (Id : E) return B is
1288 begin
1289 return Flag139 (Id);
1290 end Has_Biased_Representation;
1291
1292 function Has_Completion (Id : E) return B is
1293 begin
1294 return Flag26 (Id);
1295 end Has_Completion;
1296
1297 function Has_Completion_In_Body (Id : E) return B is
1298 begin
1299 pragma Assert (Is_Type (Id));
1300 return Flag71 (Id);
1301 end Has_Completion_In_Body;
1302
1303 function Has_Complex_Representation (Id : E) return B is
1304 begin
1305 pragma Assert (Is_Type (Id));
1306 return Flag140 (Implementation_Base_Type (Id));
1307 end Has_Complex_Representation;
1308
1309 function Has_Component_Size_Clause (Id : E) return B is
1310 begin
1311 pragma Assert (Is_Array_Type (Id));
1312 return Flag68 (Implementation_Base_Type (Id));
1313 end Has_Component_Size_Clause;
1314
1315 function Has_Constrained_Partial_View (Id : E) return B is
1316 begin
1317 pragma Assert (Is_Type (Id));
1318 return Flag187 (Id);
1319 end Has_Constrained_Partial_View;
1320
1321 function Has_Controlled_Component (Id : E) return B is
1322 begin
1323 return Flag43 (Base_Type (Id));
1324 end Has_Controlled_Component;
1325
1326 function Has_Contiguous_Rep (Id : E) return B is
1327 begin
1328 return Flag181 (Id);
1329 end Has_Contiguous_Rep;
1330
1331 function Has_Controlling_Result (Id : E) return B is
1332 begin
1333 return Flag98 (Id);
1334 end Has_Controlling_Result;
1335
1336 function Has_Convention_Pragma (Id : E) return B is
1337 begin
1338 return Flag119 (Id);
1339 end Has_Convention_Pragma;
1340
1341 function Has_Default_Aspect (Id : E) return B is
1342 begin
1343 return Flag39 (Base_Type (Id));
1344 end Has_Default_Aspect;
1345
1346 function Has_Delayed_Aspects (Id : E) return B is
1347 begin
1348 pragma Assert (Nkind (Id) in N_Entity);
1349 return Flag200 (Id);
1350 end Has_Delayed_Aspects;
1351
1352 function Has_Delayed_Freeze (Id : E) return B is
1353 begin
1354 pragma Assert (Nkind (Id) in N_Entity);
1355 return Flag18 (Id);
1356 end Has_Delayed_Freeze;
1357
1358 function Has_Delayed_Rep_Aspects (Id : E) return B is
1359 begin
1360 pragma Assert (Nkind (Id) in N_Entity);
1361 return Flag261 (Id);
1362 end Has_Delayed_Rep_Aspects;
1363
1364 function Has_Discriminants (Id : E) return B is
1365 begin
1366 pragma Assert (Nkind (Id) in N_Entity);
1367 return Flag5 (Id);
1368 end Has_Discriminants;
1369
1370 function Has_Dispatch_Table (Id : E) return B is
1371 begin
1372 pragma Assert (Is_Tagged_Type (Id));
1373 return Flag220 (Id);
1374 end Has_Dispatch_Table;
1375
1376 function Has_Dynamic_Predicate_Aspect (Id : E) return B is
1377 begin
1378 pragma Assert (Is_Type (Id));
1379 return Flag258 (Id);
1380 end Has_Dynamic_Predicate_Aspect;
1381
1382 function Has_Enumeration_Rep_Clause (Id : E) return B is
1383 begin
1384 pragma Assert (Is_Enumeration_Type (Id));
1385 return Flag66 (Id);
1386 end Has_Enumeration_Rep_Clause;
1387
1388 function Has_Exit (Id : E) return B is
1389 begin
1390 return Flag47 (Id);
1391 end Has_Exit;
1392
1393 function Has_External_Tag_Rep_Clause (Id : E) return B is
1394 begin
1395 pragma Assert (Is_Tagged_Type (Id));
1396 return Flag110 (Id);
1397 end Has_External_Tag_Rep_Clause;
1398
1399 function Has_Forward_Instantiation (Id : E) return B is
1400 begin
1401 return Flag175 (Id);
1402 end Has_Forward_Instantiation;
1403
1404 function Has_Fully_Qualified_Name (Id : E) return B is
1405 begin
1406 return Flag173 (Id);
1407 end Has_Fully_Qualified_Name;
1408
1409 function Has_Gigi_Rep_Item (Id : E) return B is
1410 begin
1411 return Flag82 (Id);
1412 end Has_Gigi_Rep_Item;
1413
1414 function Has_Homonym (Id : E) return B is
1415 begin
1416 return Flag56 (Id);
1417 end Has_Homonym;
1418
1419 function Has_Implicit_Dereference (Id : E) return B is
1420 begin
1421 return Flag251 (Id);
1422 end Has_Implicit_Dereference;
1423
1424 function Has_Independent_Components (Id : E) return B is
1425 begin
1426 pragma Assert (Is_Object (Id) or else Is_Type (Id));
1427 return Flag34 (Id);
1428 end Has_Independent_Components;
1429
1430 function Has_Inheritable_Invariants (Id : E) return B is
1431 begin
1432 pragma Assert (Is_Type (Id));
1433 return Flag248 (Id);
1434 end Has_Inheritable_Invariants;
1435
1436 function Has_Initial_Value (Id : E) return B is
1437 begin
1438 pragma Assert (Ekind (Id) = E_Variable or else Is_Formal (Id));
1439 return Flag219 (Id);
1440 end Has_Initial_Value;
1441
1442 function Has_Invariants (Id : E) return B is
1443 begin
1444 pragma Assert (Is_Type (Id));
1445 return Flag232 (Id);
1446 end Has_Invariants;
1447
1448 function Has_Loop_Entry_Attributes (Id : E) return B is
1449 begin
1450 pragma Assert (Ekind (Id) = E_Loop);
1451 return Flag260 (Id);
1452 end Has_Loop_Entry_Attributes;
1453
1454 function Has_Machine_Radix_Clause (Id : E) return B is
1455 begin
1456 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
1457 return Flag83 (Id);
1458 end Has_Machine_Radix_Clause;
1459
1460 function Has_Master_Entity (Id : E) return B is
1461 begin
1462 return Flag21 (Id);
1463 end Has_Master_Entity;
1464
1465 function Has_Missing_Return (Id : E) return B is
1466 begin
1467 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
1468 return Flag142 (Id);
1469 end Has_Missing_Return;
1470
1471 function Has_Nested_Block_With_Handler (Id : E) return B is
1472 begin
1473 return Flag101 (Id);
1474 end Has_Nested_Block_With_Handler;
1475
1476 function Has_Non_Standard_Rep (Id : E) return B is
1477 begin
1478 return Flag75 (Implementation_Base_Type (Id));
1479 end Has_Non_Standard_Rep;
1480
1481 function Has_Object_Size_Clause (Id : E) return B is
1482 begin
1483 pragma Assert (Is_Type (Id));
1484 return Flag172 (Id);
1485 end Has_Object_Size_Clause;
1486
1487 function Has_Per_Object_Constraint (Id : E) return B is
1488 begin
1489 return Flag154 (Id);
1490 end Has_Per_Object_Constraint;
1491
1492 function Has_Postconditions (Id : E) return B is
1493 begin
1494 pragma Assert (Is_Subprogram (Id));
1495 return Flag240 (Id);
1496 end Has_Postconditions;
1497
1498 function Has_Pragma_Controlled (Id : E) return B is
1499 begin
1500 pragma Assert (Is_Access_Type (Id));
1501 return Flag27 (Implementation_Base_Type (Id));
1502 end Has_Pragma_Controlled;
1503
1504 function Has_Pragma_Elaborate_Body (Id : E) return B is
1505 begin
1506 return Flag150 (Id);
1507 end Has_Pragma_Elaborate_Body;
1508
1509 function Has_Pragma_Inline (Id : E) return B is
1510 begin
1511 return Flag157 (Id);
1512 end Has_Pragma_Inline;
1513
1514 function Has_Pragma_Inline_Always (Id : E) return B is
1515 begin
1516 return Flag230 (Id);
1517 end Has_Pragma_Inline_Always;
1518
1519 function Has_Pragma_No_Inline (Id : E) return B is
1520 begin
1521 return Flag201 (Id);
1522 end Has_Pragma_No_Inline;
1523
1524 function Has_Pragma_Ordered (Id : E) return B is
1525 begin
1526 pragma Assert (Is_Enumeration_Type (Id));
1527 return Flag198 (Implementation_Base_Type (Id));
1528 end Has_Pragma_Ordered;
1529
1530 function Has_Pragma_Pack (Id : E) return B is
1531 begin
1532 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
1533 return Flag121 (Implementation_Base_Type (Id));
1534 end Has_Pragma_Pack;
1535
1536 function Has_Pragma_Preelab_Init (Id : E) return B is
1537 begin
1538 return Flag221 (Id);
1539 end Has_Pragma_Preelab_Init;
1540
1541 function Has_Pragma_Pure (Id : E) return B is
1542 begin
1543 return Flag203 (Id);
1544 end Has_Pragma_Pure;
1545
1546 function Has_Pragma_Pure_Function (Id : E) return B is
1547 begin
1548 return Flag179 (Id);
1549 end Has_Pragma_Pure_Function;
1550
1551 function Has_Pragma_Thread_Local_Storage (Id : E) return B is
1552 begin
1553 return Flag169 (Id);
1554 end Has_Pragma_Thread_Local_Storage;
1555
1556 function Has_Pragma_Unmodified (Id : E) return B is
1557 begin
1558 return Flag233 (Id);
1559 end Has_Pragma_Unmodified;
1560
1561 function Has_Pragma_Unreferenced (Id : E) return B is
1562 begin
1563 return Flag180 (Id);
1564 end Has_Pragma_Unreferenced;
1565
1566 function Has_Pragma_Unreferenced_Objects (Id : E) return B is
1567 begin
1568 pragma Assert (Is_Type (Id));
1569 return Flag212 (Id);
1570 end Has_Pragma_Unreferenced_Objects;
1571
1572 function Has_Predicates (Id : E) return B is
1573 begin
1574 pragma Assert (Is_Type (Id));
1575 return Flag250 (Id);
1576 end Has_Predicates;
1577
1578 function Has_Primitive_Operations (Id : E) return B is
1579 begin
1580 pragma Assert (Is_Type (Id));
1581 return Flag120 (Base_Type (Id));
1582 end Has_Primitive_Operations;
1583
1584 function Has_Private_Ancestor (Id : E) return B is
1585 begin
1586 return Flag151 (Id);
1587 end Has_Private_Ancestor;
1588
1589 function Has_Private_Declaration (Id : E) return B is
1590 begin
1591 return Flag155 (Id);
1592 end Has_Private_Declaration;
1593
1594 function Has_Qualified_Name (Id : E) return B is
1595 begin
1596 return Flag161 (Id);
1597 end Has_Qualified_Name;
1598
1599 function Has_RACW (Id : E) return B is
1600 begin
1601 pragma Assert (Ekind (Id) = E_Package);
1602 return Flag214 (Id);
1603 end Has_RACW;
1604
1605 function Has_Record_Rep_Clause (Id : E) return B is
1606 begin
1607 pragma Assert (Is_Record_Type (Id));
1608 return Flag65 (Implementation_Base_Type (Id));
1609 end Has_Record_Rep_Clause;
1610
1611 function Has_Recursive_Call (Id : E) return B is
1612 begin
1613 pragma Assert (Is_Subprogram (Id));
1614 return Flag143 (Id);
1615 end Has_Recursive_Call;
1616
1617 function Has_Size_Clause (Id : E) return B is
1618 begin
1619 return Flag29 (Id);
1620 end Has_Size_Clause;
1621
1622 function Has_Small_Clause (Id : E) return B is
1623 begin
1624 return Flag67 (Id);
1625 end Has_Small_Clause;
1626
1627 function Has_Specified_Layout (Id : E) return B is
1628 begin
1629 pragma Assert (Is_Type (Id));
1630 return Flag100 (Implementation_Base_Type (Id));
1631 end Has_Specified_Layout;
1632
1633 function Has_Specified_Stream_Input (Id : E) return B is
1634 begin
1635 pragma Assert (Is_Type (Id));
1636 return Flag190 (Id);
1637 end Has_Specified_Stream_Input;
1638
1639 function Has_Specified_Stream_Output (Id : E) return B is
1640 begin
1641 pragma Assert (Is_Type (Id));
1642 return Flag191 (Id);
1643 end Has_Specified_Stream_Output;
1644
1645 function Has_Specified_Stream_Read (Id : E) return B is
1646 begin
1647 pragma Assert (Is_Type (Id));
1648 return Flag192 (Id);
1649 end Has_Specified_Stream_Read;
1650
1651 function Has_Specified_Stream_Write (Id : E) return B is
1652 begin
1653 pragma Assert (Is_Type (Id));
1654 return Flag193 (Id);
1655 end Has_Specified_Stream_Write;
1656
1657 function Has_Static_Discriminants (Id : E) return B is
1658 begin
1659 pragma Assert (Is_Type (Id));
1660 return Flag211 (Id);
1661 end Has_Static_Discriminants;
1662
1663 function Has_Static_Predicate_Aspect (Id : E) return B is
1664 begin
1665 pragma Assert (Is_Type (Id));
1666 return Flag259 (Id);
1667 end Has_Static_Predicate_Aspect;
1668
1669 function Has_Storage_Size_Clause (Id : E) return B is
1670 begin
1671 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
1672 return Flag23 (Implementation_Base_Type (Id));
1673 end Has_Storage_Size_Clause;
1674
1675 function Has_Stream_Size_Clause (Id : E) return B is
1676 begin
1677 return Flag184 (Id);
1678 end Has_Stream_Size_Clause;
1679
1680 function Has_Task (Id : E) return B is
1681 begin
1682 return Flag30 (Base_Type (Id));
1683 end Has_Task;
1684
1685 function Has_Thunks (Id : E) return B is
1686 begin
1687 return Flag228 (Id);
1688 end Has_Thunks;
1689
1690 function Has_Unchecked_Union (Id : E) return B is
1691 begin
1692 return Flag123 (Base_Type (Id));
1693 end Has_Unchecked_Union;
1694
1695 function Has_Unknown_Discriminants (Id : E) return B is
1696 begin
1697 pragma Assert (Is_Type (Id));
1698 return Flag72 (Id);
1699 end Has_Unknown_Discriminants;
1700
1701 function Has_Up_Level_Access (Id : E) return B is
1702 begin
1703 pragma Assert
1704 (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter));
1705 return Flag215 (Id);
1706 end Has_Up_Level_Access;
1707
1708 function Has_Volatile_Components (Id : E) return B is
1709 begin
1710 return Flag87 (Implementation_Base_Type (Id));
1711 end Has_Volatile_Components;
1712
1713 function Has_Xref_Entry (Id : E) return B is
1714 begin
1715 return Flag182 (Id);
1716 end Has_Xref_Entry;
1717
1718 function Hiding_Loop_Variable (Id : E) return E is
1719 begin
1720 pragma Assert (Ekind (Id) = E_Variable);
1721 return Node8 (Id);
1722 end Hiding_Loop_Variable;
1723
1724 function Homonym (Id : E) return E is
1725 begin
1726 return Node4 (Id);
1727 end Homonym;
1728
1729 function Interface_Alias (Id : E) return E is
1730 begin
1731 pragma Assert (Is_Subprogram (Id));
1732 return Node25 (Id);
1733 end Interface_Alias;
1734
1735 function Interfaces (Id : E) return L is
1736 begin
1737 pragma Assert (Is_Record_Type (Id));
1738 return Elist25 (Id);
1739 end Interfaces;
1740
1741 function In_Package_Body (Id : E) return B is
1742 begin
1743 return Flag48 (Id);
1744 end In_Package_Body;
1745
1746 function In_Private_Part (Id : E) return B is
1747 begin
1748 return Flag45 (Id);
1749 end In_Private_Part;
1750
1751 function In_Use (Id : E) return B is
1752 begin
1753 pragma Assert (Nkind (Id) in N_Entity);
1754 return Flag8 (Id);
1755 end In_Use;
1756
1757 function Initialization_Statements (Id : E) return N is
1758 begin
1759 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
1760 return Node28 (Id);
1761 end Initialization_Statements;
1762
1763 function Inner_Instances (Id : E) return L is
1764 begin
1765 return Elist23 (Id);
1766 end Inner_Instances;
1767
1768 function Interface_Name (Id : E) return N is
1769 begin
1770 return Node21 (Id);
1771 end Interface_Name;
1772
1773 function Is_Abstract_Subprogram (Id : E) return B is
1774 begin
1775 pragma Assert (Is_Overloadable (Id));
1776 return Flag19 (Id);
1777 end Is_Abstract_Subprogram;
1778
1779 function Is_Abstract_Type (Id : E) return B is
1780 begin
1781 pragma Assert (Is_Type (Id));
1782 return Flag146 (Id);
1783 end Is_Abstract_Type;
1784
1785 function Is_Local_Anonymous_Access (Id : E) return B is
1786 begin
1787 pragma Assert (Is_Access_Type (Id));
1788 return Flag194 (Id);
1789 end Is_Local_Anonymous_Access;
1790
1791 function Is_Access_Constant (Id : E) return B is
1792 begin
1793 pragma Assert (Is_Access_Type (Id));
1794 return Flag69 (Id);
1795 end Is_Access_Constant;
1796
1797 function Is_Ada_2005_Only (Id : E) return B is
1798 begin
1799 return Flag185 (Id);
1800 end Is_Ada_2005_Only;
1801
1802 function Is_Ada_2012_Only (Id : E) return B is
1803 begin
1804 return Flag199 (Id);
1805 end Is_Ada_2012_Only;
1806
1807 function Is_Aliased (Id : E) return B is
1808 begin
1809 pragma Assert (Nkind (Id) in N_Entity);
1810 return Flag15 (Id);
1811 end Is_Aliased;
1812
1813 function Is_AST_Entry (Id : E) return B is
1814 begin
1815 pragma Assert (Is_Entry (Id));
1816 return Flag132 (Id);
1817 end Is_AST_Entry;
1818
1819 function Is_Asynchronous (Id : E) return B is
1820 begin
1821 pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id));
1822 return Flag81 (Id);
1823 end Is_Asynchronous;
1824
1825 function Is_Atomic (Id : E) return B is
1826 begin
1827 return Flag85 (Id);
1828 end Is_Atomic;
1829
1830 function Is_Bit_Packed_Array (Id : E) return B is
1831 begin
1832 return Flag122 (Implementation_Base_Type (Id));
1833 end Is_Bit_Packed_Array;
1834
1835 function Is_Called (Id : E) return B is
1836 begin
1837 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
1838 return Flag102 (Id);
1839 end Is_Called;
1840
1841 function Is_Character_Type (Id : E) return B is
1842 begin
1843 return Flag63 (Id);
1844 end Is_Character_Type;
1845
1846 function Is_Child_Unit (Id : E) return B is
1847 begin
1848 return Flag73 (Id);
1849 end Is_Child_Unit;
1850
1851 function Is_Class_Wide_Equivalent_Type (Id : E) return B is
1852 begin
1853 return Flag35 (Id);
1854 end Is_Class_Wide_Equivalent_Type;
1855
1856 function Is_Compilation_Unit (Id : E) return B is
1857 begin
1858 return Flag149 (Id);
1859 end Is_Compilation_Unit;
1860
1861 function Is_Completely_Hidden (Id : E) return B is
1862 begin
1863 pragma Assert (Ekind (Id) = E_Discriminant);
1864 return Flag103 (Id);
1865 end Is_Completely_Hidden;
1866
1867 function Is_Constr_Subt_For_U_Nominal (Id : E) return B is
1868 begin
1869 return Flag80 (Id);
1870 end Is_Constr_Subt_For_U_Nominal;
1871
1872 function Is_Constr_Subt_For_UN_Aliased (Id : E) return B is
1873 begin
1874 return Flag141 (Id);
1875 end Is_Constr_Subt_For_UN_Aliased;
1876
1877 function Is_Constrained (Id : E) return B is
1878 begin
1879 pragma Assert (Nkind (Id) in N_Entity);
1880 return Flag12 (Id);
1881 end Is_Constrained;
1882
1883 function Is_Constructor (Id : E) return B is
1884 begin
1885 return Flag76 (Id);
1886 end Is_Constructor;
1887
1888 function Is_Controlled (Id : E) return B is
1889 begin
1890 return Flag42 (Base_Type (Id));
1891 end Is_Controlled;
1892
1893 function Is_Controlling_Formal (Id : E) return B is
1894 begin
1895 pragma Assert (Is_Formal (Id));
1896 return Flag97 (Id);
1897 end Is_Controlling_Formal;
1898
1899 function Is_CPP_Class (Id : E) return B is
1900 begin
1901 return Flag74 (Id);
1902 end Is_CPP_Class;
1903
1904 function Is_Descendent_Of_Address (Id : E) return B is
1905 begin
1906 pragma Assert (Is_Type (Id));
1907 return Flag223 (Id);
1908 end Is_Descendent_Of_Address;
1909
1910 function Is_Discrim_SO_Function (Id : E) return B is
1911 begin
1912 return Flag176 (Id);
1913 end Is_Discrim_SO_Function;
1914
1915 function Is_Dispatch_Table_Entity (Id : E) return B is
1916 begin
1917 return Flag234 (Id);
1918 end Is_Dispatch_Table_Entity;
1919
1920 function Is_Dispatching_Operation (Id : E) return B is
1921 begin
1922 pragma Assert (Nkind (Id) in N_Entity);
1923 return Flag6 (Id);
1924 end Is_Dispatching_Operation;
1925
1926 function Is_Eliminated (Id : E) return B is
1927 begin
1928 return Flag124 (Id);
1929 end Is_Eliminated;
1930
1931 function Is_Entry_Formal (Id : E) return B is
1932 begin
1933 return Flag52 (Id);
1934 end Is_Entry_Formal;
1935
1936 function Is_Exported (Id : E) return B is
1937 begin
1938 return Flag99 (Id);
1939 end Is_Exported;
1940
1941 function Is_First_Subtype (Id : E) return B is
1942 begin
1943 return Flag70 (Id);
1944 end Is_First_Subtype;
1945
1946 function Is_For_Access_Subtype (Id : E) return B is
1947 begin
1948 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
1949 return Flag118 (Id);
1950 end Is_For_Access_Subtype;
1951
1952 function Is_Formal_Subprogram (Id : E) return B is
1953 begin
1954 return Flag111 (Id);
1955 end Is_Formal_Subprogram;
1956
1957 function Is_Frozen (Id : E) return B is
1958 begin
1959 return Flag4 (Id);
1960 end Is_Frozen;
1961
1962 function Is_Generic_Actual_Type (Id : E) return B is
1963 begin
1964 pragma Assert (Is_Type (Id));
1965 return Flag94 (Id);
1966 end Is_Generic_Actual_Type;
1967
1968 function Is_Generic_Instance (Id : E) return B is
1969 begin
1970 return Flag130 (Id);
1971 end Is_Generic_Instance;
1972
1973 function Is_Generic_Type (Id : E) return B is
1974 begin
1975 pragma Assert (Nkind (Id) in N_Entity);
1976 return Flag13 (Id);
1977 end Is_Generic_Type;
1978
1979 function Is_Hidden (Id : E) return B is
1980 begin
1981 return Flag57 (Id);
1982 end Is_Hidden;
1983
1984 function Is_Hidden_Open_Scope (Id : E) return B is
1985 begin
1986 return Flag171 (Id);
1987 end Is_Hidden_Open_Scope;
1988
1989 function Is_Immediately_Visible (Id : E) return B is
1990 begin
1991 pragma Assert (Nkind (Id) in N_Entity);
1992 return Flag7 (Id);
1993 end Is_Immediately_Visible;
1994
1995 function Is_Implementation_Defined (Id : E) return B is
1996 begin
1997 return Flag254 (Id);
1998 end Is_Implementation_Defined;
1999
2000 function Is_Imported (Id : E) return B is
2001 begin
2002 return Flag24 (Id);
2003 end Is_Imported;
2004
2005 function Is_Inlined (Id : E) return B is
2006 begin
2007 return Flag11 (Id);
2008 end Is_Inlined;
2009
2010 function Is_Interface (Id : E) return B is
2011 begin
2012 return Flag186 (Id);
2013 end Is_Interface;
2014
2015 function Is_Instantiated (Id : E) return B is
2016 begin
2017 return Flag126 (Id);
2018 end Is_Instantiated;
2019
2020 function Is_Internal (Id : E) return B is
2021 begin
2022 pragma Assert (Nkind (Id) in N_Entity);
2023 return Flag17 (Id);
2024 end Is_Internal;
2025
2026 function Is_Interrupt_Handler (Id : E) return B is
2027 begin
2028 pragma Assert (Nkind (Id) in N_Entity);
2029 return Flag89 (Id);
2030 end Is_Interrupt_Handler;
2031
2032 function Is_Intrinsic_Subprogram (Id : E) return B is
2033 begin
2034 return Flag64 (Id);
2035 end Is_Intrinsic_Subprogram;
2036
2037 function Is_Invariant_Procedure (Id : E) return B is
2038 begin
2039 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2040 return Flag257 (Id);
2041 end Is_Invariant_Procedure;
2042
2043 function Is_Itype (Id : E) return B is
2044 begin
2045 return Flag91 (Id);
2046 end Is_Itype;
2047
2048 function Is_Known_Non_Null (Id : E) return B is
2049 begin
2050 return Flag37 (Id);
2051 end Is_Known_Non_Null;
2052
2053 function Is_Known_Null (Id : E) return B is
2054 begin
2055 return Flag204 (Id);
2056 end Is_Known_Null;
2057
2058 function Is_Known_Valid (Id : E) return B is
2059 begin
2060 return Flag170 (Id);
2061 end Is_Known_Valid;
2062
2063 function Is_Limited_Composite (Id : E) return B is
2064 begin
2065 return Flag106 (Id);
2066 end Is_Limited_Composite;
2067
2068 function Is_Limited_Interface (Id : E) return B is
2069 begin
2070 return Flag197 (Id);
2071 end Is_Limited_Interface;
2072
2073 function Is_Limited_Record (Id : E) return B is
2074 begin
2075 return Flag25 (Id);
2076 end Is_Limited_Record;
2077
2078 function Is_Machine_Code_Subprogram (Id : E) return B is
2079 begin
2080 pragma Assert (Is_Subprogram (Id));
2081 return Flag137 (Id);
2082 end Is_Machine_Code_Subprogram;
2083
2084 function Is_Non_Static_Subtype (Id : E) return B is
2085 begin
2086 pragma Assert (Is_Type (Id));
2087 return Flag109 (Id);
2088 end Is_Non_Static_Subtype;
2089
2090 function Is_Null_Init_Proc (Id : E) return B is
2091 begin
2092 pragma Assert (Ekind (Id) = E_Procedure);
2093 return Flag178 (Id);
2094 end Is_Null_Init_Proc;
2095
2096 function Is_Obsolescent (Id : E) return B is
2097 begin
2098 return Flag153 (Id);
2099 end Is_Obsolescent;
2100
2101 function Is_Only_Out_Parameter (Id : E) return B is
2102 begin
2103 pragma Assert (Is_Formal (Id));
2104 return Flag226 (Id);
2105 end Is_Only_Out_Parameter;
2106
2107 function Is_Optional_Parameter (Id : E) return B is
2108 begin
2109 pragma Assert (Is_Formal (Id));
2110 return Flag134 (Id);
2111 end Is_Optional_Parameter;
2112
2113 function Is_Package_Body_Entity (Id : E) return B is
2114 begin
2115 return Flag160 (Id);
2116 end Is_Package_Body_Entity;
2117
2118 function Is_Packed (Id : E) return B is
2119 begin
2120 return Flag51 (Implementation_Base_Type (Id));
2121 end Is_Packed;
2122
2123 function Is_Packed_Array_Type (Id : E) return B is
2124 begin
2125 return Flag138 (Id);
2126 end Is_Packed_Array_Type;
2127
2128 function Is_Potentially_Use_Visible (Id : E) return B is
2129 begin
2130 pragma Assert (Nkind (Id) in N_Entity);
2131 return Flag9 (Id);
2132 end Is_Potentially_Use_Visible;
2133
2134 function Is_Predicate_Function (Id : E) return B is
2135 begin
2136 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2137 return Flag255 (Id);
2138 end Is_Predicate_Function;
2139
2140 function Is_Predicate_Function_M (Id : E) return B is
2141 begin
2142 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2143 return Flag256 (Id);
2144 end Is_Predicate_Function_M;
2145
2146 function Is_Preelaborated (Id : E) return B is
2147 begin
2148 return Flag59 (Id);
2149 end Is_Preelaborated;
2150
2151 function Is_Primitive (Id : E) return B is
2152 begin
2153 pragma Assert
2154 (Is_Overloadable (Id)
2155 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
2156 return Flag218 (Id);
2157 end Is_Primitive;
2158
2159 function Is_Primitive_Wrapper (Id : E) return B is
2160 begin
2161 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2162 return Flag195 (Id);
2163 end Is_Primitive_Wrapper;
2164
2165 function Is_Private_Composite (Id : E) return B is
2166 begin
2167 pragma Assert (Is_Type (Id));
2168 return Flag107 (Id);
2169 end Is_Private_Composite;
2170
2171 function Is_Private_Descendant (Id : E) return B is
2172 begin
2173 return Flag53 (Id);
2174 end Is_Private_Descendant;
2175
2176 function Is_Private_Primitive (Id : E) return B is
2177 begin
2178 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2179 return Flag245 (Id);
2180 end Is_Private_Primitive;
2181
2182 function Is_Processed_Transient (Id : E) return B is
2183 begin
2184 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2185 return Flag252 (Id);
2186 end Is_Processed_Transient;
2187
2188 function Is_Public (Id : E) return B is
2189 begin
2190 pragma Assert (Nkind (Id) in N_Entity);
2191 return Flag10 (Id);
2192 end Is_Public;
2193
2194 function Is_Pure (Id : E) return B is
2195 begin
2196 return Flag44 (Id);
2197 end Is_Pure;
2198
2199 function Is_Pure_Unit_Access_Type (Id : E) return B is
2200 begin
2201 pragma Assert (Is_Access_Type (Id));
2202 return Flag189 (Id);
2203 end Is_Pure_Unit_Access_Type;
2204
2205 function Is_RACW_Stub_Type (Id : E) return B is
2206 begin
2207 pragma Assert (Is_Type (Id));
2208 return Flag244 (Id);
2209 end Is_RACW_Stub_Type;
2210
2211 function Is_Raised (Id : E) return B is
2212 begin
2213 pragma Assert (Ekind (Id) = E_Exception);
2214 return Flag224 (Id);
2215 end Is_Raised;
2216
2217 function Is_Remote_Call_Interface (Id : E) return B is
2218 begin
2219 return Flag62 (Id);
2220 end Is_Remote_Call_Interface;
2221
2222 function Is_Remote_Types (Id : E) return B is
2223 begin
2224 return Flag61 (Id);
2225 end Is_Remote_Types;
2226
2227 function Is_Renaming_Of_Object (Id : E) return B is
2228 begin
2229 return Flag112 (Id);
2230 end Is_Renaming_Of_Object;
2231
2232 function Is_Return_Object (Id : E) return B is
2233 begin
2234 return Flag209 (Id);
2235 end Is_Return_Object;
2236
2237 function Is_Safe_To_Reevaluate (Id : E) return B is
2238 begin
2239 return Flag249 (Id);
2240 end Is_Safe_To_Reevaluate;
2241
2242 function Is_Shared_Passive (Id : E) return B is
2243 begin
2244 return Flag60 (Id);
2245 end Is_Shared_Passive;
2246
2247 function Is_Statically_Allocated (Id : E) return B is
2248 begin
2249 return Flag28 (Id);
2250 end Is_Statically_Allocated;
2251
2252 function Is_Tag (Id : E) return B is
2253 begin
2254 pragma Assert (Nkind (Id) in N_Entity);
2255 return Flag78 (Id);
2256 end Is_Tag;
2257
2258 function Is_Tagged_Type (Id : E) return B is
2259 begin
2260 return Flag55 (Id);
2261 end Is_Tagged_Type;
2262
2263 function Is_Thunk (Id : E) return B is
2264 begin
2265 return Flag225 (Id);
2266 end Is_Thunk;
2267
2268 function Is_Trivial_Subprogram (Id : E) return B is
2269 begin
2270 return Flag235 (Id);
2271 end Is_Trivial_Subprogram;
2272
2273 function Is_True_Constant (Id : E) return B is
2274 begin
2275 return Flag163 (Id);
2276 end Is_True_Constant;
2277
2278 function Is_Unchecked_Union (Id : E) return B is
2279 begin
2280 return Flag117 (Implementation_Base_Type (Id));
2281 end Is_Unchecked_Union;
2282
2283 function Is_Underlying_Record_View (Id : E) return B is
2284 begin
2285 return Flag246 (Id);
2286 end Is_Underlying_Record_View;
2287
2288 function Is_Unsigned_Type (Id : E) return B is
2289 begin
2290 pragma Assert (Is_Type (Id));
2291 return Flag144 (Id);
2292 end Is_Unsigned_Type;
2293
2294 function Is_Valued_Procedure (Id : E) return B is
2295 begin
2296 pragma Assert (Ekind (Id) = E_Procedure);
2297 return Flag127 (Id);
2298 end Is_Valued_Procedure;
2299
2300 function Is_Visible_Formal (Id : E) return B is
2301 begin
2302 return Flag206 (Id);
2303 end Is_Visible_Formal;
2304
2305 function Is_Visible_Lib_Unit (Id : E) return B is
2306 begin
2307 return Flag116 (Id);
2308 end Is_Visible_Lib_Unit;
2309
2310 function Is_VMS_Exception (Id : E) return B is
2311 begin
2312 return Flag133 (Id);
2313 end Is_VMS_Exception;
2314
2315 function Is_Volatile (Id : E) return B is
2316 begin
2317 pragma Assert (Nkind (Id) in N_Entity);
2318
2319 if Is_Type (Id) then
2320 return Flag16 (Base_Type (Id));
2321 else
2322 return Flag16 (Id);
2323 end if;
2324 end Is_Volatile;
2325
2326 function Itype_Printed (Id : E) return B is
2327 begin
2328 pragma Assert (Is_Itype (Id));
2329 return Flag202 (Id);
2330 end Itype_Printed;
2331
2332 function Kill_Elaboration_Checks (Id : E) return B is
2333 begin
2334 return Flag32 (Id);
2335 end Kill_Elaboration_Checks;
2336
2337 function Kill_Range_Checks (Id : E) return B is
2338 begin
2339 return Flag33 (Id);
2340 end Kill_Range_Checks;
2341
2342 function Known_To_Have_Preelab_Init (Id : E) return B is
2343 begin
2344 pragma Assert (Is_Type (Id));
2345 return Flag207 (Id);
2346 end Known_To_Have_Preelab_Init;
2347
2348 function Last_Assignment (Id : E) return N is
2349 begin
2350 pragma Assert (Is_Assignable (Id));
2351 return Node26 (Id);
2352 end Last_Assignment;
2353
2354 function Last_Entity (Id : E) return E is
2355 begin
2356 return Node20 (Id);
2357 end Last_Entity;
2358
2359 function Limited_View (Id : E) return E is
2360 begin
2361 pragma Assert (Ekind (Id) = E_Package);
2362 return Node23 (Id);
2363 end Limited_View;
2364
2365 function Lit_Indexes (Id : E) return E is
2366 begin
2367 pragma Assert (Is_Enumeration_Type (Id));
2368 return Node15 (Id);
2369 end Lit_Indexes;
2370
2371 function Lit_Strings (Id : E) return E is
2372 begin
2373 pragma Assert (Is_Enumeration_Type (Id));
2374 return Node16 (Id);
2375 end Lit_Strings;
2376
2377 function Low_Bound_Tested (Id : E) return B is
2378 begin
2379 return Flag205 (Id);
2380 end Low_Bound_Tested;
2381
2382 function Machine_Radix_10 (Id : E) return B is
2383 begin
2384 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
2385 return Flag84 (Id);
2386 end Machine_Radix_10;
2387
2388 function Master_Id (Id : E) return E is
2389 begin
2390 pragma Assert (Is_Access_Type (Id));
2391 return Node17 (Id);
2392 end Master_Id;
2393
2394 function Materialize_Entity (Id : E) return B is
2395 begin
2396 return Flag168 (Id);
2397 end Materialize_Entity;
2398
2399 function May_Inherit_Delayed_Rep_Aspects (Id : E) return B is
2400 begin
2401 return Flag262 (Id);
2402 end May_Inherit_Delayed_Rep_Aspects;
2403
2404 function Mechanism (Id : E) return M is
2405 begin
2406 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
2407 return UI_To_Int (Uint8 (Id));
2408 end Mechanism;
2409
2410 function Modulus (Id : E) return Uint is
2411 begin
2412 pragma Assert (Is_Modular_Integer_Type (Id));
2413 return Uint17 (Base_Type (Id));
2414 end Modulus;
2415
2416 function Must_Be_On_Byte_Boundary (Id : E) return B is
2417 begin
2418 pragma Assert (Is_Type (Id));
2419 return Flag183 (Id);
2420 end Must_Be_On_Byte_Boundary;
2421
2422 function Must_Have_Preelab_Init (Id : E) return B is
2423 begin
2424 pragma Assert (Is_Type (Id));
2425 return Flag208 (Id);
2426 end Must_Have_Preelab_Init;
2427
2428 function Needs_Debug_Info (Id : E) return B is
2429 begin
2430 return Flag147 (Id);
2431 end Needs_Debug_Info;
2432
2433 function Needs_No_Actuals (Id : E) return B is
2434 begin
2435 pragma Assert
2436 (Is_Overloadable (Id)
2437 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
2438 return Flag22 (Id);
2439 end Needs_No_Actuals;
2440
2441 function Never_Set_In_Source (Id : E) return B is
2442 begin
2443 return Flag115 (Id);
2444 end Never_Set_In_Source;
2445
2446 function Next_Inlined_Subprogram (Id : E) return E is
2447 begin
2448 return Node12 (Id);
2449 end Next_Inlined_Subprogram;
2450
2451 function No_Pool_Assigned (Id : E) return B is
2452 begin
2453 pragma Assert (Is_Access_Type (Id));
2454 return Flag131 (Root_Type (Id));
2455 end No_Pool_Assigned;
2456
2457 function No_Return (Id : E) return B is
2458 begin
2459 return Flag113 (Id);
2460 end No_Return;
2461
2462 function No_Strict_Aliasing (Id : E) return B is
2463 begin
2464 pragma Assert (Is_Access_Type (Id));
2465 return Flag136 (Base_Type (Id));
2466 end No_Strict_Aliasing;
2467
2468 function Non_Binary_Modulus (Id : E) return B is
2469 begin
2470 pragma Assert (Is_Type (Id));
2471 return Flag58 (Base_Type (Id));
2472 end Non_Binary_Modulus;
2473
2474 function Non_Limited_View (Id : E) return E is
2475 begin
2476 pragma Assert (Ekind (Id) in Incomplete_Kind);
2477 return Node17 (Id);
2478 end Non_Limited_View;
2479
2480 function Nonzero_Is_True (Id : E) return B is
2481 begin
2482 pragma Assert (Root_Type (Id) = Standard_Boolean);
2483 return Flag162 (Base_Type (Id));
2484 end Nonzero_Is_True;
2485
2486 function Normalized_First_Bit (Id : E) return U is
2487 begin
2488 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2489 return Uint8 (Id);
2490 end Normalized_First_Bit;
2491
2492 function Normalized_Position (Id : E) return U is
2493 begin
2494 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2495 return Uint14 (Id);
2496 end Normalized_Position;
2497
2498 function Normalized_Position_Max (Id : E) return U is
2499 begin
2500 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2501 return Uint10 (Id);
2502 end Normalized_Position_Max;
2503
2504 function OK_To_Rename (Id : E) return B is
2505 begin
2506 pragma Assert (Ekind (Id) = E_Variable);
2507 return Flag247 (Id);
2508 end OK_To_Rename;
2509
2510 function OK_To_Reorder_Components (Id : E) return B is
2511 begin
2512 pragma Assert (Is_Record_Type (Id));
2513 return Flag239 (Base_Type (Id));
2514 end OK_To_Reorder_Components;
2515
2516 function Optimize_Alignment_Space (Id : E) return B is
2517 begin
2518 pragma Assert
2519 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2520 return Flag241 (Id);
2521 end Optimize_Alignment_Space;
2522
2523 function Optimize_Alignment_Time (Id : E) return B is
2524 begin
2525 pragma Assert
2526 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2527 return Flag242 (Id);
2528 end Optimize_Alignment_Time;
2529
2530 function Original_Access_Type (Id : E) return E is
2531 begin
2532 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
2533 return Node26 (Id);
2534 end Original_Access_Type;
2535
2536 function Original_Array_Type (Id : E) return E is
2537 begin
2538 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
2539 return Node21 (Id);
2540 end Original_Array_Type;
2541
2542 function Original_Record_Component (Id : E) return E is
2543 begin
2544 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
2545 return Node22 (Id);
2546 end Original_Record_Component;
2547
2548 function Overlays_Constant (Id : E) return B is
2549 begin
2550 return Flag243 (Id);
2551 end Overlays_Constant;
2552
2553 function Overridden_Operation (Id : E) return E is
2554 begin
2555 return Node26 (Id);
2556 end Overridden_Operation;
2557
2558 function Package_Instantiation (Id : E) return N is
2559 begin
2560 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
2561 return Node26 (Id);
2562 end Package_Instantiation;
2563
2564 function Packed_Array_Type (Id : E) return E is
2565 begin
2566 pragma Assert (Is_Array_Type (Id));
2567 return Node23 (Id);
2568 end Packed_Array_Type;
2569
2570 function Parent_Subtype (Id : E) return E is
2571 begin
2572 pragma Assert (Is_Record_Type (Id));
2573 return Node19 (Base_Type (Id));
2574 end Parent_Subtype;
2575
2576 function Postcondition_Proc (Id : E) return E is
2577 begin
2578 pragma Assert (Ekind (Id) = E_Procedure);
2579 return Node8 (Id);
2580 end Postcondition_Proc;
2581
2582 function PPC_Wrapper (Id : E) return E is
2583 begin
2584 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
2585 return Node25 (Id);
2586 end PPC_Wrapper;
2587
2588 function Prival (Id : E) return E is
2589 begin
2590 pragma Assert (Is_Protected_Component (Id));
2591 return Node17 (Id);
2592 end Prival;
2593
2594 function Prival_Link (Id : E) return E is
2595 begin
2596 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2597 return Node20 (Id);
2598 end Prival_Link;
2599
2600 function Private_Dependents (Id : E) return L is
2601 begin
2602 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
2603 return Elist18 (Id);
2604 end Private_Dependents;
2605
2606 function Private_View (Id : E) return N is
2607 begin
2608 pragma Assert (Is_Private_Type (Id));
2609 return Node22 (Id);
2610 end Private_View;
2611
2612 function Protected_Body_Subprogram (Id : E) return E is
2613 begin
2614 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
2615 return Node11 (Id);
2616 end Protected_Body_Subprogram;
2617
2618 function Protected_Formal (Id : E) return E is
2619 begin
2620 pragma Assert (Is_Formal (Id));
2621 return Node22 (Id);
2622 end Protected_Formal;
2623
2624 function Protection_Object (Id : E) return E is
2625 begin
2626 pragma Assert
2627 (Ekind_In (Id, E_Entry, E_Entry_Family, E_Function, E_Procedure));
2628 return Node23 (Id);
2629 end Protection_Object;
2630
2631 function Reachable (Id : E) return B is
2632 begin
2633 return Flag49 (Id);
2634 end Reachable;
2635
2636 function Referenced (Id : E) return B is
2637 begin
2638 return Flag156 (Id);
2639 end Referenced;
2640
2641 function Referenced_As_LHS (Id : E) return B is
2642 begin
2643 return Flag36 (Id);
2644 end Referenced_As_LHS;
2645
2646 function Referenced_As_Out_Parameter (Id : E) return B is
2647 begin
2648 return Flag227 (Id);
2649 end Referenced_As_Out_Parameter;
2650
2651 function Refined_State_Pragma (Id : E) return N is
2652 begin
2653 pragma Assert (Ekind (Id) = E_Package_Body);
2654 return Node8 (Id);
2655 end Refined_State_Pragma;
2656
2657 function Register_Exception_Call (Id : E) return N is
2658 begin
2659 pragma Assert (Ekind (Id) = E_Exception);
2660 return Node20 (Id);
2661 end Register_Exception_Call;
2662
2663 function Related_Array_Object (Id : E) return E is
2664 begin
2665 pragma Assert (Is_Array_Type (Id));
2666 return Node25 (Id);
2667 end Related_Array_Object;
2668
2669 function Related_Expression (Id : E) return N is
2670 begin
2671 pragma Assert (Ekind (Id) in Type_Kind
2672 or else Ekind_In (Id, E_Constant, E_Variable));
2673 return Node24 (Id);
2674 end Related_Expression;
2675
2676 function Related_Instance (Id : E) return E is
2677 begin
2678 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
2679 return Node15 (Id);
2680 end Related_Instance;
2681
2682 function Related_Type (Id : E) return E is
2683 begin
2684 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
2685 return Node27 (Id);
2686 end Related_Type;
2687
2688 function Relative_Deadline_Variable (Id : E) return E is
2689 begin
2690 pragma Assert (Is_Task_Type (Id));
2691 return Node26 (Implementation_Base_Type (Id));
2692 end Relative_Deadline_Variable;
2693
2694 function Renamed_Entity (Id : E) return N is
2695 begin
2696 return Node18 (Id);
2697 end Renamed_Entity;
2698
2699 function Renamed_In_Spec (Id : E) return B is
2700 begin
2701 pragma Assert (Ekind (Id) = E_Package);
2702 return Flag231 (Id);
2703 end Renamed_In_Spec;
2704
2705 function Renamed_Object (Id : E) return N is
2706 begin
2707 return Node18 (Id);
2708 end Renamed_Object;
2709
2710 function Renaming_Map (Id : E) return U is
2711 begin
2712 return Uint9 (Id);
2713 end Renaming_Map;
2714
2715 function Requires_Overriding (Id : E) return B is
2716 begin
2717 pragma Assert (Is_Overloadable (Id));
2718 return Flag213 (Id);
2719 end Requires_Overriding;
2720
2721 function Return_Present (Id : E) return B is
2722 begin
2723 return Flag54 (Id);
2724 end Return_Present;
2725
2726 function Return_Applies_To (Id : E) return N is
2727 begin
2728 return Node8 (Id);
2729 end Return_Applies_To;
2730
2731 function Returns_By_Ref (Id : E) return B is
2732 begin
2733 return Flag90 (Id);
2734 end Returns_By_Ref;
2735
2736 function Reverse_Bit_Order (Id : E) return B is
2737 begin
2738 pragma Assert (Is_Record_Type (Id));
2739 return Flag164 (Base_Type (Id));
2740 end Reverse_Bit_Order;
2741
2742 function Reverse_Storage_Order (Id : E) return B is
2743 begin
2744 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
2745 return Flag93 (Base_Type (Id));
2746 end Reverse_Storage_Order;
2747
2748 function RM_Size (Id : E) return U is
2749 begin
2750 pragma Assert (Is_Type (Id));
2751 return Uint13 (Id);
2752 end RM_Size;
2753
2754 function Scalar_Range (Id : E) return N is
2755 begin
2756 return Node20 (Id);
2757 end Scalar_Range;
2758
2759 function Scale_Value (Id : E) return U is
2760 begin
2761 return Uint15 (Id);
2762 end Scale_Value;
2763
2764 function Scope_Depth_Value (Id : E) return U is
2765 begin
2766 return Uint22 (Id);
2767 end Scope_Depth_Value;
2768
2769 function Sec_Stack_Needed_For_Return (Id : E) return B is
2770 begin
2771 return Flag167 (Id);
2772 end Sec_Stack_Needed_For_Return;
2773
2774 function Shadow_Entities (Id : E) return S is
2775 begin
2776 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
2777 return List14 (Id);
2778 end Shadow_Entities;
2779
2780 function Shared_Var_Procs_Instance (Id : E) return E is
2781 begin
2782 pragma Assert (Ekind (Id) = E_Variable);
2783 return Node22 (Id);
2784 end Shared_Var_Procs_Instance;
2785
2786 function Size_Check_Code (Id : E) return N is
2787 begin
2788 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2789 return Node19 (Id);
2790 end Size_Check_Code;
2791
2792 function Size_Depends_On_Discriminant (Id : E) return B is
2793 begin
2794 return Flag177 (Id);
2795 end Size_Depends_On_Discriminant;
2796
2797 function Size_Known_At_Compile_Time (Id : E) return B is
2798 begin
2799 return Flag92 (Id);
2800 end Size_Known_At_Compile_Time;
2801
2802 function Small_Value (Id : E) return R is
2803 begin
2804 pragma Assert (Is_Fixed_Point_Type (Id));
2805 return Ureal21 (Id);
2806 end Small_Value;
2807
2808 function SPARK_Mode_Pragmas (Id : E) return N is
2809 begin
2810 pragma Assert
2811 (Ekind_In (Id, E_Function, -- subprogram variants
2812 E_Generic_Function,
2813 E_Generic_Procedure,
2814 E_Procedure,
2815 E_Subprogram_Body)
2816 or else
2817 Ekind_In (Id, E_Generic_Package, -- package variants
2818 E_Package,
2819 E_Package_Body));
2820 return Node32 (Id);
2821 end SPARK_Mode_Pragmas;
2822
2823 function Spec_Entity (Id : E) return E is
2824 begin
2825 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
2826 return Node19 (Id);
2827 end Spec_Entity;
2828
2829 function Static_Predicate (Id : E) return S is
2830 begin
2831 pragma Assert (Is_Discrete_Type (Id));
2832 return List25 (Id);
2833 end Static_Predicate;
2834
2835 function Status_Flag_Or_Transient_Decl (Id : E) return N is
2836 begin
2837 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2838 return Node15 (Id);
2839 end Status_Flag_Or_Transient_Decl;
2840
2841 function Storage_Size_Variable (Id : E) return E is
2842 begin
2843 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
2844 return Node15 (Implementation_Base_Type (Id));
2845 end Storage_Size_Variable;
2846
2847 function Static_Elaboration_Desired (Id : E) return B is
2848 begin
2849 pragma Assert (Ekind (Id) = E_Package);
2850 return Flag77 (Id);
2851 end Static_Elaboration_Desired;
2852
2853 function Static_Initialization (Id : E) return N is
2854 begin
2855 pragma Assert
2856 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
2857 return Node30 (Id);
2858 end Static_Initialization;
2859
2860 function Stored_Constraint (Id : E) return L is
2861 begin
2862 pragma Assert
2863 (Is_Composite_Type (Id) and then not Is_Array_Type (Id));
2864 return Elist23 (Id);
2865 end Stored_Constraint;
2866
2867 function Strict_Alignment (Id : E) return B is
2868 begin
2869 return Flag145 (Implementation_Base_Type (Id));
2870 end Strict_Alignment;
2871
2872 function String_Literal_Length (Id : E) return U is
2873 begin
2874 return Uint16 (Id);
2875 end String_Literal_Length;
2876
2877 function String_Literal_Low_Bound (Id : E) return N is
2878 begin
2879 return Node15 (Id);
2880 end String_Literal_Low_Bound;
2881
2882 function Subprograms_For_Type (Id : E) return E is
2883 begin
2884 pragma Assert (Is_Type (Id) or else Is_Subprogram (Id));
2885 return Node29 (Id);
2886 end Subprograms_For_Type;
2887
2888 function Suppress_Elaboration_Warnings (Id : E) return B is
2889 begin
2890 return Flag148 (Id);
2891 end Suppress_Elaboration_Warnings;
2892
2893 function Suppress_Initialization (Id : E) return B is
2894 begin
2895 pragma Assert (Is_Type (Id));
2896 return Flag105 (Id);
2897 end Suppress_Initialization;
2898
2899 function Suppress_Style_Checks (Id : E) return B is
2900 begin
2901 return Flag165 (Id);
2902 end Suppress_Style_Checks;
2903
2904 function Suppress_Value_Tracking_On_Call (Id : E) return B is
2905 begin
2906 return Flag217 (Id);
2907 end Suppress_Value_Tracking_On_Call;
2908
2909 function Task_Body_Procedure (Id : E) return N is
2910 begin
2911 pragma Assert (Ekind (Id) in Task_Kind);
2912 return Node25 (Id);
2913 end Task_Body_Procedure;
2914
2915 function Thunk_Entity (Id : E) return E is
2916 begin
2917 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
2918 and then Is_Thunk (Id));
2919 return Node31 (Id);
2920 end Thunk_Entity;
2921
2922 function Treat_As_Volatile (Id : E) return B is
2923 begin
2924 return Flag41 (Id);
2925 end Treat_As_Volatile;
2926
2927 function Underlying_Full_View (Id : E) return E is
2928 begin
2929 pragma Assert (Ekind (Id) in Private_Kind);
2930 return Node19 (Id);
2931 end Underlying_Full_View;
2932
2933 function Underlying_Record_View (Id : E) return E is
2934 begin
2935 return Node28 (Id);
2936 end Underlying_Record_View;
2937
2938 function Universal_Aliasing (Id : E) return B is
2939 begin
2940 pragma Assert (Is_Type (Id));
2941 return Flag216 (Implementation_Base_Type (Id));
2942 end Universal_Aliasing;
2943
2944 function Unset_Reference (Id : E) return N is
2945 begin
2946 return Node16 (Id);
2947 end Unset_Reference;
2948
2949 function Used_As_Generic_Actual (Id : E) return B is
2950 begin
2951 return Flag222 (Id);
2952 end Used_As_Generic_Actual;
2953
2954 function Uses_Lock_Free (Id : E) return B is
2955 begin
2956 pragma Assert (Is_Protected_Type (Id));
2957 return Flag188 (Id);
2958 end Uses_Lock_Free;
2959
2960 function Uses_Sec_Stack (Id : E) return B is
2961 begin
2962 return Flag95 (Id);
2963 end Uses_Sec_Stack;
2964
2965 function Warnings_Off (Id : E) return B is
2966 begin
2967 return Flag96 (Id);
2968 end Warnings_Off;
2969
2970 function Warnings_Off_Used (Id : E) return B is
2971 begin
2972 return Flag236 (Id);
2973 end Warnings_Off_Used;
2974
2975 function Warnings_Off_Used_Unmodified (Id : E) return B is
2976 begin
2977 return Flag237 (Id);
2978 end Warnings_Off_Used_Unmodified;
2979
2980 function Warnings_Off_Used_Unreferenced (Id : E) return B is
2981 begin
2982 return Flag238 (Id);
2983 end Warnings_Off_Used_Unreferenced;
2984
2985 function Wrapped_Entity (Id : E) return E is
2986 begin
2987 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
2988 and then Is_Primitive_Wrapper (Id));
2989 return Node27 (Id);
2990 end Wrapped_Entity;
2991
2992 function Was_Hidden (Id : E) return B is
2993 begin
2994 return Flag196 (Id);
2995 end Was_Hidden;
2996
2997 ------------------------------
2998 -- Classification Functions --
2999 ------------------------------
3000
3001 function Is_Access_Type (Id : E) return B is
3002 begin
3003 return Ekind (Id) in Access_Kind;
3004 end Is_Access_Type;
3005
3006 function Is_Access_Protected_Subprogram_Type (Id : E) return B is
3007 begin
3008 return Ekind (Id) in Access_Protected_Kind;
3009 end Is_Access_Protected_Subprogram_Type;
3010
3011 function Is_Access_Subprogram_Type (Id : E) return B is
3012 begin
3013 return Ekind (Id) in Access_Subprogram_Kind;
3014 end Is_Access_Subprogram_Type;
3015
3016 function Is_Aggregate_Type (Id : E) return B is
3017 begin
3018 return Ekind (Id) in Aggregate_Kind;
3019 end Is_Aggregate_Type;
3020
3021 function Is_Array_Type (Id : E) return B is
3022 begin
3023 return Ekind (Id) in Array_Kind;
3024 end Is_Array_Type;
3025
3026 function Is_Assignable (Id : E) return B is
3027 begin
3028 return Ekind (Id) in Assignable_Kind;
3029 end Is_Assignable;
3030
3031 function Is_Class_Wide_Type (Id : E) return B is
3032 begin
3033 return Ekind (Id) in Class_Wide_Kind;
3034 end Is_Class_Wide_Type;
3035
3036 function Is_Composite_Type (Id : E) return B is
3037 begin
3038 return Ekind (Id) in Composite_Kind;
3039 end Is_Composite_Type;
3040
3041 function Is_Concurrent_Body (Id : E) return B is
3042 begin
3043 return Ekind (Id) in
3044 Concurrent_Body_Kind;
3045 end Is_Concurrent_Body;
3046
3047 function Is_Concurrent_Record_Type (Id : E) return B is
3048 begin
3049 return Flag20 (Id);
3050 end Is_Concurrent_Record_Type;
3051
3052 function Is_Concurrent_Type (Id : E) return B is
3053 begin
3054 return Ekind (Id) in Concurrent_Kind;
3055 end Is_Concurrent_Type;
3056
3057 function Is_Decimal_Fixed_Point_Type (Id : E) return B is
3058 begin
3059 return Ekind (Id) in
3060 Decimal_Fixed_Point_Kind;
3061 end Is_Decimal_Fixed_Point_Type;
3062
3063 function Is_Digits_Type (Id : E) return B is
3064 begin
3065 return Ekind (Id) in Digits_Kind;
3066 end Is_Digits_Type;
3067
3068 function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B is
3069 begin
3070 return Ekind (Id) in Discrete_Or_Fixed_Point_Kind;
3071 end Is_Discrete_Or_Fixed_Point_Type;
3072
3073 function Is_Discrete_Type (Id : E) return B is
3074 begin
3075 return Ekind (Id) in Discrete_Kind;
3076 end Is_Discrete_Type;
3077
3078 function Is_Elementary_Type (Id : E) return B is
3079 begin
3080 return Ekind (Id) in Elementary_Kind;
3081 end Is_Elementary_Type;
3082
3083 function Is_Entry (Id : E) return B is
3084 begin
3085 return Ekind (Id) in Entry_Kind;
3086 end Is_Entry;
3087
3088 function Is_Enumeration_Type (Id : E) return B is
3089 begin
3090 return Ekind (Id) in
3091 Enumeration_Kind;
3092 end Is_Enumeration_Type;
3093
3094 function Is_Fixed_Point_Type (Id : E) return B is
3095 begin
3096 return Ekind (Id) in
3097 Fixed_Point_Kind;
3098 end Is_Fixed_Point_Type;
3099
3100 function Is_Floating_Point_Type (Id : E) return B is
3101 begin
3102 return Ekind (Id) in Float_Kind;
3103 end Is_Floating_Point_Type;
3104
3105 function Is_Formal (Id : E) return B is
3106 begin
3107 return Ekind (Id) in Formal_Kind;
3108 end Is_Formal;
3109
3110 function Is_Formal_Object (Id : E) return B is
3111 begin
3112 return Ekind (Id) in Formal_Object_Kind;
3113 end Is_Formal_Object;
3114
3115 function Is_Generic_Subprogram (Id : E) return B is
3116 begin
3117 return Ekind (Id) in Generic_Subprogram_Kind;
3118 end Is_Generic_Subprogram;
3119
3120 function Is_Generic_Unit (Id : E) return B is
3121 begin
3122 return Ekind (Id) in Generic_Unit_Kind;
3123 end Is_Generic_Unit;
3124
3125 function Is_Incomplete_Or_Private_Type (Id : E) return B is
3126 begin
3127 return Ekind (Id) in
3128 Incomplete_Or_Private_Kind;
3129 end Is_Incomplete_Or_Private_Type;
3130
3131 function Is_Incomplete_Type (Id : E) return B is
3132 begin
3133 return Ekind (Id) in
3134 Incomplete_Kind;
3135 end Is_Incomplete_Type;
3136
3137 function Is_Integer_Type (Id : E) return B is
3138 begin
3139 return Ekind (Id) in Integer_Kind;
3140 end Is_Integer_Type;
3141
3142 function Is_Modular_Integer_Type (Id : E) return B is
3143 begin
3144 return Ekind (Id) in
3145 Modular_Integer_Kind;
3146 end Is_Modular_Integer_Type;
3147
3148 function Is_Named_Number (Id : E) return B is
3149 begin
3150 return Ekind (Id) in Named_Kind;
3151 end Is_Named_Number;
3152
3153 function Is_Numeric_Type (Id : E) return B is
3154 begin
3155 return Ekind (Id) in Numeric_Kind;
3156 end Is_Numeric_Type;
3157
3158 function Is_Object (Id : E) return B is
3159 begin
3160 return Ekind (Id) in Object_Kind;
3161 end Is_Object;
3162
3163 function Is_Ordinary_Fixed_Point_Type (Id : E) return B is
3164 begin
3165 return Ekind (Id) in
3166 Ordinary_Fixed_Point_Kind;
3167 end Is_Ordinary_Fixed_Point_Type;
3168
3169 function Is_Overloadable (Id : E) return B is
3170 begin
3171 return Ekind (Id) in Overloadable_Kind;
3172 end Is_Overloadable;
3173
3174 function Is_Private_Type (Id : E) return B is
3175 begin
3176 return Ekind (Id) in Private_Kind;
3177 end Is_Private_Type;
3178
3179 function Is_Protected_Type (Id : E) return B is
3180 begin
3181 return Ekind (Id) in Protected_Kind;
3182 end Is_Protected_Type;
3183
3184 function Is_Real_Type (Id : E) return B is
3185 begin
3186 return Ekind (Id) in Real_Kind;
3187 end Is_Real_Type;
3188
3189 function Is_Record_Type (Id : E) return B is
3190 begin
3191 return Ekind (Id) in Record_Kind;
3192 end Is_Record_Type;
3193
3194 function Is_Scalar_Type (Id : E) return B is
3195 begin
3196 return Ekind (Id) in Scalar_Kind;
3197 end Is_Scalar_Type;
3198
3199 function Is_Signed_Integer_Type (Id : E) return B is
3200 begin
3201 return Ekind (Id) in Signed_Integer_Kind;
3202 end Is_Signed_Integer_Type;
3203
3204 function Is_Subprogram (Id : E) return B is
3205 begin
3206 return Ekind (Id) in Subprogram_Kind;
3207 end Is_Subprogram;
3208
3209 function Is_Task_Type (Id : E) return B is
3210 begin
3211 return Ekind (Id) in Task_Kind;
3212 end Is_Task_Type;
3213
3214 function Is_Type (Id : E) return B is
3215 begin
3216 return Ekind (Id) in Type_Kind;
3217 end Is_Type;
3218
3219 ------------------------------
3220 -- Attribute Set Procedures --
3221 ------------------------------
3222
3223 -- Note: in many of these set procedures an "obvious" assertion is missing.
3224 -- The reason for this is that in many cases, a field is set before the
3225 -- Ekind field is set, so that the field is set when Ekind = E_Void. It
3226 -- it is possible to add assertions that specifically include the E_Void
3227 -- possibility, but in some cases, we just omit the assertions.
3228
3229 procedure Set_Abstract_States (Id : E; V : L) is
3230 begin
3231 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
3232 Set_Elist25 (Id, V);
3233 end Set_Abstract_States;
3234
3235 procedure Set_Accept_Address (Id : E; V : L) is
3236 begin
3237 Set_Elist21 (Id, V);
3238 end Set_Accept_Address;
3239
3240 procedure Set_Access_Disp_Table (Id : E; V : L) is
3241 begin
3242 pragma Assert (Ekind (Id) = E_Record_Type
3243 and then Id = Implementation_Base_Type (Id));
3244 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
3245 Set_Elist16 (Id, V);
3246 end Set_Access_Disp_Table;
3247
3248 procedure Set_Associated_Formal_Package (Id : E; V : E) is
3249 begin
3250 Set_Node12 (Id, V);
3251 end Set_Associated_Formal_Package;
3252
3253 procedure Set_Associated_Node_For_Itype (Id : E; V : E) is
3254 begin
3255 Set_Node8 (Id, V);
3256 end Set_Associated_Node_For_Itype;
3257
3258 procedure Set_Associated_Storage_Pool (Id : E; V : E) is
3259 begin
3260 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
3261 Set_Node22 (Id, V);
3262 end Set_Associated_Storage_Pool;
3263
3264 procedure Set_Actual_Subtype (Id : E; V : E) is
3265 begin
3266 pragma Assert
3267 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
3268 or else Is_Formal (Id));
3269 Set_Node17 (Id, V);
3270 end Set_Actual_Subtype;
3271
3272 procedure Set_Address_Taken (Id : E; V : B := True) is
3273 begin
3274 Set_Flag104 (Id, V);
3275 end Set_Address_Taken;
3276
3277 procedure Set_Alias (Id : E; V : E) is
3278 begin
3279 pragma Assert
3280 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
3281 Set_Node18 (Id, V);
3282 end Set_Alias;
3283
3284 procedure Set_Alignment (Id : E; V : U) is
3285 begin
3286 pragma Assert (Is_Type (Id)
3287 or else Is_Formal (Id)
3288 or else Ekind_In (Id, E_Loop_Parameter,
3289 E_Constant,
3290 E_Exception,
3291 E_Variable));
3292 Set_Uint14 (Id, V);
3293 end Set_Alignment;
3294
3295 procedure Set_Barrier_Function (Id : E; V : N) is
3296 begin
3297 pragma Assert (Is_Entry (Id));
3298 Set_Node12 (Id, V);
3299 end Set_Barrier_Function;
3300
3301 procedure Set_Block_Node (Id : E; V : N) is
3302 begin
3303 pragma Assert (Ekind (Id) = E_Block);
3304 Set_Node11 (Id, V);
3305 end Set_Block_Node;
3306
3307 procedure Set_Body_Entity (Id : E; V : E) is
3308 begin
3309 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
3310 Set_Node19 (Id, V);
3311 end Set_Body_Entity;
3312
3313 procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is
3314 begin
3315 pragma Assert
3316 (Ekind (Id) = E_Package
3317 or else Is_Subprogram (Id)
3318 or else Is_Generic_Unit (Id));
3319 Set_Flag40 (Id, V);
3320 end Set_Body_Needed_For_SAL;
3321
3322 procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is
3323 begin
3324 pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
3325 Set_Flag125 (Id, V);
3326 end Set_C_Pass_By_Copy;
3327
3328 procedure Set_Can_Never_Be_Null (Id : E; V : B := True) is
3329 begin
3330 Set_Flag38 (Id, V);
3331 end Set_Can_Never_Be_Null;
3332
3333 procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is
3334 begin
3335 Set_Flag31 (Id, V);
3336 end Set_Checks_May_Be_Suppressed;
3337
3338 procedure Set_Class_Wide_Type (Id : E; V : E) is
3339 begin
3340 pragma Assert (Is_Type (Id));
3341 Set_Node9 (Id, V);
3342 end Set_Class_Wide_Type;
3343
3344 procedure Set_Cloned_Subtype (Id : E; V : E) is
3345 begin
3346 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
3347 Set_Node16 (Id, V);
3348 end Set_Cloned_Subtype;
3349
3350 procedure Set_Component_Bit_Offset (Id : E; V : U) is
3351 begin
3352 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
3353 Set_Uint11 (Id, V);
3354 end Set_Component_Bit_Offset;
3355
3356 procedure Set_Component_Clause (Id : E; V : N) is
3357 begin
3358 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
3359 Set_Node13 (Id, V);
3360 end Set_Component_Clause;
3361
3362 procedure Set_Component_Size (Id : E; V : U) is
3363 begin
3364 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3365 Set_Uint22 (Id, V);
3366 end Set_Component_Size;
3367
3368 procedure Set_Component_Type (Id : E; V : E) is
3369 begin
3370 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3371 Set_Node20 (Id, V);
3372 end Set_Component_Type;
3373
3374 procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is
3375 begin
3376 pragma Assert
3377 (Ekind (Id) = E_Record_Type and then Is_Concurrent_Type (V));
3378 Set_Node18 (Id, V);
3379 end Set_Corresponding_Concurrent_Type;
3380
3381 procedure Set_Corresponding_Discriminant (Id : E; V : E) is
3382 begin
3383 pragma Assert (Ekind (Id) = E_Discriminant);
3384 Set_Node19 (Id, V);
3385 end Set_Corresponding_Discriminant;
3386
3387 procedure Set_Corresponding_Equality (Id : E; V : E) is
3388 begin
3389 pragma Assert
3390 (Ekind (Id) = E_Function
3391 and then not Comes_From_Source (Id)
3392 and then Chars (Id) = Name_Op_Ne);
3393 Set_Node30 (Id, V);
3394 end Set_Corresponding_Equality;
3395
3396 procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
3397 begin
3398 pragma Assert (Ekind_In (Id, E_Void, E_Subprogram_Body));
3399 Set_Node18 (Id, V);
3400 end Set_Corresponding_Protected_Entry;
3401
3402 procedure Set_Corresponding_Record_Type (Id : E; V : E) is
3403 begin
3404 pragma Assert (Is_Concurrent_Type (Id));
3405 Set_Node18 (Id, V);
3406 end Set_Corresponding_Record_Type;
3407
3408 procedure Set_Corresponding_Remote_Type (Id : E; V : E) is
3409 begin
3410 Set_Node22 (Id, V);
3411 end Set_Corresponding_Remote_Type;
3412
3413 procedure Set_Current_Use_Clause (Id : E; V : E) is
3414 begin
3415 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
3416 Set_Node27 (Id, V);
3417 end Set_Current_Use_Clause;
3418
3419 procedure Set_Current_Value (Id : E; V : N) is
3420 begin
3421 pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
3422 Set_Node9 (Id, V);
3423 end Set_Current_Value;
3424
3425 procedure Set_CR_Discriminant (Id : E; V : E) is
3426 begin
3427 Set_Node23 (Id, V);
3428 end Set_CR_Discriminant;
3429
3430 procedure Set_Debug_Info_Off (Id : E; V : B := True) is
3431 begin
3432 Set_Flag166 (Id, V);
3433 end Set_Debug_Info_Off;
3434
3435 procedure Set_Debug_Renaming_Link (Id : E; V : E) is
3436 begin
3437 Set_Node25 (Id, V);
3438 end Set_Debug_Renaming_Link;
3439
3440 procedure Set_Default_Aspect_Component_Value (Id : E; V : E) is
3441 begin
3442 pragma Assert (Is_Array_Type (Id));
3443 Set_Node19 (Id, V);
3444 end Set_Default_Aspect_Component_Value;
3445
3446 procedure Set_Default_Aspect_Value (Id : E; V : E) is
3447 begin
3448 pragma Assert (Is_Scalar_Type (Id));
3449 Set_Node19 (Id, V);
3450 end Set_Default_Aspect_Value;
3451
3452 procedure Set_Default_Expr_Function (Id : E; V : E) is
3453 begin
3454 pragma Assert (Is_Formal (Id));
3455 Set_Node21 (Id, V);
3456 end Set_Default_Expr_Function;
3457
3458 procedure Set_Default_Expressions_Processed (Id : E; V : B := True) is
3459 begin
3460 Set_Flag108 (Id, V);
3461 end Set_Default_Expressions_Processed;
3462
3463 procedure Set_Default_Value (Id : E; V : N) is
3464 begin
3465 pragma Assert (Is_Formal (Id));
3466 Set_Node20 (Id, V);
3467 end Set_Default_Value;
3468
3469 procedure Set_Delay_Cleanups (Id : E; V : B := True) is
3470 begin
3471 pragma Assert
3472 (Is_Subprogram (Id)
3473 or else Is_Task_Type (Id)
3474 or else Ekind (Id) = E_Block);
3475 Set_Flag114 (Id, V);
3476 end Set_Delay_Cleanups;
3477
3478 procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is
3479 begin
3480 pragma Assert
3481 (Is_Subprogram (Id) or else Ekind_In (Id, E_Package, E_Package_Body));
3482
3483 Set_Flag50 (Id, V);
3484 end Set_Delay_Subprogram_Descriptors;
3485
3486 procedure Set_Delta_Value (Id : E; V : R) is
3487 begin
3488 pragma Assert (Is_Fixed_Point_Type (Id));
3489 Set_Ureal18 (Id, V);
3490 end Set_Delta_Value;
3491
3492 procedure Set_Dependent_Instances (Id : E; V : L) is
3493 begin
3494 pragma Assert (Is_Generic_Instance (Id));
3495 Set_Elist8 (Id, V);
3496 end Set_Dependent_Instances;
3497
3498 procedure Set_Depends_On_Private (Id : E; V : B := True) is
3499 begin
3500 pragma Assert (Nkind (Id) in N_Entity);
3501 Set_Flag14 (Id, V);
3502 end Set_Depends_On_Private;
3503
3504 procedure Set_Digits_Value (Id : E; V : U) is
3505 begin
3506 pragma Assert
3507 (Is_Floating_Point_Type (Id)
3508 or else Is_Decimal_Fixed_Point_Type (Id));
3509 Set_Uint17 (Id, V);
3510 end Set_Digits_Value;
3511
3512 procedure Set_Directly_Designated_Type (Id : E; V : E) is
3513 begin
3514 Set_Node20 (Id, V);
3515 end Set_Directly_Designated_Type;
3516
3517 procedure Set_Discard_Names (Id : E; V : B := True) is
3518 begin
3519 Set_Flag88 (Id, V);
3520 end Set_Discard_Names;
3521
3522 procedure Set_Discriminal (Id : E; V : E) is
3523 begin
3524 pragma Assert (Ekind (Id) = E_Discriminant);
3525 Set_Node17 (Id, V);
3526 end Set_Discriminal;
3527
3528 procedure Set_Discriminal_Link (Id : E; V : E) is
3529 begin
3530 Set_Node10 (Id, V);
3531 end Set_Discriminal_Link;
3532
3533 procedure Set_Discriminant_Checking_Func (Id : E; V : E) is
3534 begin
3535 pragma Assert (Ekind (Id) = E_Component);
3536 Set_Node20 (Id, V);
3537 end Set_Discriminant_Checking_Func;
3538
3539 procedure Set_Discriminant_Constraint (Id : E; V : L) is
3540 begin
3541 pragma Assert (Nkind (Id) in N_Entity);
3542 Set_Elist21 (Id, V);
3543 end Set_Discriminant_Constraint;
3544
3545 procedure Set_Discriminant_Default_Value (Id : E; V : N) is
3546 begin
3547 Set_Node20 (Id, V);
3548 end Set_Discriminant_Default_Value;
3549
3550 procedure Set_Discriminant_Number (Id : E; V : U) is
3551 begin
3552 Set_Uint15 (Id, V);
3553 end Set_Discriminant_Number;
3554
3555 procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is
3556 begin
3557 pragma Assert (Ekind (Id) = E_Record_Type
3558 and then Id = Implementation_Base_Type (Id));
3559 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
3560 Set_Elist26 (Id, V);
3561 end Set_Dispatch_Table_Wrappers;
3562
3563 procedure Set_DT_Entry_Count (Id : E; V : U) is
3564 begin
3565 pragma Assert (Ekind (Id) = E_Component);
3566 Set_Uint15 (Id, V);
3567 end Set_DT_Entry_Count;
3568
3569 procedure Set_DT_Offset_To_Top_Func (Id : E; V : E) is
3570 begin
3571 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
3572 Set_Node25 (Id, V);
3573 end Set_DT_Offset_To_Top_Func;
3574
3575 procedure Set_DT_Position (Id : E; V : U) is
3576 begin
3577 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3578 Set_Uint15 (Id, V);
3579 end Set_DT_Position;
3580
3581 procedure Set_DTC_Entity (Id : E; V : E) is
3582 begin
3583 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3584 Set_Node16 (Id, V);
3585 end Set_DTC_Entity;
3586
3587 procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True) is
3588 begin
3589 pragma Assert (Ekind (Id) = E_Package);
3590 Set_Flag210 (Id, V);
3591 end Set_Elaborate_Body_Desirable;
3592
3593 procedure Set_Elaboration_Entity (Id : E; V : E) is
3594 begin
3595 pragma Assert
3596 (Is_Subprogram (Id)
3597 or else
3598 Ekind (Id) = E_Package
3599 or else
3600 Is_Generic_Unit (Id));
3601 Set_Node13 (Id, V);
3602 end Set_Elaboration_Entity;
3603
3604 procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is
3605 begin
3606 pragma Assert
3607 (Is_Subprogram (Id)
3608 or else
3609 Ekind (Id) = E_Package
3610 or else
3611 Is_Generic_Unit (Id));
3612 Set_Flag174 (Id, V);
3613 end Set_Elaboration_Entity_Required;
3614
3615 procedure Set_Enclosing_Scope (Id : E; V : E) is
3616 begin
3617 Set_Node18 (Id, V);
3618 end Set_Enclosing_Scope;
3619
3620 procedure Set_Entry_Accepted (Id : E; V : B := True) is
3621 begin
3622 pragma Assert (Is_Entry (Id));
3623 Set_Flag152 (Id, V);
3624 end Set_Entry_Accepted;
3625
3626 procedure Set_Entry_Bodies_Array (Id : E; V : E) is
3627 begin
3628 Set_Node15 (Id, V);
3629 end Set_Entry_Bodies_Array;
3630
3631 procedure Set_Entry_Cancel_Parameter (Id : E; V : E) is
3632 begin
3633 Set_Node23 (Id, V);
3634 end Set_Entry_Cancel_Parameter;
3635
3636 procedure Set_Entry_Component (Id : E; V : E) is
3637 begin
3638 Set_Node11 (Id, V);
3639 end Set_Entry_Component;
3640
3641 procedure Set_Entry_Formal (Id : E; V : E) is
3642 begin
3643 Set_Node16 (Id, V);
3644 end Set_Entry_Formal;
3645
3646 procedure Set_Entry_Index_Constant (Id : E; V : E) is
3647 begin
3648 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
3649 Set_Node18 (Id, V);
3650 end Set_Entry_Index_Constant;
3651
3652 procedure Set_Contract (Id : E; V : N) is
3653 begin
3654 pragma Assert
3655 (Ekind_In (Id, E_Entry, E_Entry_Family, E_Subprogram_Body, E_Void)
3656 or else Is_Subprogram (Id)
3657 or else Is_Generic_Subprogram (Id));
3658 Set_Node24 (Id, V);
3659 end Set_Contract;
3660
3661 procedure Set_Entry_Parameters_Type (Id : E; V : E) is
3662 begin
3663 Set_Node15 (Id, V);
3664 end Set_Entry_Parameters_Type;
3665
3666 procedure Set_Enum_Pos_To_Rep (Id : E; V : E) is
3667 begin
3668 pragma Assert (Ekind (Id) = E_Enumeration_Type);
3669 Set_Node23 (Id, V);
3670 end Set_Enum_Pos_To_Rep;
3671
3672 procedure Set_Enumeration_Pos (Id : E; V : U) is
3673 begin
3674 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
3675 Set_Uint11 (Id, V);
3676 end Set_Enumeration_Pos;
3677
3678 procedure Set_Enumeration_Rep (Id : E; V : U) is
3679 begin
3680 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
3681 Set_Uint12 (Id, V);
3682 end Set_Enumeration_Rep;
3683
3684 procedure Set_Enumeration_Rep_Expr (Id : E; V : N) is
3685 begin
3686 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
3687 Set_Node22 (Id, V);
3688 end Set_Enumeration_Rep_Expr;
3689
3690 procedure Set_Equivalent_Type (Id : E; V : E) is
3691 begin
3692 pragma Assert
3693 (Ekind_In (Id, E_Class_Wide_Type,
3694 E_Class_Wide_Subtype,
3695 E_Access_Protected_Subprogram_Type,
3696 E_Anonymous_Access_Protected_Subprogram_Type,
3697 E_Access_Subprogram_Type,
3698 E_Exception_Type));
3699 Set_Node18 (Id, V);
3700 end Set_Equivalent_Type;
3701
3702 procedure Set_Esize (Id : E; V : U) is
3703 begin
3704 Set_Uint12 (Id, V);
3705 end Set_Esize;
3706
3707 procedure Set_Exception_Code (Id : E; V : U) is
3708 begin
3709 pragma Assert (Ekind (Id) = E_Exception);
3710 Set_Uint22 (Id, V);
3711 end Set_Exception_Code;
3712
3713 procedure Set_Extra_Accessibility (Id : E; V : E) is
3714 begin
3715 pragma Assert
3716 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
3717 Set_Node13 (Id, V);
3718 end Set_Extra_Accessibility;
3719
3720 procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is
3721 begin
3722 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
3723 Set_Node19 (Id, V);
3724 end Set_Extra_Accessibility_Of_Result;
3725
3726 procedure Set_Extra_Constrained (Id : E; V : E) is
3727 begin
3728 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
3729 Set_Node23 (Id, V);
3730 end Set_Extra_Constrained;
3731
3732 procedure Set_Extra_Formal (Id : E; V : E) is
3733 begin
3734 Set_Node15 (Id, V);
3735 end Set_Extra_Formal;
3736
3737 procedure Set_Extra_Formals (Id : E; V : E) is
3738 begin
3739 pragma Assert
3740 (Is_Overloadable (Id)
3741 or else Ekind_In (Id, E_Entry_Family,
3742 E_Subprogram_Body,
3743 E_Subprogram_Type));
3744 Set_Node28 (Id, V);
3745 end Set_Extra_Formals;
3746
3747 procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
3748 begin
3749 pragma Assert
3750 (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
3751 Set_Flag229 (Id, V);
3752 end Set_Can_Use_Internal_Rep;
3753
3754 procedure Set_Finalization_Master (Id : E; V : E) is
3755 begin
3756 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
3757 Set_Node23 (Id, V);
3758 end Set_Finalization_Master;
3759
3760 procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is
3761 begin
3762 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
3763 Set_Flag158 (Id, V);
3764 end Set_Finalize_Storage_Only;
3765
3766 procedure Set_Finalizer (Id : E; V : E) is
3767 begin
3768 pragma Assert
3769 (Ekind (Id) = E_Package
3770 or else Ekind (Id) = E_Package_Body);
3771 Set_Node24 (Id, V);
3772 end Set_Finalizer;
3773
3774 procedure Set_First_Entity (Id : E; V : E) is
3775 begin
3776 Set_Node17 (Id, V);
3777 end Set_First_Entity;
3778
3779 procedure Set_First_Exit_Statement (Id : E; V : N) is
3780 begin
3781 pragma Assert (Ekind (Id) = E_Loop);
3782 Set_Node8 (Id, V);
3783 end Set_First_Exit_Statement;
3784
3785 procedure Set_First_Index (Id : E; V : N) is
3786 begin
3787 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
3788 Set_Node17 (Id, V);
3789 end Set_First_Index;
3790
3791 procedure Set_First_Literal (Id : E; V : E) is
3792 begin
3793 pragma Assert (Is_Enumeration_Type (Id));
3794 Set_Node17 (Id, V);
3795 end Set_First_Literal;
3796
3797 procedure Set_First_Optional_Parameter (Id : E; V : E) is
3798 begin
3799 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3800 Set_Node14 (Id, V);
3801 end Set_First_Optional_Parameter;
3802
3803 procedure Set_First_Private_Entity (Id : E; V : E) is
3804 begin
3805 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
3806 or else Ekind (Id) in Concurrent_Kind);
3807 Set_Node16 (Id, V);
3808 end Set_First_Private_Entity;
3809
3810 procedure Set_First_Rep_Item (Id : E; V : N) is
3811 begin
3812 Set_Node6 (Id, V);
3813 end Set_First_Rep_Item;
3814
3815 procedure Set_Float_Rep (Id : E; V : F) is
3816 pragma Assert (Ekind (Id) = E_Floating_Point_Type);
3817 begin
3818 Set_Uint10 (Id, UI_From_Int (F'Pos (V)));
3819 end Set_Float_Rep;
3820
3821 procedure Set_Freeze_Node (Id : E; V : N) is
3822 begin
3823 Set_Node7 (Id, V);
3824 end Set_Freeze_Node;
3825
3826 procedure Set_From_With_Type (Id : E; V : B := True) is
3827 begin
3828 pragma Assert
3829 (Is_Type (Id)
3830 or else Ekind (Id) = E_Package);
3831 Set_Flag159 (Id, V);
3832 end Set_From_With_Type;
3833
3834 procedure Set_Full_View (Id : E; V : E) is
3835 begin
3836 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
3837 Set_Node11 (Id, V);
3838 end Set_Full_View;
3839
3840 procedure Set_Generic_Homonym (Id : E; V : E) is
3841 begin
3842 Set_Node11 (Id, V);
3843 end Set_Generic_Homonym;
3844
3845 procedure Set_Generic_Renamings (Id : E; V : L) is
3846 begin
3847 Set_Elist23 (Id, V);
3848 end Set_Generic_Renamings;
3849
3850 procedure Set_Handler_Records (Id : E; V : S) is
3851 begin
3852 Set_List10 (Id, V);
3853 end Set_Handler_Records;
3854
3855 procedure Set_Has_Aliased_Components (Id : E; V : B := True) is
3856 begin
3857 pragma Assert (Id = Base_Type (Id));
3858 Set_Flag135 (Id, V);
3859 end Set_Has_Aliased_Components;
3860
3861 procedure Set_Has_Alignment_Clause (Id : E; V : B := True) is
3862 begin
3863 Set_Flag46 (Id, V);
3864 end Set_Has_Alignment_Clause;
3865
3866 procedure Set_Has_All_Calls_Remote (Id : E; V : B := True) is
3867 begin
3868 Set_Flag79 (Id, V);
3869 end Set_Has_All_Calls_Remote;
3870
3871 procedure Set_Has_Anonymous_Master (Id : E; V : B := True) is
3872 begin
3873 pragma Assert
3874 (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
3875 Set_Flag253 (Id, V);
3876 end Set_Has_Anonymous_Master;
3877
3878 procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
3879 begin
3880 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
3881 Set_Flag86 (Id, V);
3882 end Set_Has_Atomic_Components;
3883
3884 procedure Set_Has_Biased_Representation (Id : E; V : B := True) is
3885 begin
3886 pragma Assert
3887 ((V = False) or else (Is_Discrete_Type (Id) or else Is_Object (Id)));
3888 Set_Flag139 (Id, V);
3889 end Set_Has_Biased_Representation;
3890
3891 procedure Set_Has_Completion (Id : E; V : B := True) is
3892 begin
3893 Set_Flag26 (Id, V);
3894 end Set_Has_Completion;
3895
3896 procedure Set_Has_Completion_In_Body (Id : E; V : B := True) is
3897 begin
3898 pragma Assert (Is_Type (Id));
3899 Set_Flag71 (Id, V);
3900 end Set_Has_Completion_In_Body;
3901
3902 procedure Set_Has_Complex_Representation (Id : E; V : B := True) is
3903 begin
3904 pragma Assert (Ekind (Id) = E_Record_Type);
3905 Set_Flag140 (Id, V);
3906 end Set_Has_Complex_Representation;
3907
3908 procedure Set_Has_Component_Size_Clause (Id : E; V : B := True) is
3909 begin
3910 pragma Assert (Ekind (Id) = E_Array_Type);
3911 Set_Flag68 (Id, V);
3912 end Set_Has_Component_Size_Clause;
3913
3914 procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True) is
3915 begin
3916 pragma Assert (Is_Type (Id));
3917 Set_Flag187 (Id, V);
3918 end Set_Has_Constrained_Partial_View;
3919
3920 procedure Set_Has_Contiguous_Rep (Id : E; V : B := True) is
3921 begin
3922 Set_Flag181 (Id, V);
3923 end Set_Has_Contiguous_Rep;
3924
3925 procedure Set_Has_Controlled_Component (Id : E; V : B := True) is
3926 begin
3927 pragma Assert (Id = Base_Type (Id));
3928 Set_Flag43 (Id, V);
3929 end Set_Has_Controlled_Component;
3930
3931 procedure Set_Has_Controlling_Result (Id : E; V : B := True) is
3932 begin
3933 Set_Flag98 (Id, V);
3934 end Set_Has_Controlling_Result;
3935
3936 procedure Set_Has_Convention_Pragma (Id : E; V : B := True) is
3937 begin
3938 Set_Flag119 (Id, V);
3939 end Set_Has_Convention_Pragma;
3940
3941 procedure Set_Has_Default_Aspect (Id : E; V : B := True) is
3942 begin
3943 pragma Assert
3944 ((Is_Scalar_Type (Id) or else Is_Array_Type (Id))
3945 and then Is_Base_Type (Id));
3946 Set_Flag39 (Id, V);
3947 end Set_Has_Default_Aspect;
3948
3949 procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is
3950 begin
3951 pragma Assert (Nkind (Id) in N_Entity);
3952 Set_Flag200 (Id, V);
3953 end Set_Has_Delayed_Aspects;
3954
3955 procedure Set_Has_Delayed_Freeze (Id : E; V : B := True) is
3956 begin
3957 pragma Assert (Nkind (Id) in N_Entity);
3958 Set_Flag18 (Id, V);
3959 end Set_Has_Delayed_Freeze;
3960
3961 procedure Set_Has_Delayed_Rep_Aspects (Id : E; V : B := True) is
3962 begin
3963 pragma Assert (Nkind (Id) in N_Entity);
3964 Set_Flag261 (Id, V);
3965 end Set_Has_Delayed_Rep_Aspects;
3966
3967 procedure Set_Has_Discriminants (Id : E; V : B := True) is
3968 begin
3969 pragma Assert (Nkind (Id) in N_Entity);
3970 Set_Flag5 (Id, V);
3971 end Set_Has_Discriminants;
3972
3973 procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is
3974 begin
3975 pragma Assert (Ekind (Id) = E_Record_Type
3976 and then Is_Tagged_Type (Id));
3977 Set_Flag220 (Id, V);
3978 end Set_Has_Dispatch_Table;
3979
3980 procedure Set_Has_Dynamic_Predicate_Aspect (Id : E; V : B := True) is
3981 begin
3982 pragma Assert (Is_Type (Id));
3983 Set_Flag258 (Id, V);
3984 end Set_Has_Dynamic_Predicate_Aspect;
3985
3986 procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True) is
3987 begin
3988 pragma Assert (Is_Enumeration_Type (Id));
3989 Set_Flag66 (Id, V);
3990 end Set_Has_Enumeration_Rep_Clause;
3991
3992 procedure Set_Has_Exit (Id : E; V : B := True) is
3993 begin
3994 Set_Flag47 (Id, V);
3995 end Set_Has_Exit;
3996
3997 procedure Set_Has_External_Tag_Rep_Clause (Id : E; V : B := True) is
3998 begin
3999 pragma Assert (Is_Tagged_Type (Id));
4000 Set_Flag110 (Id, V);
4001 end Set_Has_External_Tag_Rep_Clause;
4002
4003 procedure Set_Has_Forward_Instantiation (Id : E; V : B := True) is
4004 begin
4005 Set_Flag175 (Id, V);
4006 end Set_Has_Forward_Instantiation;
4007
4008 procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True) is
4009 begin
4010 Set_Flag173 (Id, V);
4011 end Set_Has_Fully_Qualified_Name;
4012
4013 procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True) is
4014 begin
4015 Set_Flag82 (Id, V);
4016 end Set_Has_Gigi_Rep_Item;
4017
4018 procedure Set_Has_Homonym (Id : E; V : B := True) is
4019 begin
4020 Set_Flag56 (Id, V);
4021 end Set_Has_Homonym;
4022
4023 procedure Set_Has_Implicit_Dereference (Id : E; V : B := True) is
4024 begin
4025 Set_Flag251 (Id, V);
4026 end Set_Has_Implicit_Dereference;
4027
4028 procedure Set_Has_Independent_Components (Id : E; V : B := True) is
4029 begin
4030 pragma Assert (Is_Object (Id) or else Is_Type (Id));
4031 Set_Flag34 (Id, V);
4032 end Set_Has_Independent_Components;
4033
4034 procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is
4035 begin
4036 pragma Assert (Is_Type (Id));
4037 Set_Flag248 (Id, V);
4038 end Set_Has_Inheritable_Invariants;
4039
4040 procedure Set_Has_Initial_Value (Id : E; V : B := True) is
4041 begin
4042 pragma Assert (Ekind_In (Id, E_Variable, E_Out_Parameter));
4043 Set_Flag219 (Id, V);
4044 end Set_Has_Initial_Value;
4045
4046 procedure Set_Has_Invariants (Id : E; V : B := True) is
4047 begin
4048 pragma Assert (Is_Type (Id));
4049 Set_Flag232 (Id, V);
4050 end Set_Has_Invariants;
4051
4052 procedure Set_Has_Loop_Entry_Attributes (Id : E; V : B := True) is
4053 begin
4054 pragma Assert (Ekind (Id) = E_Loop);
4055 Set_Flag260 (Id, V);
4056 end Set_Has_Loop_Entry_Attributes;
4057
4058 procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True) is
4059 begin
4060 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
4061 Set_Flag83 (Id, V);
4062 end Set_Has_Machine_Radix_Clause;
4063
4064 procedure Set_Has_Master_Entity (Id : E; V : B := True) is
4065 begin
4066 Set_Flag21 (Id, V);
4067 end Set_Has_Master_Entity;
4068
4069 procedure Set_Has_Missing_Return (Id : E; V : B := True) is
4070 begin
4071 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
4072 Set_Flag142 (Id, V);
4073 end Set_Has_Missing_Return;
4074
4075 procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True) is
4076 begin
4077 Set_Flag101 (Id, V);
4078 end Set_Has_Nested_Block_With_Handler;
4079
4080 procedure Set_Has_Up_Level_Access (Id : E; V : B := True) is
4081 begin
4082 pragma Assert (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter));
4083 Set_Flag215 (Id, V);
4084 end Set_Has_Up_Level_Access;
4085
4086 procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
4087 begin
4088 pragma Assert (Id = Base_Type (Id));
4089 Set_Flag75 (Id, V);
4090 end Set_Has_Non_Standard_Rep;
4091
4092 procedure Set_Has_Object_Size_Clause (Id : E; V : B := True) is
4093 begin
4094 pragma Assert (Is_Type (Id));
4095 Set_Flag172 (Id, V);
4096 end Set_Has_Object_Size_Clause;
4097
4098 procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True) is
4099 begin
4100 Set_Flag154 (Id, V);
4101 end Set_Has_Per_Object_Constraint;
4102
4103 procedure Set_Has_Postconditions (Id : E; V : B := True) is
4104 begin
4105 pragma Assert (Is_Subprogram (Id));
4106 Set_Flag240 (Id, V);
4107 end Set_Has_Postconditions;
4108
4109 procedure Set_Has_Pragma_Controlled (Id : E; V : B := True) is
4110 begin
4111 pragma Assert (Is_Access_Type (Id));
4112 Set_Flag27 (Base_Type (Id), V);
4113 end Set_Has_Pragma_Controlled;
4114
4115 procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True) is
4116 begin
4117 Set_Flag150 (Id, V);
4118 end Set_Has_Pragma_Elaborate_Body;
4119
4120 procedure Set_Has_Pragma_Inline (Id : E; V : B := True) is
4121 begin
4122 Set_Flag157 (Id, V);
4123 end Set_Has_Pragma_Inline;
4124
4125 procedure Set_Has_Pragma_Inline_Always (Id : E; V : B := True) is
4126 begin
4127 Set_Flag230 (Id, V);
4128 end Set_Has_Pragma_Inline_Always;
4129
4130 procedure Set_Has_Pragma_No_Inline (Id : E; V : B := True) is
4131 begin
4132 Set_Flag201 (Id, V);
4133 end Set_Has_Pragma_No_Inline;
4134
4135 procedure Set_Has_Pragma_Ordered (Id : E; V : B := True) is
4136 begin
4137 pragma Assert (Is_Enumeration_Type (Id));
4138 pragma Assert (Id = Base_Type (Id));
4139 Set_Flag198 (Id, V);
4140 end Set_Has_Pragma_Ordered;
4141
4142 procedure Set_Has_Pragma_Pack (Id : E; V : B := True) is
4143 begin
4144 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
4145 pragma Assert (Id = Base_Type (Id));
4146 Set_Flag121 (Id, V);
4147 end Set_Has_Pragma_Pack;
4148
4149 procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True) is
4150 begin
4151 Set_Flag221 (Id, V);
4152 end Set_Has_Pragma_Preelab_Init;
4153
4154 procedure Set_Has_Pragma_Pure (Id : E; V : B := True) is
4155 begin
4156 Set_Flag203 (Id, V);
4157 end Set_Has_Pragma_Pure;
4158
4159 procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True) is
4160 begin
4161 Set_Flag179 (Id, V);
4162 end Set_Has_Pragma_Pure_Function;
4163
4164 procedure Set_Has_Pragma_Thread_Local_Storage (Id : E; V : B := True) is
4165 begin
4166 Set_Flag169 (Id, V);
4167 end Set_Has_Pragma_Thread_Local_Storage;
4168
4169 procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True) is
4170 begin
4171 Set_Flag233 (Id, V);
4172 end Set_Has_Pragma_Unmodified;
4173
4174 procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True) is
4175 begin
4176 Set_Flag180 (Id, V);
4177 end Set_Has_Pragma_Unreferenced;
4178
4179 procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True) is
4180 begin
4181 pragma Assert (Is_Type (Id));
4182 Set_Flag212 (Id, V);
4183 end Set_Has_Pragma_Unreferenced_Objects;
4184
4185 procedure Set_Has_Predicates (Id : E; V : B := True) is
4186 begin
4187 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Void);
4188 Set_Flag250 (Id, V);
4189 end Set_Has_Predicates;
4190
4191 procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is
4192 begin
4193 pragma Assert (Id = Base_Type (Id));
4194 Set_Flag120 (Id, V);
4195 end Set_Has_Primitive_Operations;
4196
4197 procedure Set_Has_Private_Ancestor (Id : E; V : B := True) is
4198 begin
4199 pragma Assert (Is_Type (Id));
4200 Set_Flag151 (Id, V);
4201 end Set_Has_Private_Ancestor;
4202
4203 procedure Set_Has_Private_Declaration (Id : E; V : B := True) is
4204 begin
4205 Set_Flag155 (Id, V);
4206 end Set_Has_Private_Declaration;
4207
4208 procedure Set_Has_Qualified_Name (Id : E; V : B := True) is
4209 begin
4210 Set_Flag161 (Id, V);
4211 end Set_Has_Qualified_Name;
4212
4213 procedure Set_Has_RACW (Id : E; V : B := True) is
4214 begin
4215 pragma Assert (Ekind (Id) = E_Package);
4216 Set_Flag214 (Id, V);
4217 end Set_Has_RACW;
4218
4219 procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True) is
4220 begin
4221 pragma Assert (Id = Base_Type (Id));
4222 Set_Flag65 (Id, V);
4223 end Set_Has_Record_Rep_Clause;
4224
4225 procedure Set_Has_Recursive_Call (Id : E; V : B := True) is
4226 begin
4227 pragma Assert (Is_Subprogram (Id));
4228 Set_Flag143 (Id, V);
4229 end Set_Has_Recursive_Call;
4230
4231 procedure Set_Has_Size_Clause (Id : E; V : B := True) is
4232 begin
4233 Set_Flag29 (Id, V);
4234 end Set_Has_Size_Clause;
4235
4236 procedure Set_Has_Small_Clause (Id : E; V : B := True) is
4237 begin
4238 Set_Flag67 (Id, V);
4239 end Set_Has_Small_Clause;
4240
4241 procedure Set_Has_Specified_Layout (Id : E; V : B := True) is
4242 begin
4243 pragma Assert (Id = Base_Type (Id));
4244 Set_Flag100 (Id, V);
4245 end Set_Has_Specified_Layout;
4246
4247 procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True) is
4248 begin
4249 pragma Assert (Is_Type (Id));
4250 Set_Flag190 (Id, V);
4251 end Set_Has_Specified_Stream_Input;
4252
4253 procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True) is
4254 begin
4255 pragma Assert (Is_Type (Id));
4256 Set_Flag191 (Id, V);
4257 end Set_Has_Specified_Stream_Output;
4258
4259 procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True) is
4260 begin
4261 pragma Assert (Is_Type (Id));
4262 Set_Flag192 (Id, V);
4263 end Set_Has_Specified_Stream_Read;
4264
4265 procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True) is
4266 begin
4267 pragma Assert (Is_Type (Id));
4268 Set_Flag193 (Id, V);
4269 end Set_Has_Specified_Stream_Write;
4270
4271 procedure Set_Has_Static_Discriminants (Id : E; V : B := True) is
4272 begin
4273 Set_Flag211 (Id, V);
4274 end Set_Has_Static_Discriminants;
4275
4276 procedure Set_Has_Static_Predicate_Aspect (Id : E; V : B := True) is
4277 begin
4278 pragma Assert (Is_Type (Id));
4279 Set_Flag259 (Id, V);
4280 end Set_Has_Static_Predicate_Aspect;
4281
4282 procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True) is
4283 begin
4284 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
4285 pragma Assert (Id = Base_Type (Id));
4286 Set_Flag23 (Id, V);
4287 end Set_Has_Storage_Size_Clause;
4288
4289 procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True) is
4290 begin
4291 pragma Assert (Is_Elementary_Type (Id));
4292 Set_Flag184 (Id, V);
4293 end Set_Has_Stream_Size_Clause;
4294
4295 procedure Set_Has_Task (Id : E; V : B := True) is
4296 begin
4297 pragma Assert (Id = Base_Type (Id));
4298 Set_Flag30 (Id, V);
4299 end Set_Has_Task;
4300
4301 procedure Set_Has_Thunks (Id : E; V : B := True) is
4302 begin
4303 pragma Assert (Is_Tag (Id));
4304 Set_Flag228 (Id, V);
4305 end Set_Has_Thunks;
4306
4307 procedure Set_Has_Unchecked_Union (Id : E; V : B := True) is
4308 begin
4309 pragma Assert (Id = Base_Type (Id));
4310 Set_Flag123 (Id, V);
4311 end Set_Has_Unchecked_Union;
4312
4313 procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True) is
4314 begin
4315 pragma Assert (Is_Type (Id));
4316 Set_Flag72 (Id, V);
4317 end Set_Has_Unknown_Discriminants;
4318
4319 procedure Set_Has_Volatile_Components (Id : E; V : B := True) is
4320 begin
4321 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4322 Set_Flag87 (Id, V);
4323 end Set_Has_Volatile_Components;
4324
4325 procedure Set_Has_Xref_Entry (Id : E; V : B := True) is
4326 begin
4327 Set_Flag182 (Id, V);
4328 end Set_Has_Xref_Entry;
4329
4330 procedure Set_Hiding_Loop_Variable (Id : E; V : E) is
4331 begin
4332 pragma Assert (Ekind (Id) = E_Variable);
4333 Set_Node8 (Id, V);
4334 end Set_Hiding_Loop_Variable;
4335
4336 procedure Set_Homonym (Id : E; V : E) is
4337 begin
4338 pragma Assert (Id /= V);
4339 Set_Node4 (Id, V);
4340 end Set_Homonym;
4341
4342 procedure Set_Interface_Alias (Id : E; V : E) is
4343 begin
4344 pragma Assert
4345 (Is_Internal (Id)
4346 and then Is_Hidden (Id)
4347 and then (Ekind_In (Id, E_Procedure, E_Function)));
4348 Set_Node25 (Id, V);
4349 end Set_Interface_Alias;
4350
4351 procedure Set_Interfaces (Id : E; V : L) is
4352 begin
4353 pragma Assert (Is_Record_Type (Id));
4354 Set_Elist25 (Id, V);
4355 end Set_Interfaces;
4356
4357 procedure Set_In_Package_Body (Id : E; V : B := True) is
4358 begin
4359 Set_Flag48 (Id, V);
4360 end Set_In_Package_Body;
4361
4362 procedure Set_In_Private_Part (Id : E; V : B := True) is
4363 begin
4364 Set_Flag45 (Id, V);
4365 end Set_In_Private_Part;
4366
4367 procedure Set_In_Use (Id : E; V : B := True) is
4368 begin
4369 pragma Assert (Nkind (Id) in N_Entity);
4370 Set_Flag8 (Id, V);
4371 end Set_In_Use;
4372
4373 procedure Set_Initialization_Statements (Id : E; V : N) is
4374 begin
4375 -- Tolerate an E_Void entity since this can be called while resolving
4376 -- an aggregate used as the initialization expression for an object
4377 -- declaration, and this occurs before the Ekind for the object is set.
4378
4379 pragma Assert (Ekind_In (Id, E_Void, E_Constant, E_Variable));
4380 Set_Node28 (Id, V);
4381 end Set_Initialization_Statements;
4382
4383 procedure Set_Inner_Instances (Id : E; V : L) is
4384 begin
4385 Set_Elist23 (Id, V);
4386 end Set_Inner_Instances;
4387
4388 procedure Set_Interface_Name (Id : E; V : N) is
4389 begin
4390 Set_Node21 (Id, V);
4391 end Set_Interface_Name;
4392
4393 procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is
4394 begin
4395 pragma Assert (Is_Overloadable (Id));
4396 Set_Flag19 (Id, V);
4397 end Set_Is_Abstract_Subprogram;
4398
4399 procedure Set_Is_Abstract_Type (Id : E; V : B := True) is
4400 begin
4401 pragma Assert (Is_Type (Id));
4402 Set_Flag146 (Id, V);
4403 end Set_Is_Abstract_Type;
4404
4405 procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
4406 begin
4407 pragma Assert (Is_Access_Type (Id));
4408 Set_Flag194 (Id, V);
4409 end Set_Is_Local_Anonymous_Access;
4410
4411 procedure Set_Is_Access_Constant (Id : E; V : B := True) is
4412 begin
4413 pragma Assert (Is_Access_Type (Id));
4414 Set_Flag69 (Id, V);
4415 end Set_Is_Access_Constant;
4416
4417 procedure Set_Is_Ada_2005_Only (Id : E; V : B := True) is
4418 begin
4419 Set_Flag185 (Id, V);
4420 end Set_Is_Ada_2005_Only;
4421
4422 procedure Set_Is_Ada_2012_Only (Id : E; V : B := True) is
4423 begin
4424 Set_Flag199 (Id, V);
4425 end Set_Is_Ada_2012_Only;
4426
4427 procedure Set_Is_Aliased (Id : E; V : B := True) is
4428 begin
4429 pragma Assert (Nkind (Id) in N_Entity);
4430 Set_Flag15 (Id, V);
4431 end Set_Is_Aliased;
4432
4433 procedure Set_Is_AST_Entry (Id : E; V : B := True) is
4434 begin
4435 pragma Assert (Is_Entry (Id));
4436 Set_Flag132 (Id, V);
4437 end Set_Is_AST_Entry;
4438
4439 procedure Set_Is_Asynchronous (Id : E; V : B := True) is
4440 begin
4441 pragma Assert
4442 (Ekind (Id) = E_Procedure or else Is_Type (Id));
4443 Set_Flag81 (Id, V);
4444 end Set_Is_Asynchronous;
4445
4446 procedure Set_Is_Atomic (Id : E; V : B := True) is
4447 begin
4448 Set_Flag85 (Id, V);
4449 end Set_Is_Atomic;
4450
4451 procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True) is
4452 begin
4453 pragma Assert ((not V)
4454 or else (Is_Array_Type (Id) and then Is_Base_Type (Id)));
4455 Set_Flag122 (Id, V);
4456 end Set_Is_Bit_Packed_Array;
4457
4458 procedure Set_Is_Called (Id : E; V : B := True) is
4459 begin
4460 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
4461 Set_Flag102 (Id, V);
4462 end Set_Is_Called;
4463
4464 procedure Set_Is_Character_Type (Id : E; V : B := True) is
4465 begin
4466 Set_Flag63 (Id, V);
4467 end Set_Is_Character_Type;
4468
4469 procedure Set_Is_Child_Unit (Id : E; V : B := True) is
4470 begin
4471 Set_Flag73 (Id, V);
4472 end Set_Is_Child_Unit;
4473
4474 procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is
4475 begin
4476 Set_Flag35 (Id, V);
4477 end Set_Is_Class_Wide_Equivalent_Type;
4478
4479 procedure Set_Is_Compilation_Unit (Id : E; V : B := True) is
4480 begin
4481 Set_Flag149 (Id, V);
4482 end Set_Is_Compilation_Unit;
4483
4484 procedure Set_Is_Completely_Hidden (Id : E; V : B := True) is
4485 begin
4486 pragma Assert (Ekind (Id) = E_Discriminant);
4487 Set_Flag103 (Id, V);
4488 end Set_Is_Completely_Hidden;
4489
4490 procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True) is
4491 begin
4492 Set_Flag20 (Id, V);
4493 end Set_Is_Concurrent_Record_Type;
4494
4495 procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True) is
4496 begin
4497 Set_Flag80 (Id, V);
4498 end Set_Is_Constr_Subt_For_U_Nominal;
4499
4500 procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True) is
4501 begin
4502 Set_Flag141 (Id, V);
4503 end Set_Is_Constr_Subt_For_UN_Aliased;
4504
4505 procedure Set_Is_Constrained (Id : E; V : B := True) is
4506 begin
4507 pragma Assert (Nkind (Id) in N_Entity);
4508 Set_Flag12 (Id, V);
4509 end Set_Is_Constrained;
4510
4511 procedure Set_Is_Constructor (Id : E; V : B := True) is
4512 begin
4513 Set_Flag76 (Id, V);
4514 end Set_Is_Constructor;
4515
4516 procedure Set_Is_Controlled (Id : E; V : B := True) is
4517 begin
4518 pragma Assert (Id = Base_Type (Id));
4519 Set_Flag42 (Id, V);
4520 end Set_Is_Controlled;
4521
4522 procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is
4523 begin
4524 pragma Assert (Is_Formal (Id));
4525 Set_Flag97 (Id, V);
4526 end Set_Is_Controlling_Formal;
4527
4528 procedure Set_Is_CPP_Class (Id : E; V : B := True) is
4529 begin
4530 Set_Flag74 (Id, V);
4531 end Set_Is_CPP_Class;
4532
4533 procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True) is
4534 begin
4535 pragma Assert (Is_Type (Id));
4536 Set_Flag223 (Id, V);
4537 end Set_Is_Descendent_Of_Address;
4538
4539 procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is
4540 begin
4541 Set_Flag176 (Id, V);
4542 end Set_Is_Discrim_SO_Function;
4543
4544 procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True) is
4545 begin
4546 Set_Flag234 (Id, V);
4547 end Set_Is_Dispatch_Table_Entity;
4548
4549 procedure Set_Is_Dispatching_Operation (Id : E; V : B := True) is
4550 begin
4551 pragma Assert
4552 (V = False
4553 or else
4554 Is_Overloadable (Id)
4555 or else
4556 Ekind (Id) = E_Subprogram_Type);
4557
4558 Set_Flag6 (Id, V);
4559 end Set_Is_Dispatching_Operation;
4560
4561 procedure Set_Is_Eliminated (Id : E; V : B := True) is
4562 begin
4563 Set_Flag124 (Id, V);
4564 end Set_Is_Eliminated;
4565
4566 procedure Set_Is_Entry_Formal (Id : E; V : B := True) is
4567 begin
4568 Set_Flag52 (Id, V);
4569 end Set_Is_Entry_Formal;
4570
4571 procedure Set_Is_Exported (Id : E; V : B := True) is
4572 begin
4573 Set_Flag99 (Id, V);
4574 end Set_Is_Exported;
4575
4576 procedure Set_Is_First_Subtype (Id : E; V : B := True) is
4577 begin
4578 Set_Flag70 (Id, V);
4579 end Set_Is_First_Subtype;
4580
4581 procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
4582 begin
4583 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
4584 Set_Flag118 (Id, V);
4585 end Set_Is_For_Access_Subtype;
4586
4587 procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is
4588 begin
4589 Set_Flag111 (Id, V);
4590 end Set_Is_Formal_Subprogram;
4591
4592 procedure Set_Is_Frozen (Id : E; V : B := True) is
4593 begin
4594 pragma Assert (Nkind (Id) in N_Entity);
4595 Set_Flag4 (Id, V);
4596 end Set_Is_Frozen;
4597
4598 procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True) is
4599 begin
4600 pragma Assert (Is_Type (Id));
4601 Set_Flag94 (Id, V);
4602 end Set_Is_Generic_Actual_Type;
4603
4604 procedure Set_Is_Generic_Instance (Id : E; V : B := True) is
4605 begin
4606 Set_Flag130 (Id, V);
4607 end Set_Is_Generic_Instance;
4608
4609 procedure Set_Is_Generic_Type (Id : E; V : B := True) is
4610 begin
4611 pragma Assert (Nkind (Id) in N_Entity);
4612 Set_Flag13 (Id, V);
4613 end Set_Is_Generic_Type;
4614
4615 procedure Set_Is_Hidden (Id : E; V : B := True) is
4616 begin
4617 Set_Flag57 (Id, V);
4618 end Set_Is_Hidden;
4619
4620 procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True) is
4621 begin
4622 Set_Flag171 (Id, V);
4623 end Set_Is_Hidden_Open_Scope;
4624
4625 procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
4626 begin
4627 pragma Assert (Nkind (Id) in N_Entity);
4628 Set_Flag7 (Id, V);
4629 end Set_Is_Immediately_Visible;
4630
4631 procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is
4632 begin
4633 Set_Flag254 (Id, V);
4634 end Set_Is_Implementation_Defined;
4635
4636 procedure Set_Is_Imported (Id : E; V : B := True) is
4637 begin
4638 Set_Flag24 (Id, V);
4639 end Set_Is_Imported;
4640
4641 procedure Set_Is_Inlined (Id : E; V : B := True) is
4642 begin
4643 Set_Flag11 (Id, V);
4644 end Set_Is_Inlined;
4645
4646 procedure Set_Is_Interface (Id : E; V : B := True) is
4647 begin
4648 pragma Assert (Is_Record_Type (Id));
4649 Set_Flag186 (Id, V);
4650 end Set_Is_Interface;
4651
4652 procedure Set_Is_Instantiated (Id : E; V : B := True) is
4653 begin
4654 Set_Flag126 (Id, V);
4655 end Set_Is_Instantiated;
4656
4657 procedure Set_Is_Internal (Id : E; V : B := True) is
4658 begin
4659 pragma Assert (Nkind (Id) in N_Entity);
4660 Set_Flag17 (Id, V);
4661 end Set_Is_Internal;
4662
4663 procedure Set_Is_Interrupt_Handler (Id : E; V : B := True) is
4664 begin
4665 pragma Assert (Nkind (Id) in N_Entity);
4666 Set_Flag89 (Id, V);
4667 end Set_Is_Interrupt_Handler;
4668
4669 procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True) is
4670 begin
4671 Set_Flag64 (Id, V);
4672 end Set_Is_Intrinsic_Subprogram;
4673
4674 procedure Set_Is_Invariant_Procedure (Id : E; V : B := True) is
4675 begin
4676 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
4677 Set_Flag257 (Id, V);
4678 end Set_Is_Invariant_Procedure;
4679
4680 procedure Set_Is_Itype (Id : E; V : B := True) is
4681 begin
4682 Set_Flag91 (Id, V);
4683 end Set_Is_Itype;
4684
4685 procedure Set_Is_Known_Non_Null (Id : E; V : B := True) is
4686 begin
4687 Set_Flag37 (Id, V);
4688 end Set_Is_Known_Non_Null;
4689
4690 procedure Set_Is_Known_Null (Id : E; V : B := True) is
4691 begin
4692 Set_Flag204 (Id, V);
4693 end Set_Is_Known_Null;
4694
4695 procedure Set_Is_Known_Valid (Id : E; V : B := True) is
4696 begin
4697 Set_Flag170 (Id, V);
4698 end Set_Is_Known_Valid;
4699
4700 procedure Set_Is_Limited_Composite (Id : E; V : B := True) is
4701 begin
4702 pragma Assert (Is_Type (Id));
4703 Set_Flag106 (Id, V);
4704 end Set_Is_Limited_Composite;
4705
4706 procedure Set_Is_Limited_Interface (Id : E; V : B := True) is
4707 begin
4708 pragma Assert (Is_Interface (Id));
4709 Set_Flag197 (Id, V);
4710 end Set_Is_Limited_Interface;
4711
4712 procedure Set_Is_Limited_Record (Id : E; V : B := True) is
4713 begin
4714 Set_Flag25 (Id, V);
4715 end Set_Is_Limited_Record;
4716
4717 procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
4718 begin
4719 pragma Assert (Is_Subprogram (Id));
4720 Set_Flag137 (Id, V);
4721 end Set_Is_Machine_Code_Subprogram;
4722
4723 procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True) is
4724 begin
4725 pragma Assert (Is_Type (Id));
4726 Set_Flag109 (Id, V);
4727 end Set_Is_Non_Static_Subtype;
4728
4729 procedure Set_Is_Null_Init_Proc (Id : E; V : B := True) is
4730 begin
4731 pragma Assert (Ekind (Id) = E_Procedure);
4732 Set_Flag178 (Id, V);
4733 end Set_Is_Null_Init_Proc;
4734
4735 procedure Set_Is_Obsolescent (Id : E; V : B := True) is
4736 begin
4737 Set_Flag153 (Id, V);
4738 end Set_Is_Obsolescent;
4739
4740 procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True) is
4741 begin
4742 pragma Assert (Ekind (Id) = E_Out_Parameter);
4743 Set_Flag226 (Id, V);
4744 end Set_Is_Only_Out_Parameter;
4745
4746 procedure Set_Is_Optional_Parameter (Id : E; V : B := True) is
4747 begin
4748 pragma Assert (Is_Formal (Id));
4749 Set_Flag134 (Id, V);
4750 end Set_Is_Optional_Parameter;
4751
4752 procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
4753 begin
4754 Set_Flag160 (Id, V);
4755 end Set_Is_Package_Body_Entity;
4756
4757 procedure Set_Is_Packed (Id : E; V : B := True) is
4758 begin
4759 pragma Assert (Id = Base_Type (Id));
4760 Set_Flag51 (Id, V);
4761 end Set_Is_Packed;
4762
4763 procedure Set_Is_Packed_Array_Type (Id : E; V : B := True) is
4764 begin
4765 Set_Flag138 (Id, V);
4766 end Set_Is_Packed_Array_Type;
4767
4768 procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
4769 begin
4770 pragma Assert (Nkind (Id) in N_Entity);
4771 Set_Flag9 (Id, V);
4772 end Set_Is_Potentially_Use_Visible;
4773
4774 procedure Set_Is_Predicate_Function (Id : E; V : B := True) is
4775 begin
4776 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
4777 Set_Flag255 (Id, V);
4778 end Set_Is_Predicate_Function;
4779
4780 procedure Set_Is_Predicate_Function_M (Id : E; V : B := True) is
4781 begin
4782 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
4783 Set_Flag256 (Id, V);
4784 end Set_Is_Predicate_Function_M;
4785
4786 procedure Set_Is_Preelaborated (Id : E; V : B := True) is
4787 begin
4788 Set_Flag59 (Id, V);
4789 end Set_Is_Preelaborated;
4790
4791 procedure Set_Is_Primitive (Id : E; V : B := True) is
4792 begin
4793 pragma Assert
4794 (Is_Overloadable (Id)
4795 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
4796 Set_Flag218 (Id, V);
4797 end Set_Is_Primitive;
4798
4799 procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
4800 begin
4801 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
4802 Set_Flag195 (Id, V);
4803 end Set_Is_Primitive_Wrapper;
4804
4805 procedure Set_Is_Private_Composite (Id : E; V : B := True) is
4806 begin
4807 pragma Assert (Is_Type (Id));
4808 Set_Flag107 (Id, V);
4809 end Set_Is_Private_Composite;
4810
4811 procedure Set_Is_Private_Descendant (Id : E; V : B := True) is
4812 begin
4813 Set_Flag53 (Id, V);
4814 end Set_Is_Private_Descendant;
4815
4816 procedure Set_Is_Private_Primitive (Id : E; V : B := True) is
4817 begin
4818 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
4819 Set_Flag245 (Id, V);
4820 end Set_Is_Private_Primitive;
4821
4822 procedure Set_Is_Processed_Transient (Id : E; V : B := True) is
4823 begin
4824 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
4825 Set_Flag252 (Id, V);
4826 end Set_Is_Processed_Transient;
4827
4828 procedure Set_Is_Public (Id : E; V : B := True) is
4829 begin
4830 pragma Assert (Nkind (Id) in N_Entity);
4831 Set_Flag10 (Id, V);
4832 end Set_Is_Public;
4833
4834 procedure Set_Is_Pure (Id : E; V : B := True) is
4835 begin
4836 Set_Flag44 (Id, V);
4837 end Set_Is_Pure;
4838
4839 procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True) is
4840 begin
4841 pragma Assert (Is_Access_Type (Id));
4842 Set_Flag189 (Id, V);
4843 end Set_Is_Pure_Unit_Access_Type;
4844
4845 procedure Set_Is_RACW_Stub_Type (Id : E; V : B := True) is
4846 begin
4847 pragma Assert (Is_Type (Id));
4848 Set_Flag244 (Id, V);
4849 end Set_Is_RACW_Stub_Type;
4850
4851 procedure Set_Is_Raised (Id : E; V : B := True) is
4852 begin
4853 pragma Assert (Ekind (Id) = E_Exception);
4854 Set_Flag224 (Id, V);
4855 end Set_Is_Raised;
4856
4857 procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is
4858 begin
4859 Set_Flag62 (Id, V);
4860 end Set_Is_Remote_Call_Interface;
4861
4862 procedure Set_Is_Remote_Types (Id : E; V : B := True) is
4863 begin
4864 Set_Flag61 (Id, V);
4865 end Set_Is_Remote_Types;
4866
4867 procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True) is
4868 begin
4869 Set_Flag112 (Id, V);
4870 end Set_Is_Renaming_Of_Object;
4871
4872 procedure Set_Is_Return_Object (Id : E; V : B := True) is
4873 begin
4874 Set_Flag209 (Id, V);
4875 end Set_Is_Return_Object;
4876
4877 procedure Set_Is_Safe_To_Reevaluate (Id : E; V : B := True) is
4878 begin
4879 pragma Assert (Ekind (Id) = E_Variable);
4880 Set_Flag249 (Id, V);
4881 end Set_Is_Safe_To_Reevaluate;
4882
4883 procedure Set_Is_Shared_Passive (Id : E; V : B := True) is
4884 begin
4885 Set_Flag60 (Id, V);
4886 end Set_Is_Shared_Passive;
4887
4888 procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is
4889 begin
4890 pragma Assert
4891 (Is_Type (Id)
4892 or else Ekind_In (Id, E_Exception,
4893 E_Variable,
4894 E_Constant,
4895 E_Void));
4896 Set_Flag28 (Id, V);
4897 end Set_Is_Statically_Allocated;
4898
4899 procedure Set_Is_Tag (Id : E; V : B := True) is
4900 begin
4901 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
4902 Set_Flag78 (Id, V);
4903 end Set_Is_Tag;
4904
4905 procedure Set_Is_Tagged_Type (Id : E; V : B := True) is
4906 begin
4907 Set_Flag55 (Id, V);
4908 end Set_Is_Tagged_Type;
4909
4910 procedure Set_Is_Thunk (Id : E; V : B := True) is
4911 begin
4912 pragma Assert (Is_Subprogram (Id));
4913 Set_Flag225 (Id, V);
4914 end Set_Is_Thunk;
4915
4916 procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True) is
4917 begin
4918 Set_Flag235 (Id, V);
4919 end Set_Is_Trivial_Subprogram;
4920
4921 procedure Set_Is_True_Constant (Id : E; V : B := True) is
4922 begin
4923 Set_Flag163 (Id, V);
4924 end Set_Is_True_Constant;
4925
4926 procedure Set_Is_Unchecked_Union (Id : E; V : B := True) is
4927 begin
4928 pragma Assert (Id = Base_Type (Id));
4929 Set_Flag117 (Id, V);
4930 end Set_Is_Unchecked_Union;
4931
4932 procedure Set_Is_Underlying_Record_View (Id : E; V : B := True) is
4933 begin
4934 pragma Assert (Ekind (Id) = E_Record_Type);
4935 Set_Flag246 (Id, V);
4936 end Set_Is_Underlying_Record_View;
4937
4938 procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
4939 begin
4940 pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
4941 Set_Flag144 (Id, V);
4942 end Set_Is_Unsigned_Type;
4943
4944 procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
4945 begin
4946 pragma Assert (Ekind (Id) = E_Procedure);
4947 Set_Flag127 (Id, V);
4948 end Set_Is_Valued_Procedure;
4949
4950 procedure Set_Is_Visible_Formal (Id : E; V : B := True) is
4951 begin
4952 Set_Flag206 (Id, V);
4953 end Set_Is_Visible_Formal;
4954
4955 procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True) is
4956 begin
4957 Set_Flag116 (Id, V);
4958 end Set_Is_Visible_Lib_Unit;
4959
4960 procedure Set_Is_VMS_Exception (Id : E; V : B := True) is
4961 begin
4962 pragma Assert (Ekind (Id) = E_Exception);
4963 Set_Flag133 (Id, V);
4964 end Set_Is_VMS_Exception;
4965
4966 procedure Set_Is_Volatile (Id : E; V : B := True) is
4967 begin
4968 pragma Assert (Nkind (Id) in N_Entity);
4969 Set_Flag16 (Id, V);
4970 end Set_Is_Volatile;
4971
4972 procedure Set_Itype_Printed (Id : E; V : B := True) is
4973 begin
4974 pragma Assert (Is_Itype (Id));
4975 Set_Flag202 (Id, V);
4976 end Set_Itype_Printed;
4977
4978 procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
4979 begin
4980 Set_Flag32 (Id, V);
4981 end Set_Kill_Elaboration_Checks;
4982
4983 procedure Set_Kill_Range_Checks (Id : E; V : B := True) is
4984 begin
4985 Set_Flag33 (Id, V);
4986 end Set_Kill_Range_Checks;
4987
4988 procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True) is
4989 begin
4990 pragma Assert (Is_Type (Id));
4991 Set_Flag207 (Id, V);
4992 end Set_Known_To_Have_Preelab_Init;
4993
4994 procedure Set_Last_Assignment (Id : E; V : N) is
4995 begin
4996 pragma Assert (Is_Assignable (Id));
4997 Set_Node26 (Id, V);
4998 end Set_Last_Assignment;
4999
5000 procedure Set_Last_Entity (Id : E; V : E) is
5001 begin
5002 Set_Node20 (Id, V);
5003 end Set_Last_Entity;
5004
5005 procedure Set_Limited_View (Id : E; V : E) is
5006 begin
5007 pragma Assert (Ekind (Id) = E_Package);
5008 Set_Node23 (Id, V);
5009 end Set_Limited_View;
5010
5011 procedure Set_Lit_Indexes (Id : E; V : E) is
5012 begin
5013 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
5014 Set_Node15 (Id, V);
5015 end Set_Lit_Indexes;
5016
5017 procedure Set_Lit_Strings (Id : E; V : E) is
5018 begin
5019 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
5020 Set_Node16 (Id, V);
5021 end Set_Lit_Strings;
5022
5023 procedure Set_Low_Bound_Tested (Id : E; V : B := True) is
5024 begin
5025 pragma Assert (Is_Formal (Id));
5026 Set_Flag205 (Id, V);
5027 end Set_Low_Bound_Tested;
5028
5029 procedure Set_Machine_Radix_10 (Id : E; V : B := True) is
5030 begin
5031 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
5032 Set_Flag84 (Id, V);
5033 end Set_Machine_Radix_10;
5034
5035 procedure Set_Master_Id (Id : E; V : E) is
5036 begin
5037 pragma Assert (Is_Access_Type (Id));
5038 Set_Node17 (Id, V);
5039 end Set_Master_Id;
5040
5041 procedure Set_Materialize_Entity (Id : E; V : B := True) is
5042 begin
5043 Set_Flag168 (Id, V);
5044 end Set_Materialize_Entity;
5045
5046 procedure Set_May_Inherit_Delayed_Rep_Aspects (Id : E; V : B := True) is
5047 begin
5048 Set_Flag262 (Id, V);
5049 end Set_May_Inherit_Delayed_Rep_Aspects;
5050
5051 procedure Set_Mechanism (Id : E; V : M) is
5052 begin
5053 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
5054 Set_Uint8 (Id, UI_From_Int (V));
5055 end Set_Mechanism;
5056
5057 procedure Set_Modulus (Id : E; V : U) is
5058 begin
5059 pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
5060 Set_Uint17 (Id, V);
5061 end Set_Modulus;
5062
5063 procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True) is
5064 begin
5065 pragma Assert (Is_Type (Id));
5066 Set_Flag183 (Id, V);
5067 end Set_Must_Be_On_Byte_Boundary;
5068
5069 procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True) is
5070 begin
5071 pragma Assert (Is_Type (Id));
5072 Set_Flag208 (Id, V);
5073 end Set_Must_Have_Preelab_Init;
5074
5075 procedure Set_Needs_Debug_Info (Id : E; V : B := True) is
5076 begin
5077 Set_Flag147 (Id, V);
5078 end Set_Needs_Debug_Info;
5079
5080 procedure Set_Needs_No_Actuals (Id : E; V : B := True) is
5081 begin
5082 pragma Assert
5083 (Is_Overloadable (Id)
5084 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
5085 Set_Flag22 (Id, V);
5086 end Set_Needs_No_Actuals;
5087
5088 procedure Set_Never_Set_In_Source (Id : E; V : B := True) is
5089 begin
5090 Set_Flag115 (Id, V);
5091 end Set_Never_Set_In_Source;
5092
5093 procedure Set_Next_Inlined_Subprogram (Id : E; V : E) is
5094 begin
5095 Set_Node12 (Id, V);
5096 end Set_Next_Inlined_Subprogram;
5097
5098 procedure Set_No_Pool_Assigned (Id : E; V : B := True) is
5099 begin
5100 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
5101 Set_Flag131 (Id, V);
5102 end Set_No_Pool_Assigned;
5103
5104 procedure Set_No_Return (Id : E; V : B := True) is
5105 begin
5106 pragma Assert
5107 (V = False or else Ekind_In (Id, E_Procedure, E_Generic_Procedure));
5108 Set_Flag113 (Id, V);
5109 end Set_No_Return;
5110
5111 procedure Set_No_Strict_Aliasing (Id : E; V : B := True) is
5112 begin
5113 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
5114 Set_Flag136 (Id, V);
5115 end Set_No_Strict_Aliasing;
5116
5117 procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
5118 begin
5119 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
5120 Set_Flag58 (Id, V);
5121 end Set_Non_Binary_Modulus;
5122
5123 procedure Set_Non_Limited_View (Id : E; V : E) is
5124 begin
5125 pragma Assert (Ekind (Id) in Incomplete_Kind);
5126 Set_Node17 (Id, V);
5127 end Set_Non_Limited_View;
5128
5129 procedure Set_Nonzero_Is_True (Id : E; V : B := True) is
5130 begin
5131 pragma Assert
5132 (Root_Type (Id) = Standard_Boolean
5133 and then Ekind (Id) = E_Enumeration_Type);
5134 Set_Flag162 (Id, V);
5135 end Set_Nonzero_Is_True;
5136
5137 procedure Set_Normalized_First_Bit (Id : E; V : U) is
5138 begin
5139 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5140 Set_Uint8 (Id, V);
5141 end Set_Normalized_First_Bit;
5142
5143 procedure Set_Normalized_Position (Id : E; V : U) is
5144 begin
5145 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5146 Set_Uint14 (Id, V);
5147 end Set_Normalized_Position;
5148
5149 procedure Set_Normalized_Position_Max (Id : E; V : U) is
5150 begin
5151 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5152 Set_Uint10 (Id, V);
5153 end Set_Normalized_Position_Max;
5154
5155 procedure Set_OK_To_Rename (Id : E; V : B := True) is
5156 begin
5157 pragma Assert (Ekind (Id) = E_Variable);
5158 Set_Flag247 (Id, V);
5159 end Set_OK_To_Rename;
5160
5161 procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is
5162 begin
5163 pragma Assert
5164 (Is_Record_Type (Id) and then Is_Base_Type (Id));
5165 Set_Flag239 (Id, V);
5166 end Set_OK_To_Reorder_Components;
5167
5168 procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is
5169 begin
5170 pragma Assert
5171 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
5172 Set_Flag241 (Id, V);
5173 end Set_Optimize_Alignment_Space;
5174
5175 procedure Set_Optimize_Alignment_Time (Id : E; V : B := True) is
5176 begin
5177 pragma Assert
5178 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
5179 Set_Flag242 (Id, V);
5180 end Set_Optimize_Alignment_Time;
5181
5182 procedure Set_Original_Access_Type (Id : E; V : E) is
5183 begin
5184 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
5185 Set_Node26 (Id, V);
5186 end Set_Original_Access_Type;
5187
5188 procedure Set_Original_Array_Type (Id : E; V : E) is
5189 begin
5190 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
5191 Set_Node21 (Id, V);
5192 end Set_Original_Array_Type;
5193
5194 procedure Set_Original_Record_Component (Id : E; V : E) is
5195 begin
5196 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
5197 Set_Node22 (Id, V);
5198 end Set_Original_Record_Component;
5199
5200 procedure Set_Overlays_Constant (Id : E; V : B := True) is
5201 begin
5202 Set_Flag243 (Id, V);
5203 end Set_Overlays_Constant;
5204
5205 procedure Set_Overridden_Operation (Id : E; V : E) is
5206 begin
5207 Set_Node26 (Id, V);
5208 end Set_Overridden_Operation;
5209
5210 procedure Set_Package_Instantiation (Id : E; V : N) is
5211 begin
5212 pragma Assert (Ekind_In (Id, E_Void, E_Generic_Package, E_Package));
5213 Set_Node26 (Id, V);
5214 end Set_Package_Instantiation;
5215
5216 procedure Set_Packed_Array_Type (Id : E; V : E) is
5217 begin
5218 pragma Assert (Is_Array_Type (Id));
5219 Set_Node23 (Id, V);
5220 end Set_Packed_Array_Type;
5221
5222 procedure Set_Parent_Subtype (Id : E; V : E) is
5223 begin
5224 pragma Assert (Ekind (Id) = E_Record_Type);
5225 Set_Node19 (Id, V);
5226 end Set_Parent_Subtype;
5227
5228 procedure Set_Postcondition_Proc (Id : E; V : E) is
5229 begin
5230 pragma Assert (Ekind (Id) = E_Procedure);
5231 Set_Node8 (Id, V);
5232 end Set_Postcondition_Proc;
5233
5234 procedure Set_PPC_Wrapper (Id : E; V : E) is
5235 begin
5236 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
5237 Set_Node25 (Id, V);
5238 end Set_PPC_Wrapper;
5239
5240 procedure Set_Direct_Primitive_Operations (Id : E; V : L) is
5241 begin
5242 pragma Assert (Is_Tagged_Type (Id));
5243 Set_Elist10 (Id, V);
5244 end Set_Direct_Primitive_Operations;
5245
5246 procedure Set_Prival (Id : E; V : E) is
5247 begin
5248 pragma Assert (Is_Protected_Component (Id));
5249 Set_Node17 (Id, V);
5250 end Set_Prival;
5251
5252 procedure Set_Prival_Link (Id : E; V : E) is
5253 begin
5254 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5255 Set_Node20 (Id, V);
5256 end Set_Prival_Link;
5257
5258 procedure Set_Private_Dependents (Id : E; V : L) is
5259 begin
5260 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
5261 Set_Elist18 (Id, V);
5262 end Set_Private_Dependents;
5263
5264 procedure Set_Private_View (Id : E; V : N) is
5265 begin
5266 pragma Assert (Is_Private_Type (Id));
5267 Set_Node22 (Id, V);
5268 end Set_Private_View;
5269
5270 procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
5271 begin
5272 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
5273 Set_Node11 (Id, V);
5274 end Set_Protected_Body_Subprogram;
5275
5276 procedure Set_Protected_Formal (Id : E; V : E) is
5277 begin
5278 pragma Assert (Is_Formal (Id));
5279 Set_Node22 (Id, V);
5280 end Set_Protected_Formal;
5281
5282 procedure Set_Protection_Object (Id : E; V : E) is
5283 begin
5284 pragma Assert (Ekind_In (Id, E_Entry,
5285 E_Entry_Family,
5286 E_Function,
5287 E_Procedure));
5288 Set_Node23 (Id, V);
5289 end Set_Protection_Object;
5290
5291 procedure Set_Reachable (Id : E; V : B := True) is
5292 begin
5293 Set_Flag49 (Id, V);
5294 end Set_Reachable;
5295
5296 procedure Set_Referenced (Id : E; V : B := True) is
5297 begin
5298 Set_Flag156 (Id, V);
5299 end Set_Referenced;
5300
5301 procedure Set_Referenced_As_LHS (Id : E; V : B := True) is
5302 begin
5303 Set_Flag36 (Id, V);
5304 end Set_Referenced_As_LHS;
5305
5306 procedure Set_Referenced_As_Out_Parameter (Id : E; V : B := True) is
5307 begin
5308 Set_Flag227 (Id, V);
5309 end Set_Referenced_As_Out_Parameter;
5310
5311 procedure Set_Refined_State_Pragma (Id : E; V : N) is
5312 begin
5313 pragma Assert (Ekind (Id) = E_Package_Body);
5314 Set_Node8 (Id, V);
5315 end Set_Refined_State_Pragma;
5316
5317 procedure Set_Register_Exception_Call (Id : E; V : N) is
5318 begin
5319 pragma Assert (Ekind (Id) = E_Exception);
5320 Set_Node20 (Id, V);
5321 end Set_Register_Exception_Call;
5322
5323 procedure Set_Related_Array_Object (Id : E; V : E) is
5324 begin
5325 pragma Assert (Is_Array_Type (Id));
5326 Set_Node25 (Id, V);
5327 end Set_Related_Array_Object;
5328
5329 procedure Set_Related_Expression (Id : E; V : N) is
5330 begin
5331 pragma Assert (Ekind (Id) in Type_Kind
5332 or else Ekind_In (Id, E_Constant, E_Variable, E_Void));
5333 Set_Node24 (Id, V);
5334 end Set_Related_Expression;
5335
5336 procedure Set_Related_Instance (Id : E; V : E) is
5337 begin
5338 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
5339 Set_Node15 (Id, V);
5340 end Set_Related_Instance;
5341
5342 procedure Set_Related_Type (Id : E; V : E) is
5343 begin
5344 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
5345 Set_Node27 (Id, V);
5346 end Set_Related_Type;
5347
5348 procedure Set_Relative_Deadline_Variable (Id : E; V : E) is
5349 begin
5350 pragma Assert (Is_Task_Type (Id) and then Is_Base_Type (Id));
5351 Set_Node26 (Id, V);
5352 end Set_Relative_Deadline_Variable;
5353
5354 procedure Set_Renamed_Entity (Id : E; V : N) is
5355 begin
5356 Set_Node18 (Id, V);
5357 end Set_Renamed_Entity;
5358
5359 procedure Set_Renamed_In_Spec (Id : E; V : B := True) is
5360 begin
5361 pragma Assert (Ekind (Id) = E_Package);
5362 Set_Flag231 (Id, V);
5363 end Set_Renamed_In_Spec;
5364
5365 procedure Set_Renamed_Object (Id : E; V : N) is
5366 begin
5367 Set_Node18 (Id, V);
5368 end Set_Renamed_Object;
5369
5370 procedure Set_Renaming_Map (Id : E; V : U) is
5371 begin
5372 Set_Uint9 (Id, V);
5373 end Set_Renaming_Map;
5374
5375 procedure Set_Requires_Overriding (Id : E; V : B := True) is
5376 begin
5377 pragma Assert (Is_Overloadable (Id));
5378 Set_Flag213 (Id, V);
5379 end Set_Requires_Overriding;
5380
5381 procedure Set_Return_Present (Id : E; V : B := True) is
5382 begin
5383 Set_Flag54 (Id, V);
5384 end Set_Return_Present;
5385
5386 procedure Set_Return_Applies_To (Id : E; V : N) is
5387 begin
5388 Set_Node8 (Id, V);
5389 end Set_Return_Applies_To;
5390
5391 procedure Set_Returns_By_Ref (Id : E; V : B := True) is
5392 begin
5393 Set_Flag90 (Id, V);
5394 end Set_Returns_By_Ref;
5395
5396 procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
5397 begin
5398 pragma Assert
5399 (Is_Record_Type (Id) and then Is_Base_Type (Id));
5400 Set_Flag164 (Id, V);
5401 end Set_Reverse_Bit_Order;
5402
5403 procedure Set_Reverse_Storage_Order (Id : E; V : B := True) is
5404 begin
5405 pragma Assert
5406 (Is_Base_Type (Id)
5407 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
5408 Set_Flag93 (Id, V);
5409 end Set_Reverse_Storage_Order;
5410
5411 procedure Set_RM_Size (Id : E; V : U) is
5412 begin
5413 pragma Assert (Is_Type (Id));
5414 Set_Uint13 (Id, V);
5415 end Set_RM_Size;
5416
5417 procedure Set_Scalar_Range (Id : E; V : N) is
5418 begin
5419 Set_Node20 (Id, V);
5420 end Set_Scalar_Range;
5421
5422 procedure Set_Scale_Value (Id : E; V : U) is
5423 begin
5424 Set_Uint15 (Id, V);
5425 end Set_Scale_Value;
5426
5427 procedure Set_Scope_Depth_Value (Id : E; V : U) is
5428 begin
5429 pragma Assert (not Is_Record_Type (Id));
5430 Set_Uint22 (Id, V);
5431 end Set_Scope_Depth_Value;
5432
5433 procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is
5434 begin
5435 Set_Flag167 (Id, V);
5436 end Set_Sec_Stack_Needed_For_Return;
5437
5438 procedure Set_Shadow_Entities (Id : E; V : S) is
5439 begin
5440 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
5441 Set_List14 (Id, V);
5442 end Set_Shadow_Entities;
5443
5444 procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is
5445 begin
5446 pragma Assert (Ekind (Id) = E_Variable);
5447 Set_Node22 (Id, V);
5448 end Set_Shared_Var_Procs_Instance;
5449
5450 procedure Set_Size_Check_Code (Id : E; V : N) is
5451 begin
5452 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5453 Set_Node19 (Id, V);
5454 end Set_Size_Check_Code;
5455
5456 procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True) is
5457 begin
5458 Set_Flag177 (Id, V);
5459 end Set_Size_Depends_On_Discriminant;
5460
5461 procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True) is
5462 begin
5463 Set_Flag92 (Id, V);
5464 end Set_Size_Known_At_Compile_Time;
5465
5466 procedure Set_Small_Value (Id : E; V : R) is
5467 begin
5468 pragma Assert (Is_Fixed_Point_Type (Id));
5469 Set_Ureal21 (Id, V);
5470 end Set_Small_Value;
5471
5472 procedure Set_SPARK_Mode_Pragmas (Id : E; V : N) is
5473 begin
5474 pragma Assert
5475 (Ekind_In (Id, E_Function, -- subprogram variants
5476 E_Generic_Function,
5477 E_Generic_Procedure,
5478 E_Procedure,
5479 E_Subprogram_Body)
5480 or else
5481 Ekind_In (Id, E_Generic_Package, -- package variants
5482 E_Package,
5483 E_Package_Body));
5484
5485 Set_Node32 (Id, V);
5486 end Set_SPARK_Mode_Pragmas;
5487
5488 procedure Set_Spec_Entity (Id : E; V : E) is
5489 begin
5490 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
5491 Set_Node19 (Id, V);
5492 end Set_Spec_Entity;
5493
5494 procedure Set_Static_Predicate (Id : E; V : S) is
5495 begin
5496 pragma Assert
5497 (Ekind_In (Id, E_Enumeration_Subtype,
5498 E_Modular_Integer_Subtype,
5499 E_Signed_Integer_Subtype)
5500 and then Has_Predicates (Id));
5501 Set_List25 (Id, V);
5502 end Set_Static_Predicate;
5503
5504 procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E) is
5505 begin
5506 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5507 Set_Node15 (Id, V);
5508 end Set_Status_Flag_Or_Transient_Decl;
5509
5510 procedure Set_Storage_Size_Variable (Id : E; V : E) is
5511 begin
5512 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
5513 pragma Assert (Id = Base_Type (Id));
5514 Set_Node15 (Id, V);
5515 end Set_Storage_Size_Variable;
5516
5517 procedure Set_Static_Elaboration_Desired (Id : E; V : B) is
5518 begin
5519 pragma Assert (Ekind (Id) = E_Package);
5520 Set_Flag77 (Id, V);
5521 end Set_Static_Elaboration_Desired;
5522
5523 procedure Set_Static_Initialization (Id : E; V : N) is
5524 begin
5525 pragma Assert
5526 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
5527 Set_Node30 (Id, V);
5528 end Set_Static_Initialization;
5529
5530 procedure Set_Stored_Constraint (Id : E; V : L) is
5531 begin
5532 pragma Assert (Nkind (Id) in N_Entity);
5533 Set_Elist23 (Id, V);
5534 end Set_Stored_Constraint;
5535
5536 procedure Set_Strict_Alignment (Id : E; V : B := True) is
5537 begin
5538 pragma Assert (Id = Base_Type (Id));
5539 Set_Flag145 (Id, V);
5540 end Set_Strict_Alignment;
5541
5542 procedure Set_String_Literal_Length (Id : E; V : U) is
5543 begin
5544 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
5545 Set_Uint16 (Id, V);
5546 end Set_String_Literal_Length;
5547
5548 procedure Set_String_Literal_Low_Bound (Id : E; V : N) is
5549 begin
5550 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
5551 Set_Node15 (Id, V);
5552 end Set_String_Literal_Low_Bound;
5553
5554 procedure Set_Subprograms_For_Type (Id : E; V : E) is
5555 begin
5556 pragma Assert (Is_Type (Id) or else Is_Subprogram (Id));
5557 Set_Node29 (Id, V);
5558 end Set_Subprograms_For_Type;
5559
5560 procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
5561 begin
5562 Set_Flag148 (Id, V);
5563 end Set_Suppress_Elaboration_Warnings;
5564
5565 procedure Set_Suppress_Initialization (Id : E; V : B := True) is
5566 begin
5567 pragma Assert (Is_Type (Id));
5568 Set_Flag105 (Id, V);
5569 end Set_Suppress_Initialization;
5570
5571 procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is
5572 begin
5573 Set_Flag165 (Id, V);
5574 end Set_Suppress_Style_Checks;
5575
5576 procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True) is
5577 begin
5578 Set_Flag217 (Id, V);
5579 end Set_Suppress_Value_Tracking_On_Call;
5580
5581 procedure Set_Task_Body_Procedure (Id : E; V : N) is
5582 begin
5583 pragma Assert (Ekind (Id) in Task_Kind);
5584 Set_Node25 (Id, V);
5585 end Set_Task_Body_Procedure;
5586
5587 procedure Set_Thunk_Entity (Id : E; V : E) is
5588 begin
5589 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
5590 and then Is_Thunk (Id));
5591 Set_Node31 (Id, V);
5592 end Set_Thunk_Entity;
5593
5594 procedure Set_Treat_As_Volatile (Id : E; V : B := True) is
5595 begin
5596 Set_Flag41 (Id, V);
5597 end Set_Treat_As_Volatile;
5598
5599 procedure Set_Underlying_Full_View (Id : E; V : E) is
5600 begin
5601 pragma Assert (Ekind (Id) in Private_Kind);
5602 Set_Node19 (Id, V);
5603 end Set_Underlying_Full_View;
5604
5605 procedure Set_Underlying_Record_View (Id : E; V : E) is
5606 begin
5607 pragma Assert (Ekind (Id) = E_Record_Type);
5608 Set_Node28 (Id, V);
5609 end Set_Underlying_Record_View;
5610
5611 procedure Set_Universal_Aliasing (Id : E; V : B := True) is
5612 begin
5613 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
5614 Set_Flag216 (Id, V);
5615 end Set_Universal_Aliasing;
5616
5617 procedure Set_Unset_Reference (Id : E; V : N) is
5618 begin
5619 Set_Node16 (Id, V);
5620 end Set_Unset_Reference;
5621
5622 procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
5623 begin
5624 Set_Flag222 (Id, V);
5625 end Set_Used_As_Generic_Actual;
5626
5627 procedure Set_Uses_Lock_Free (Id : E; V : B := True) is
5628 begin
5629 pragma Assert (Ekind (Id) = E_Protected_Type);
5630 Set_Flag188 (Id, V);
5631 end Set_Uses_Lock_Free;
5632
5633 procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
5634 begin
5635 Set_Flag95 (Id, V);
5636 end Set_Uses_Sec_Stack;
5637
5638 procedure Set_Warnings_Off (Id : E; V : B := True) is
5639 begin
5640 Set_Flag96 (Id, V);
5641 end Set_Warnings_Off;
5642
5643 procedure Set_Warnings_Off_Used (Id : E; V : B := True) is
5644 begin
5645 Set_Flag236 (Id, V);
5646 end Set_Warnings_Off_Used;
5647
5648 procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True) is
5649 begin
5650 Set_Flag237 (Id, V);
5651 end Set_Warnings_Off_Used_Unmodified;
5652
5653 procedure Set_Warnings_Off_Used_Unreferenced (Id : E; V : B := True) is
5654 begin
5655 Set_Flag238 (Id, V);
5656 end Set_Warnings_Off_Used_Unreferenced;
5657
5658 procedure Set_Was_Hidden (Id : E; V : B := True) is
5659 begin
5660 Set_Flag196 (Id, V);
5661 end Set_Was_Hidden;
5662
5663 procedure Set_Wrapped_Entity (Id : E; V : E) is
5664 begin
5665 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
5666 and then Is_Primitive_Wrapper (Id));
5667 Set_Node27 (Id, V);
5668 end Set_Wrapped_Entity;
5669
5670 -----------------------------------
5671 -- Field Initialization Routines --
5672 -----------------------------------
5673
5674 procedure Init_Alignment (Id : E) is
5675 begin
5676 Set_Uint14 (Id, Uint_0);
5677 end Init_Alignment;
5678
5679 procedure Init_Alignment (Id : E; V : Int) is
5680 begin
5681 Set_Uint14 (Id, UI_From_Int (V));
5682 end Init_Alignment;
5683
5684 procedure Init_Component_Bit_Offset (Id : E) is
5685 begin
5686 Set_Uint11 (Id, No_Uint);
5687 end Init_Component_Bit_Offset;
5688
5689 procedure Init_Component_Bit_Offset (Id : E; V : Int) is
5690 begin
5691 Set_Uint11 (Id, UI_From_Int (V));
5692 end Init_Component_Bit_Offset;
5693
5694 procedure Init_Component_Size (Id : E) is
5695 begin
5696 Set_Uint22 (Id, Uint_0);
5697 end Init_Component_Size;
5698
5699 procedure Init_Component_Size (Id : E; V : Int) is
5700 begin
5701 Set_Uint22 (Id, UI_From_Int (V));
5702 end Init_Component_Size;
5703
5704 procedure Init_Digits_Value (Id : E) is
5705 begin
5706 Set_Uint17 (Id, Uint_0);
5707 end Init_Digits_Value;
5708
5709 procedure Init_Digits_Value (Id : E; V : Int) is
5710 begin
5711 Set_Uint17 (Id, UI_From_Int (V));
5712 end Init_Digits_Value;
5713
5714 procedure Init_Esize (Id : E) is
5715 begin
5716 Set_Uint12 (Id, Uint_0);
5717 end Init_Esize;
5718
5719 procedure Init_Esize (Id : E; V : Int) is
5720 begin
5721 Set_Uint12 (Id, UI_From_Int (V));
5722 end Init_Esize;
5723
5724 procedure Init_Normalized_First_Bit (Id : E) is
5725 begin
5726 Set_Uint8 (Id, No_Uint);
5727 end Init_Normalized_First_Bit;
5728
5729 procedure Init_Normalized_First_Bit (Id : E; V : Int) is
5730 begin
5731 Set_Uint8 (Id, UI_From_Int (V));
5732 end Init_Normalized_First_Bit;
5733
5734 procedure Init_Normalized_Position (Id : E) is
5735 begin
5736 Set_Uint14 (Id, No_Uint);
5737 end Init_Normalized_Position;
5738
5739 procedure Init_Normalized_Position (Id : E; V : Int) is
5740 begin
5741 Set_Uint14 (Id, UI_From_Int (V));
5742 end Init_Normalized_Position;
5743
5744 procedure Init_Normalized_Position_Max (Id : E) is
5745 begin
5746 Set_Uint10 (Id, No_Uint);
5747 end Init_Normalized_Position_Max;
5748
5749 procedure Init_Normalized_Position_Max (Id : E; V : Int) is
5750 begin
5751 Set_Uint10 (Id, UI_From_Int (V));
5752 end Init_Normalized_Position_Max;
5753
5754 procedure Init_RM_Size (Id : E) is
5755 begin
5756 Set_Uint13 (Id, Uint_0);
5757 end Init_RM_Size;
5758
5759 procedure Init_RM_Size (Id : E; V : Int) is
5760 begin
5761 Set_Uint13 (Id, UI_From_Int (V));
5762 end Init_RM_Size;
5763
5764 -----------------------------
5765 -- Init_Component_Location --
5766 -----------------------------
5767
5768 procedure Init_Component_Location (Id : E) is
5769 begin
5770 Set_Uint8 (Id, No_Uint); -- Normalized_First_Bit
5771 Set_Uint10 (Id, No_Uint); -- Normalized_Position_Max
5772 Set_Uint11 (Id, No_Uint); -- Component_Bit_Offset
5773 Set_Uint12 (Id, Uint_0); -- Esize
5774 Set_Uint14 (Id, No_Uint); -- Normalized_Position
5775 end Init_Component_Location;
5776
5777 ----------------------------
5778 -- Init_Object_Size_Align --
5779 ----------------------------
5780
5781 procedure Init_Object_Size_Align (Id : E) is
5782 begin
5783 Set_Uint12 (Id, Uint_0); -- Esize
5784 Set_Uint14 (Id, Uint_0); -- Alignment
5785 end Init_Object_Size_Align;
5786
5787 ---------------
5788 -- Init_Size --
5789 ---------------
5790
5791 procedure Init_Size (Id : E; V : Int) is
5792 begin
5793 pragma Assert (not Is_Object (Id));
5794 Set_Uint12 (Id, UI_From_Int (V)); -- Esize
5795 Set_Uint13 (Id, UI_From_Int (V)); -- RM_Size
5796 end Init_Size;
5797
5798 ---------------------
5799 -- Init_Size_Align --
5800 ---------------------
5801
5802 procedure Init_Size_Align (Id : E) is
5803 begin
5804 pragma Assert (not Is_Object (Id));
5805 Set_Uint12 (Id, Uint_0); -- Esize
5806 Set_Uint13 (Id, Uint_0); -- RM_Size
5807 Set_Uint14 (Id, Uint_0); -- Alignment
5808 end Init_Size_Align;
5809
5810 ----------------------------------------------
5811 -- Type Representation Attribute Predicates --
5812 ----------------------------------------------
5813
5814 function Known_Alignment (E : Entity_Id) return B is
5815 begin
5816 return Uint14 (E) /= Uint_0
5817 and then Uint14 (E) /= No_Uint;
5818 end Known_Alignment;
5819
5820 function Known_Component_Bit_Offset (E : Entity_Id) return B is
5821 begin
5822 return Uint11 (E) /= No_Uint;
5823 end Known_Component_Bit_Offset;
5824
5825 function Known_Component_Size (E : Entity_Id) return B is
5826 begin
5827 return Uint22 (Base_Type (E)) /= Uint_0
5828 and then Uint22 (Base_Type (E)) /= No_Uint;
5829 end Known_Component_Size;
5830
5831 function Known_Esize (E : Entity_Id) return B is
5832 begin
5833 return Uint12 (E) /= Uint_0
5834 and then Uint12 (E) /= No_Uint;
5835 end Known_Esize;
5836
5837 function Known_Normalized_First_Bit (E : Entity_Id) return B is
5838 begin
5839 return Uint8 (E) /= No_Uint;
5840 end Known_Normalized_First_Bit;
5841
5842 function Known_Normalized_Position (E : Entity_Id) return B is
5843 begin
5844 return Uint14 (E) /= No_Uint;
5845 end Known_Normalized_Position;
5846
5847 function Known_Normalized_Position_Max (E : Entity_Id) return B is
5848 begin
5849 return Uint10 (E) /= No_Uint;
5850 end Known_Normalized_Position_Max;
5851
5852 function Known_RM_Size (E : Entity_Id) return B is
5853 begin
5854 return Uint13 (E) /= No_Uint
5855 and then (Uint13 (E) /= Uint_0
5856 or else Is_Discrete_Type (E)
5857 or else Is_Fixed_Point_Type (E));
5858 end Known_RM_Size;
5859
5860 function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is
5861 begin
5862 return Uint11 (E) /= No_Uint
5863 and then Uint11 (E) >= Uint_0;
5864 end Known_Static_Component_Bit_Offset;
5865
5866 function Known_Static_Component_Size (E : Entity_Id) return B is
5867 begin
5868 return Uint22 (Base_Type (E)) > Uint_0;
5869 end Known_Static_Component_Size;
5870
5871 function Known_Static_Esize (E : Entity_Id) return B is
5872 begin
5873 return Uint12 (E) > Uint_0
5874 and then not Is_Generic_Type (E);
5875 end Known_Static_Esize;
5876
5877 function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is
5878 begin
5879 return Uint8 (E) /= No_Uint
5880 and then Uint8 (E) >= Uint_0;
5881 end Known_Static_Normalized_First_Bit;
5882
5883 function Known_Static_Normalized_Position (E : Entity_Id) return B is
5884 begin
5885 return Uint14 (E) /= No_Uint
5886 and then Uint14 (E) >= Uint_0;
5887 end Known_Static_Normalized_Position;
5888
5889 function Known_Static_Normalized_Position_Max (E : Entity_Id) return B is
5890 begin
5891 return Uint10 (E) /= No_Uint
5892 and then Uint10 (E) >= Uint_0;
5893 end Known_Static_Normalized_Position_Max;
5894
5895 function Known_Static_RM_Size (E : Entity_Id) return B is
5896 begin
5897 return (Uint13 (E) > Uint_0
5898 or else Is_Discrete_Type (E)
5899 or else Is_Fixed_Point_Type (E))
5900 and then not Is_Generic_Type (E);
5901 end Known_Static_RM_Size;
5902
5903 function Unknown_Alignment (E : Entity_Id) return B is
5904 begin
5905 return Uint14 (E) = Uint_0
5906 or else Uint14 (E) = No_Uint;
5907 end Unknown_Alignment;
5908
5909 function Unknown_Component_Bit_Offset (E : Entity_Id) return B is
5910 begin
5911 return Uint11 (E) = No_Uint;
5912 end Unknown_Component_Bit_Offset;
5913
5914 function Unknown_Component_Size (E : Entity_Id) return B is
5915 begin
5916 return Uint22 (Base_Type (E)) = Uint_0
5917 or else
5918 Uint22 (Base_Type (E)) = No_Uint;
5919 end Unknown_Component_Size;
5920
5921 function Unknown_Esize (E : Entity_Id) return B is
5922 begin
5923 return Uint12 (E) = No_Uint
5924 or else
5925 Uint12 (E) = Uint_0;
5926 end Unknown_Esize;
5927
5928 function Unknown_Normalized_First_Bit (E : Entity_Id) return B is
5929 begin
5930 return Uint8 (E) = No_Uint;
5931 end Unknown_Normalized_First_Bit;
5932
5933 function Unknown_Normalized_Position (E : Entity_Id) return B is
5934 begin
5935 return Uint14 (E) = No_Uint;
5936 end Unknown_Normalized_Position;
5937
5938 function Unknown_Normalized_Position_Max (E : Entity_Id) return B is
5939 begin
5940 return Uint10 (E) = No_Uint;
5941 end Unknown_Normalized_Position_Max;
5942
5943 function Unknown_RM_Size (E : Entity_Id) return B is
5944 begin
5945 return (Uint13 (E) = Uint_0
5946 and then not Is_Discrete_Type (E)
5947 and then not Is_Fixed_Point_Type (E))
5948 or else Uint13 (E) = No_Uint;
5949 end Unknown_RM_Size;
5950
5951 --------------------
5952 -- Address_Clause --
5953 --------------------
5954
5955 function Address_Clause (Id : E) return N is
5956 begin
5957 return Get_Attribute_Definition_Clause (Id, Attribute_Address);
5958 end Address_Clause;
5959
5960 ---------------
5961 -- Aft_Value --
5962 ---------------
5963
5964 function Aft_Value (Id : E) return U is
5965 Result : Nat := 1;
5966 Delta_Val : Ureal := Delta_Value (Id);
5967 begin
5968 while Delta_Val < Ureal_Tenth loop
5969 Delta_Val := Delta_Val * Ureal_10;
5970 Result := Result + 1;
5971 end loop;
5972
5973 return UI_From_Int (Result);
5974 end Aft_Value;
5975
5976 ----------------------
5977 -- Alignment_Clause --
5978 ----------------------
5979
5980 function Alignment_Clause (Id : E) return N is
5981 begin
5982 return Get_Attribute_Definition_Clause (Id, Attribute_Alignment);
5983 end Alignment_Clause;
5984
5985 -------------------
5986 -- Append_Entity --
5987 -------------------
5988
5989 procedure Append_Entity (Id : Entity_Id; V : Entity_Id) is
5990 begin
5991 if Last_Entity (V) = Empty then
5992 Set_First_Entity (Id => V, V => Id);
5993 else
5994 Set_Next_Entity (Last_Entity (V), Id);
5995 end if;
5996
5997 Set_Next_Entity (Id, Empty);
5998 Set_Scope (Id, V);
5999 Set_Last_Entity (Id => V, V => Id);
6000 end Append_Entity;
6001
6002 ---------------
6003 -- Base_Type --
6004 ---------------
6005
6006 function Base_Type (Id : E) return E is
6007 begin
6008 if Is_Base_Type (Id) then
6009 return Id;
6010 else
6011 pragma Assert (Is_Type (Id));
6012 return Etype (Id);
6013 end if;
6014 end Base_Type;
6015
6016 -------------------------
6017 -- Component_Alignment --
6018 -------------------------
6019
6020 -- Component Alignment is encoded using two flags, Flag128/129 as
6021 -- follows. Note that both flags False = Align_Default, so that the
6022 -- default initialization of flags to False initializes component
6023 -- alignment to the default value as required.
6024
6025 -- Flag128 Flag129 Value
6026 -- ------- ------- -----
6027 -- False False Calign_Default
6028 -- False True Calign_Component_Size
6029 -- True False Calign_Component_Size_4
6030 -- True True Calign_Storage_Unit
6031
6032 function Component_Alignment (Id : E) return C is
6033 BT : constant Node_Id := Base_Type (Id);
6034
6035 begin
6036 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
6037
6038 if Flag128 (BT) then
6039 if Flag129 (BT) then
6040 return Calign_Storage_Unit;
6041 else
6042 return Calign_Component_Size_4;
6043 end if;
6044
6045 else
6046 if Flag129 (BT) then
6047 return Calign_Component_Size;
6048 else
6049 return Calign_Default;
6050 end if;
6051 end if;
6052 end Component_Alignment;
6053
6054 ----------------------
6055 -- Declaration_Node --
6056 ----------------------
6057
6058 function Declaration_Node (Id : E) return N is
6059 P : Node_Id;
6060
6061 begin
6062 if Ekind (Id) = E_Incomplete_Type
6063 and then Present (Full_View (Id))
6064 then
6065 P := Parent (Full_View (Id));
6066 else
6067 P := Parent (Id);
6068 end if;
6069
6070 loop
6071 if Nkind (P) /= N_Selected_Component
6072 and then Nkind (P) /= N_Expanded_Name
6073 and then
6074 not (Nkind (P) = N_Defining_Program_Unit_Name
6075 and then Is_Child_Unit (Id))
6076 then
6077 return P;
6078 else
6079 P := Parent (P);
6080 end if;
6081 end loop;
6082 end Declaration_Node;
6083
6084 ---------------------
6085 -- Designated_Type --
6086 ---------------------
6087
6088 function Designated_Type (Id : E) return E is
6089 Desig_Type : E;
6090
6091 begin
6092 Desig_Type := Directly_Designated_Type (Id);
6093
6094 if Ekind (Desig_Type) = E_Incomplete_Type
6095 and then Present (Full_View (Desig_Type))
6096 then
6097 return Full_View (Desig_Type);
6098
6099 elsif Is_Class_Wide_Type (Desig_Type)
6100 and then Ekind (Etype (Desig_Type)) = E_Incomplete_Type
6101 and then Present (Full_View (Etype (Desig_Type)))
6102 and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type))))
6103 then
6104 return Class_Wide_Type (Full_View (Etype (Desig_Type)));
6105
6106 else
6107 return Desig_Type;
6108 end if;
6109 end Designated_Type;
6110
6111 ----------------------
6112 -- Entry_Index_Type --
6113 ----------------------
6114
6115 function Entry_Index_Type (Id : E) return N is
6116 begin
6117 pragma Assert (Ekind (Id) = E_Entry_Family);
6118 return Etype (Discrete_Subtype_Definition (Parent (Id)));
6119 end Entry_Index_Type;
6120
6121 ---------------------
6122 -- First_Component --
6123 ---------------------
6124
6125 function First_Component (Id : E) return E is
6126 Comp_Id : E;
6127
6128 begin
6129 pragma Assert
6130 (Is_Record_Type (Id) or else Is_Incomplete_Or_Private_Type (Id));
6131
6132 Comp_Id := First_Entity (Id);
6133 while Present (Comp_Id) loop
6134 exit when Ekind (Comp_Id) = E_Component;
6135 Comp_Id := Next_Entity (Comp_Id);
6136 end loop;
6137
6138 return Comp_Id;
6139 end First_Component;
6140
6141 -------------------------------------
6142 -- First_Component_Or_Discriminant --
6143 -------------------------------------
6144
6145 function First_Component_Or_Discriminant (Id : E) return E is
6146 Comp_Id : E;
6147
6148 begin
6149 pragma Assert
6150 (Is_Record_Type (Id)
6151 or else Is_Incomplete_Or_Private_Type (Id)
6152 or else Has_Discriminants (Id));
6153
6154 Comp_Id := First_Entity (Id);
6155 while Present (Comp_Id) loop
6156 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
6157 Comp_Id := Next_Entity (Comp_Id);
6158 end loop;
6159
6160 return Comp_Id;
6161 end First_Component_Or_Discriminant;
6162
6163 ------------------
6164 -- First_Formal --
6165 ------------------
6166
6167 function First_Formal (Id : E) return E is
6168 Formal : E;
6169
6170 begin
6171 pragma Assert
6172 (Is_Overloadable (Id)
6173 or else Ekind_In (Id, E_Entry_Family,
6174 E_Subprogram_Body,
6175 E_Subprogram_Type));
6176
6177 if Ekind (Id) = E_Enumeration_Literal then
6178 return Empty;
6179
6180 else
6181 Formal := First_Entity (Id);
6182
6183 if Present (Formal) and then Is_Formal (Formal) then
6184 return Formal;
6185 else
6186 return Empty;
6187 end if;
6188 end if;
6189 end First_Formal;
6190
6191 ------------------------------
6192 -- First_Formal_With_Extras --
6193 ------------------------------
6194
6195 function First_Formal_With_Extras (Id : E) return E is
6196 Formal : E;
6197
6198 begin
6199 pragma Assert
6200 (Is_Overloadable (Id)
6201 or else Ekind_In (Id, E_Entry_Family,
6202 E_Subprogram_Body,
6203 E_Subprogram_Type));
6204
6205 if Ekind (Id) = E_Enumeration_Literal then
6206 return Empty;
6207
6208 else
6209 Formal := First_Entity (Id);
6210
6211 if Present (Formal) and then Is_Formal (Formal) then
6212 return Formal;
6213 else
6214 return Extra_Formals (Id); -- Empty if no extra formals
6215 end if;
6216 end if;
6217 end First_Formal_With_Extras;
6218
6219 -------------------------------------
6220 -- Get_Attribute_Definition_Clause --
6221 -------------------------------------
6222
6223 function Get_Attribute_Definition_Clause
6224 (E : Entity_Id;
6225 Id : Attribute_Id) return Node_Id
6226 is
6227 N : Node_Id;
6228
6229 begin
6230 N := First_Rep_Item (E);
6231 while Present (N) loop
6232 if Nkind (N) = N_Attribute_Definition_Clause
6233 and then Get_Attribute_Id (Chars (N)) = Id
6234 then
6235 return N;
6236 else
6237 Next_Rep_Item (N);
6238 end if;
6239 end loop;
6240
6241 return Empty;
6242 end Get_Attribute_Definition_Clause;
6243
6244 -------------------
6245 -- Get_Full_View --
6246 -------------------
6247
6248 function Get_Full_View (T : Entity_Id) return Entity_Id is
6249 begin
6250 if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then
6251 return Full_View (T);
6252
6253 elsif Is_Class_Wide_Type (T)
6254 and then Ekind (Root_Type (T)) = E_Incomplete_Type
6255 and then Present (Full_View (Root_Type (T)))
6256 then
6257 return Class_Wide_Type (Full_View (Root_Type (T)));
6258
6259 else
6260 return T;
6261 end if;
6262 end Get_Full_View;
6263
6264 ----------------
6265 -- Get_Pragma --
6266 ----------------
6267
6268 function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is
6269 Is_CDG : constant Boolean :=
6270 Id = Pragma_Depends or else Id = Pragma_Global;
6271 Is_CTC : constant Boolean :=
6272 Id = Pragma_Contract_Cases or else Id = Pragma_Test_Case;
6273 Is_PPC : constant Boolean :=
6274 Id = Pragma_Precondition or else Id = Pragma_Postcondition;
6275 Delayed : constant Boolean := Is_CDG or Is_CTC or Is_PPC;
6276 Item : Node_Id;
6277 Items : Node_Id;
6278
6279 begin
6280 -- Handle delayed pragmas that appear in N_Contract nodes. Those have to
6281 -- be extracted from their specialized list.
6282
6283 if Delayed then
6284 Items := Contract (E);
6285
6286 if No (Items) then
6287 return Empty;
6288
6289 elsif Is_CDG then
6290 Item := Classifications (Items);
6291
6292 elsif Is_CTC then
6293 Item := Contract_Test_Cases (Items);
6294
6295 else
6296 Item := Pre_Post_Conditions (Items);
6297 end if;
6298
6299 -- Regular pragmas
6300
6301 else
6302 Item := First_Rep_Item (E);
6303 end if;
6304
6305 while Present (Item) loop
6306 if Nkind (Item) = N_Pragma
6307 and then Get_Pragma_Id (Pragma_Name (Item)) = Id
6308 then
6309 return Item;
6310
6311 -- All nodes in N_Contract are chained using Next_Pragma
6312
6313 elsif Delayed then
6314 Item := Next_Pragma (Item);
6315
6316 -- Regular pragmas
6317
6318 else
6319 Next_Rep_Item (Item);
6320 end if;
6321 end loop;
6322
6323 return Empty;
6324 end Get_Pragma;
6325
6326 --------------------------------------
6327 -- Get_Record_Representation_Clause --
6328 --------------------------------------
6329
6330 function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id is
6331 N : Node_Id;
6332
6333 begin
6334 N := First_Rep_Item (E);
6335 while Present (N) loop
6336 if Nkind (N) = N_Record_Representation_Clause then
6337 return N;
6338 end if;
6339
6340 Next_Rep_Item (N);
6341 end loop;
6342
6343 return Empty;
6344 end Get_Record_Representation_Clause;
6345
6346 ------------------------
6347 -- Has_Attach_Handler --
6348 ------------------------
6349
6350 function Has_Attach_Handler (Id : E) return B is
6351 Ritem : Node_Id;
6352
6353 begin
6354 pragma Assert (Is_Protected_Type (Id));
6355
6356 Ritem := First_Rep_Item (Id);
6357 while Present (Ritem) loop
6358 if Nkind (Ritem) = N_Pragma
6359 and then Pragma_Name (Ritem) = Name_Attach_Handler
6360 then
6361 return True;
6362 else
6363 Next_Rep_Item (Ritem);
6364 end if;
6365 end loop;
6366
6367 return False;
6368 end Has_Attach_Handler;
6369
6370 -----------------
6371 -- Has_Entries --
6372 -----------------
6373
6374 function Has_Entries (Id : E) return B is
6375 Ent : Entity_Id;
6376
6377 begin
6378 pragma Assert (Is_Concurrent_Type (Id));
6379
6380 Ent := First_Entity (Id);
6381 while Present (Ent) loop
6382 if Is_Entry (Ent) then
6383 return True;
6384 end if;
6385
6386 Ent := Next_Entity (Ent);
6387 end loop;
6388
6389 return False;
6390 end Has_Entries;
6391
6392 ----------------------------
6393 -- Has_Foreign_Convention --
6394 ----------------------------
6395
6396 function Has_Foreign_Convention (Id : E) return B is
6397 begin
6398 -- While regular Intrinsics such as the Standard operators fit in the
6399 -- "Ada" convention, those with an Interface_Name materialize GCC
6400 -- builtin imports for which Ada special treatments shouldn't apply.
6401
6402 return Convention (Id) in Foreign_Convention
6403 or else (Convention (Id) = Convention_Intrinsic
6404 and then Present (Interface_Name (Id)));
6405 end Has_Foreign_Convention;
6406
6407 ---------------------------
6408 -- Has_Interrupt_Handler --
6409 ---------------------------
6410
6411 function Has_Interrupt_Handler (Id : E) return B is
6412 Ritem : Node_Id;
6413
6414 begin
6415 pragma Assert (Is_Protected_Type (Id));
6416
6417 Ritem := First_Rep_Item (Id);
6418 while Present (Ritem) loop
6419 if Nkind (Ritem) = N_Pragma
6420 and then Pragma_Name (Ritem) = Name_Interrupt_Handler
6421 then
6422 return True;
6423 else
6424 Next_Rep_Item (Ritem);
6425 end if;
6426 end loop;
6427
6428 return False;
6429 end Has_Interrupt_Handler;
6430
6431 -----------------------------
6432 -- Has_Null_Abstract_State --
6433 -----------------------------
6434
6435 function Has_Null_Abstract_State (Id : E) return B is
6436 begin
6437 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
6438
6439 return
6440 Present (Abstract_States (Id))
6441 and then Is_Null_State (Node (First_Elmt (Abstract_States (Id))));
6442 end Has_Null_Abstract_State;
6443
6444 --------------------
6445 -- Has_Unmodified --
6446 --------------------
6447
6448 function Has_Unmodified (E : Entity_Id) return Boolean is
6449 begin
6450 if Has_Pragma_Unmodified (E) then
6451 return True;
6452 elsif Warnings_Off (E) then
6453 Set_Warnings_Off_Used_Unmodified (E);
6454 return True;
6455 else
6456 return False;
6457 end if;
6458 end Has_Unmodified;
6459
6460 ---------------------
6461 -- Has_Unreferenced --
6462 ---------------------
6463
6464 function Has_Unreferenced (E : Entity_Id) return Boolean is
6465 begin
6466 if Has_Pragma_Unreferenced (E) then
6467 return True;
6468 elsif Warnings_Off (E) then
6469 Set_Warnings_Off_Used_Unreferenced (E);
6470 return True;
6471 else
6472 return False;
6473 end if;
6474 end Has_Unreferenced;
6475
6476 ----------------------
6477 -- Has_Warnings_Off --
6478 ----------------------
6479
6480 function Has_Warnings_Off (E : Entity_Id) return Boolean is
6481 begin
6482 if Warnings_Off (E) then
6483 Set_Warnings_Off_Used (E);
6484 return True;
6485 else
6486 return False;
6487 end if;
6488 end Has_Warnings_Off;
6489
6490 ------------------------------
6491 -- Implementation_Base_Type --
6492 ------------------------------
6493
6494 function Implementation_Base_Type (Id : E) return E is
6495 Bastyp : Entity_Id;
6496 Imptyp : Entity_Id;
6497
6498 begin
6499 Bastyp := Base_Type (Id);
6500
6501 if Is_Incomplete_Or_Private_Type (Bastyp) then
6502 Imptyp := Underlying_Type (Bastyp);
6503
6504 -- If we have an implementation type, then just return it,
6505 -- otherwise we return the Base_Type anyway. This can only
6506 -- happen in error situations and should avoid some error bombs.
6507
6508 if Present (Imptyp) then
6509 return Base_Type (Imptyp);
6510 else
6511 return Bastyp;
6512 end if;
6513
6514 else
6515 return Bastyp;
6516 end if;
6517 end Implementation_Base_Type;
6518
6519 -------------------------
6520 -- Invariant_Procedure --
6521 -------------------------
6522
6523 function Invariant_Procedure (Id : E) return E is
6524 S : Entity_Id;
6525
6526 begin
6527 pragma Assert (Is_Type (Id) and then Has_Invariants (Id));
6528
6529 if No (Subprograms_For_Type (Id)) then
6530 return Empty;
6531
6532 else
6533 S := Subprograms_For_Type (Id);
6534 while Present (S) loop
6535 if Is_Invariant_Procedure (S) then
6536 return S;
6537 else
6538 S := Subprograms_For_Type (S);
6539 end if;
6540 end loop;
6541
6542 return Empty;
6543 end if;
6544 end Invariant_Procedure;
6545
6546 ------------------
6547 -- Is_Base_Type --
6548 ------------------
6549
6550 -- Global flag table allowing rapid computation of this function
6551
6552 Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean :=
6553 (E_Enumeration_Subtype |
6554 E_Incomplete_Type |
6555 E_Signed_Integer_Subtype |
6556 E_Modular_Integer_Subtype |
6557 E_Floating_Point_Subtype |
6558 E_Ordinary_Fixed_Point_Subtype |
6559 E_Decimal_Fixed_Point_Subtype |
6560 E_Array_Subtype |
6561 E_String_Subtype |
6562 E_Record_Subtype |
6563 E_Private_Subtype |
6564 E_Record_Subtype_With_Private |
6565 E_Limited_Private_Subtype |
6566 E_Access_Subtype |
6567 E_Protected_Subtype |
6568 E_Task_Subtype |
6569 E_String_Literal_Subtype |
6570 E_Class_Wide_Subtype => False,
6571 others => True);
6572
6573 function Is_Base_Type (Id : E) return Boolean is
6574 begin
6575 return Entity_Is_Base_Type (Ekind (Id));
6576 end Is_Base_Type;
6577
6578 ---------------------
6579 -- Is_Boolean_Type --
6580 ---------------------
6581
6582 function Is_Boolean_Type (Id : E) return B is
6583 begin
6584 return Root_Type (Id) = Standard_Boolean;
6585 end Is_Boolean_Type;
6586
6587 ------------------------
6588 -- Is_Constant_Object --
6589 ------------------------
6590
6591 function Is_Constant_Object (Id : E) return B is
6592 K : constant Entity_Kind := Ekind (Id);
6593 begin
6594 return
6595 K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
6596 end Is_Constant_Object;
6597
6598 --------------------
6599 -- Is_Discriminal --
6600 --------------------
6601
6602 function Is_Discriminal (Id : E) return B is
6603 begin
6604 return (Ekind_In (Id, E_Constant, E_In_Parameter)
6605 and then Present (Discriminal_Link (Id)));
6606 end Is_Discriminal;
6607
6608 ----------------------
6609 -- Is_Dynamic_Scope --
6610 ----------------------
6611
6612 function Is_Dynamic_Scope (Id : E) return B is
6613 begin
6614 return
6615 Ekind (Id) = E_Block
6616 or else
6617 Ekind (Id) = E_Function
6618 or else
6619 Ekind (Id) = E_Procedure
6620 or else
6621 Ekind (Id) = E_Subprogram_Body
6622 or else
6623 Ekind (Id) = E_Task_Type
6624 or else
6625 (Ekind (Id) = E_Limited_Private_Type
6626 and then Present (Full_View (Id))
6627 and then Ekind (Full_View (Id)) = E_Task_Type)
6628 or else
6629 Ekind (Id) = E_Entry
6630 or else
6631 Ekind (Id) = E_Entry_Family
6632 or else
6633 Ekind (Id) = E_Return_Statement;
6634 end Is_Dynamic_Scope;
6635
6636 --------------------
6637 -- Is_Entity_Name --
6638 --------------------
6639
6640 function Is_Entity_Name (N : Node_Id) return Boolean is
6641 Kind : constant Node_Kind := Nkind (N);
6642
6643 begin
6644 -- Identifiers, operator symbols, expanded names are entity names
6645
6646 return Kind = N_Identifier
6647 or else Kind = N_Operator_Symbol
6648 or else Kind = N_Expanded_Name
6649
6650 -- Attribute references are entity names if they refer to an entity.
6651 -- Note that we don't do this by testing for the presence of the
6652 -- Entity field in the N_Attribute_Reference node, since it may not
6653 -- have been set yet.
6654
6655 or else (Kind = N_Attribute_Reference
6656 and then Is_Entity_Attribute_Name (Attribute_Name (N)));
6657 end Is_Entity_Name;
6658
6659 -----------------------
6660 -- Is_External_State --
6661 -----------------------
6662
6663 function Is_External_State (Id : E) return B is
6664 begin
6665 return
6666 Ekind (Id) = E_Abstract_State and then Has_Option (Id, Name_External);
6667 end Is_External_State;
6668
6669 ------------------
6670 -- Is_Finalizer --
6671 ------------------
6672
6673 function Is_Finalizer (Id : E) return B is
6674 begin
6675 return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer;
6676 end Is_Finalizer;
6677
6678 ---------------------
6679 -- Is_Ghost_Entity --
6680 ---------------------
6681
6682 function Is_Ghost_Entity (Id : E) return B is
6683 begin
6684 if Present (Id) and then Ekind (Id) = E_Variable then
6685 return Convention (Id) = Convention_Ghost;
6686 else
6687 return Is_Ghost_Subprogram (Id);
6688 end if;
6689 end Is_Ghost_Entity;
6690
6691 -------------------------
6692 -- Is_Ghost_Subprogram --
6693 -------------------------
6694
6695 function Is_Ghost_Subprogram (Id : E) return B is
6696 begin
6697 if Present (Id) and then Ekind_In (Id, E_Function, E_Procedure) then
6698 return Convention (Id) = Convention_Ghost;
6699 else
6700 return False;
6701 end if;
6702 end Is_Ghost_Subprogram;
6703
6704 -------------------------
6705 -- Is_Input_Only_State --
6706 -------------------------
6707
6708 function Is_Input_Only_State (Id : E) return B is
6709 begin
6710 return
6711 Ekind (Id) = E_Abstract_State
6712 and then Has_Option (Id, Name_Input_Only);
6713 end Is_Input_Only_State;
6714
6715 -------------------
6716 -- Is_Null_State --
6717 -------------------
6718
6719 function Is_Null_State (Id : E) return B is
6720 begin
6721 return
6722 Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null;
6723 end Is_Null_State;
6724
6725 ---------------------
6726 -- Is_Output_State --
6727 ---------------------
6728
6729 function Is_Output_Only_State (Id : E) return B is
6730 begin
6731 return
6732 Ekind (Id) = E_Abstract_State
6733 and then Has_Option (Id, Name_Output_Only);
6734 end Is_Output_Only_State;
6735
6736 -----------------------------------
6737 -- Is_Package_Or_Generic_Package --
6738 -----------------------------------
6739
6740 function Is_Package_Or_Generic_Package (Id : E) return B is
6741 begin
6742 return Ekind_In (Id, E_Generic_Package, E_Package);
6743 end Is_Package_Or_Generic_Package;
6744
6745 ---------------
6746 -- Is_Prival --
6747 ---------------
6748
6749 function Is_Prival (Id : E) return B is
6750 begin
6751 return (Ekind_In (Id, E_Constant, E_Variable)
6752 and then Present (Prival_Link (Id)));
6753 end Is_Prival;
6754
6755 ----------------------------
6756 -- Is_Protected_Component --
6757 ----------------------------
6758
6759 function Is_Protected_Component (Id : E) return B is
6760 begin
6761 return Ekind (Id) = E_Component and then Is_Protected_Type (Scope (Id));
6762 end Is_Protected_Component;
6763
6764 ----------------------------
6765 -- Is_Protected_Interface --
6766 ----------------------------
6767
6768 function Is_Protected_Interface (Id : E) return B is
6769 Typ : constant Entity_Id := Base_Type (Id);
6770 begin
6771 if not Is_Interface (Typ) then
6772 return False;
6773 elsif Is_Class_Wide_Type (Typ) then
6774 return Is_Protected_Interface (Etype (Typ));
6775 else
6776 return Protected_Present (Type_Definition (Parent (Typ)));
6777 end if;
6778 end Is_Protected_Interface;
6779
6780 ------------------------------
6781 -- Is_Protected_Record_Type --
6782 ------------------------------
6783
6784 function Is_Protected_Record_Type (Id : E) return B is
6785 begin
6786 return
6787 Is_Concurrent_Record_Type (Id)
6788 and then Is_Protected_Type (Corresponding_Concurrent_Type (Id));
6789 end Is_Protected_Record_Type;
6790
6791 --------------------------------
6792 -- Is_Standard_Character_Type --
6793 --------------------------------
6794
6795 function Is_Standard_Character_Type (Id : E) return B is
6796 begin
6797 if Is_Type (Id) then
6798 declare
6799 R : constant Entity_Id := Root_Type (Id);
6800 begin
6801 return
6802 R = Standard_Character
6803 or else
6804 R = Standard_Wide_Character
6805 or else
6806 R = Standard_Wide_Wide_Character;
6807 end;
6808
6809 else
6810 return False;
6811 end if;
6812 end Is_Standard_Character_Type;
6813
6814 --------------------
6815 -- Is_String_Type --
6816 --------------------
6817
6818 function Is_String_Type (Id : E) return B is
6819 begin
6820 return Ekind (Id) in String_Kind
6821 or else (Is_Array_Type (Id)
6822 and then Id /= Any_Composite
6823 and then Number_Dimensions (Id) = 1
6824 and then Is_Character_Type (Component_Type (Id)));
6825 end Is_String_Type;
6826
6827 -------------------------------
6828 -- Is_Synchronized_Interface --
6829 -------------------------------
6830
6831 function Is_Synchronized_Interface (Id : E) return B is
6832 Typ : constant Entity_Id := Base_Type (Id);
6833
6834 begin
6835 if not Is_Interface (Typ) then
6836 return False;
6837
6838 elsif Is_Class_Wide_Type (Typ) then
6839 return Is_Synchronized_Interface (Etype (Typ));
6840
6841 else
6842 return Protected_Present (Type_Definition (Parent (Typ)))
6843 or else Synchronized_Present (Type_Definition (Parent (Typ)))
6844 or else Task_Present (Type_Definition (Parent (Typ)));
6845 end if;
6846 end Is_Synchronized_Interface;
6847
6848 -----------------------
6849 -- Is_Task_Interface --
6850 -----------------------
6851
6852 function Is_Task_Interface (Id : E) return B is
6853 Typ : constant Entity_Id := Base_Type (Id);
6854 begin
6855 if not Is_Interface (Typ) then
6856 return False;
6857 elsif Is_Class_Wide_Type (Typ) then
6858 return Is_Task_Interface (Etype (Typ));
6859 else
6860 return Task_Present (Type_Definition (Parent (Typ)));
6861 end if;
6862 end Is_Task_Interface;
6863
6864 -------------------------
6865 -- Is_Task_Record_Type --
6866 -------------------------
6867
6868 function Is_Task_Record_Type (Id : E) return B is
6869 begin
6870 return
6871 Is_Concurrent_Record_Type (Id)
6872 and then Is_Task_Type (Corresponding_Concurrent_Type (Id));
6873 end Is_Task_Record_Type;
6874
6875 -----------------------
6876 -- Is_Volatile_State --
6877 -----------------------
6878
6879 function Is_Volatile_State (Id : E) return B is
6880 begin
6881 return
6882 Ekind (Id) = E_Abstract_State
6883 and then Has_Option (Id, Name_Volatile);
6884 end Is_Volatile_State;
6885
6886 ------------------------
6887 -- Is_Wrapper_Package --
6888 ------------------------
6889
6890 function Is_Wrapper_Package (Id : E) return B is
6891 begin
6892 return (Ekind (Id) = E_Package and then Present (Related_Instance (Id)));
6893 end Is_Wrapper_Package;
6894
6895 -----------------
6896 -- Last_Formal --
6897 -----------------
6898
6899 function Last_Formal (Id : E) return E is
6900 Formal : E;
6901
6902 begin
6903 pragma Assert
6904 (Is_Overloadable (Id)
6905 or else Ekind_In (Id, E_Entry_Family,
6906 E_Subprogram_Body,
6907 E_Subprogram_Type));
6908
6909 if Ekind (Id) = E_Enumeration_Literal then
6910 return Empty;
6911
6912 else
6913 Formal := First_Formal (Id);
6914
6915 if Present (Formal) then
6916 while Present (Next_Formal (Formal)) loop
6917 Formal := Next_Formal (Formal);
6918 end loop;
6919 end if;
6920
6921 return Formal;
6922 end if;
6923 end Last_Formal;
6924
6925 function Model_Emin_Value (Id : E) return Uint is
6926 begin
6927 return Machine_Emin_Value (Id);
6928 end Model_Emin_Value;
6929
6930 -------------------------
6931 -- Model_Epsilon_Value --
6932 -------------------------
6933
6934 function Model_Epsilon_Value (Id : E) return Ureal is
6935 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
6936 begin
6937 return Radix ** (1 - Model_Mantissa_Value (Id));
6938 end Model_Epsilon_Value;
6939
6940 --------------------------
6941 -- Model_Mantissa_Value --
6942 --------------------------
6943
6944 function Model_Mantissa_Value (Id : E) return Uint is
6945 begin
6946 return Machine_Mantissa_Value (Id);
6947 end Model_Mantissa_Value;
6948
6949 -----------------------
6950 -- Model_Small_Value --
6951 -----------------------
6952
6953 function Model_Small_Value (Id : E) return Ureal is
6954 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
6955 begin
6956 return Radix ** (Model_Emin_Value (Id) - 1);
6957 end Model_Small_Value;
6958
6959 ------------------------
6960 -- Machine_Emax_Value --
6961 ------------------------
6962
6963 function Machine_Emax_Value (Id : E) return Uint is
6964 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
6965
6966 begin
6967 case Float_Rep (Id) is
6968 when IEEE_Binary =>
6969 case Digs is
6970 when 1 .. 6 => return Uint_128;
6971 when 7 .. 15 => return 2**10;
6972 when 16 .. 33 => return 2**14;
6973 when others => return No_Uint;
6974 end case;
6975
6976 when VAX_Native =>
6977 case Digs is
6978 when 1 .. 9 => return 2**7 - 1;
6979 when 10 .. 15 => return 2**10 - 1;
6980 when others => return No_Uint;
6981 end case;
6982
6983 when AAMP =>
6984 return Uint_2 ** Uint_7 - Uint_1;
6985 end case;
6986 end Machine_Emax_Value;
6987
6988 ------------------------
6989 -- Machine_Emin_Value --
6990 ------------------------
6991
6992 function Machine_Emin_Value (Id : E) return Uint is
6993 begin
6994 case Float_Rep (Id) is
6995 when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id);
6996 when VAX_Native => return -Machine_Emax_Value (Id);
6997 when AAMP => return -Machine_Emax_Value (Id);
6998 end case;
6999 end Machine_Emin_Value;
7000
7001 ----------------------------
7002 -- Machine_Mantissa_Value --
7003 ----------------------------
7004
7005 function Machine_Mantissa_Value (Id : E) return Uint is
7006 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
7007
7008 begin
7009 case Float_Rep (Id) is
7010 when IEEE_Binary =>
7011 case Digs is
7012 when 1 .. 6 => return Uint_24;
7013 when 7 .. 15 => return UI_From_Int (53);
7014 when 16 .. 18 => return Uint_64;
7015 when 19 .. 33 => return UI_From_Int (113);
7016 when others => return No_Uint;
7017 end case;
7018
7019 when VAX_Native =>
7020 case Digs is
7021 when 1 .. 6 => return Uint_24;
7022 when 7 .. 9 => return UI_From_Int (56);
7023 when 10 .. 15 => return UI_From_Int (53);
7024 when others => return No_Uint;
7025 end case;
7026
7027 when AAMP =>
7028 case Digs is
7029 when 1 .. 6 => return Uint_24;
7030 when 7 .. 9 => return UI_From_Int (40);
7031 when others => return No_Uint;
7032 end case;
7033 end case;
7034 end Machine_Mantissa_Value;
7035
7036 -------------------------
7037 -- Machine_Radix_Value --
7038 -------------------------
7039
7040 function Machine_Radix_Value (Id : E) return U is
7041 begin
7042 case Float_Rep (Id) is
7043 when IEEE_Binary | VAX_Native | AAMP =>
7044 return Uint_2;
7045 end case;
7046 end Machine_Radix_Value;
7047
7048 --------------------
7049 -- Next_Component --
7050 --------------------
7051
7052 function Next_Component (Id : E) return E is
7053 Comp_Id : E;
7054
7055 begin
7056 Comp_Id := Next_Entity (Id);
7057 while Present (Comp_Id) loop
7058 exit when Ekind (Comp_Id) = E_Component;
7059 Comp_Id := Next_Entity (Comp_Id);
7060 end loop;
7061
7062 return Comp_Id;
7063 end Next_Component;
7064
7065 ------------------------------------
7066 -- Next_Component_Or_Discriminant --
7067 ------------------------------------
7068
7069 function Next_Component_Or_Discriminant (Id : E) return E is
7070 Comp_Id : E;
7071
7072 begin
7073 Comp_Id := Next_Entity (Id);
7074 while Present (Comp_Id) loop
7075 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
7076 Comp_Id := Next_Entity (Comp_Id);
7077 end loop;
7078
7079 return Comp_Id;
7080 end Next_Component_Or_Discriminant;
7081
7082 -----------------------
7083 -- Next_Discriminant --
7084 -----------------------
7085
7086 -- This function actually implements both Next_Discriminant and
7087 -- Next_Stored_Discriminant by making sure that the Discriminant
7088 -- returned is of the same variety as Id.
7089
7090 function Next_Discriminant (Id : E) return E is
7091
7092 -- Derived Tagged types with private extensions look like this...
7093
7094 -- E_Discriminant d1
7095 -- E_Discriminant d2
7096 -- E_Component _tag
7097 -- E_Discriminant d1
7098 -- E_Discriminant d2
7099 -- ...
7100
7101 -- so it is critical not to go past the leading discriminants
7102
7103 D : E := Id;
7104
7105 begin
7106 pragma Assert (Ekind (Id) = E_Discriminant);
7107
7108 loop
7109 D := Next_Entity (D);
7110 if No (D)
7111 or else (Ekind (D) /= E_Discriminant
7112 and then not Is_Itype (D))
7113 then
7114 return Empty;
7115 end if;
7116
7117 exit when Ekind (D) = E_Discriminant
7118 and then (Is_Completely_Hidden (D) = Is_Completely_Hidden (Id));
7119 end loop;
7120
7121 return D;
7122 end Next_Discriminant;
7123
7124 -----------------
7125 -- Next_Formal --
7126 -----------------
7127
7128 function Next_Formal (Id : E) return E is
7129 P : E;
7130
7131 begin
7132 -- Follow the chain of declared entities as long as the kind of the
7133 -- entity corresponds to a formal parameter. Skip internal entities
7134 -- that may have been created for implicit subtypes, in the process
7135 -- of analyzing default expressions.
7136
7137 P := Id;
7138 loop
7139 P := Next_Entity (P);
7140
7141 if No (P) or else Is_Formal (P) then
7142 return P;
7143 elsif not Is_Internal (P) then
7144 return Empty;
7145 end if;
7146 end loop;
7147 end Next_Formal;
7148
7149 -----------------------------
7150 -- Next_Formal_With_Extras --
7151 -----------------------------
7152
7153 function Next_Formal_With_Extras (Id : E) return E is
7154 begin
7155 if Present (Extra_Formal (Id)) then
7156 return Extra_Formal (Id);
7157 else
7158 return Next_Formal (Id);
7159 end if;
7160 end Next_Formal_With_Extras;
7161
7162 ----------------
7163 -- Next_Index --
7164 ----------------
7165
7166 function Next_Index (Id : Node_Id) return Node_Id is
7167 begin
7168 return Next (Id);
7169 end Next_Index;
7170
7171 ------------------
7172 -- Next_Literal --
7173 ------------------
7174
7175 function Next_Literal (Id : E) return E is
7176 begin
7177 pragma Assert (Nkind (Id) in N_Entity);
7178 return Next (Id);
7179 end Next_Literal;
7180
7181 ------------------------------
7182 -- Next_Stored_Discriminant --
7183 ------------------------------
7184
7185 function Next_Stored_Discriminant (Id : E) return E is
7186 begin
7187 -- See comment in Next_Discriminant
7188
7189 return Next_Discriminant (Id);
7190 end Next_Stored_Discriminant;
7191
7192 -----------------------
7193 -- Number_Dimensions --
7194 -----------------------
7195
7196 function Number_Dimensions (Id : E) return Pos is
7197 N : Int;
7198 T : Node_Id;
7199
7200 begin
7201 if Ekind (Id) in String_Kind then
7202 return 1;
7203
7204 else
7205 N := 0;
7206 T := First_Index (Id);
7207 while Present (T) loop
7208 N := N + 1;
7209 T := Next (T);
7210 end loop;
7211
7212 return N;
7213 end if;
7214 end Number_Dimensions;
7215
7216 --------------------
7217 -- Number_Entries --
7218 --------------------
7219
7220 function Number_Entries (Id : E) return Nat is
7221 N : Int;
7222 Ent : Entity_Id;
7223
7224 begin
7225 pragma Assert (Is_Concurrent_Type (Id));
7226
7227 N := 0;
7228 Ent := First_Entity (Id);
7229 while Present (Ent) loop
7230 if Is_Entry (Ent) then
7231 N := N + 1;
7232 end if;
7233
7234 Ent := Next_Entity (Ent);
7235 end loop;
7236
7237 return N;
7238 end Number_Entries;
7239
7240 --------------------
7241 -- Number_Formals --
7242 --------------------
7243
7244 function Number_Formals (Id : E) return Pos is
7245 N : Int;
7246 Formal : Entity_Id;
7247
7248 begin
7249 N := 0;
7250 Formal := First_Formal (Id);
7251 while Present (Formal) loop
7252 N := N + 1;
7253 Formal := Next_Formal (Formal);
7254 end loop;
7255
7256 return N;
7257 end Number_Formals;
7258
7259 --------------------
7260 -- Parameter_Mode --
7261 --------------------
7262
7263 function Parameter_Mode (Id : E) return Formal_Kind is
7264 begin
7265 return Ekind (Id);
7266 end Parameter_Mode;
7267
7268 ------------------------
7269 -- Predicate_Function --
7270 ------------------------
7271
7272 function Predicate_Function (Id : E) return E is
7273 S : Entity_Id;
7274 T : Entity_Id;
7275
7276 begin
7277 pragma Assert (Is_Type (Id));
7278
7279 -- If type is private and has a completion, predicate may be defined
7280 -- on the full view.
7281
7282 if Is_Private_Type (Id) and then Present (Full_View (Id)) then
7283 T := Full_View (Id);
7284 else
7285 T := Id;
7286 end if;
7287
7288 if No (Subprograms_For_Type (T)) then
7289 return Empty;
7290
7291 else
7292 S := Subprograms_For_Type (T);
7293 while Present (S) loop
7294 if Is_Predicate_Function (S) then
7295 return S;
7296 else
7297 S := Subprograms_For_Type (S);
7298 end if;
7299 end loop;
7300
7301 return Empty;
7302 end if;
7303 end Predicate_Function;
7304
7305 --------------------------
7306 -- Predicate_Function_M --
7307 --------------------------
7308
7309 function Predicate_Function_M (Id : E) return E is
7310 S : Entity_Id;
7311 T : Entity_Id;
7312
7313 begin
7314 pragma Assert (Is_Type (Id));
7315
7316 -- If type is private and has a completion, predicate may be defined
7317 -- on the full view.
7318
7319 if Is_Private_Type (Id) and then Present (Full_View (Id)) then
7320 T := Full_View (Id);
7321 else
7322 T := Id;
7323 end if;
7324
7325 if No (Subprograms_For_Type (T)) then
7326 return Empty;
7327
7328 else
7329 S := Subprograms_For_Type (T);
7330 while Present (S) loop
7331 if Is_Predicate_Function_M (S) then
7332 return S;
7333 else
7334 S := Subprograms_For_Type (S);
7335 end if;
7336 end loop;
7337
7338 return Empty;
7339 end if;
7340 end Predicate_Function_M;
7341
7342 -------------------------
7343 -- Present_In_Rep_Item --
7344 -------------------------
7345
7346 function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean is
7347 Ritem : Node_Id;
7348
7349 begin
7350 Ritem := First_Rep_Item (E);
7351
7352 while Present (Ritem) loop
7353 if Ritem = N then
7354 return True;
7355 end if;
7356
7357 Next_Rep_Item (Ritem);
7358 end loop;
7359
7360 return False;
7361 end Present_In_Rep_Item;
7362
7363 --------------------------
7364 -- Primitive_Operations --
7365 --------------------------
7366
7367 function Primitive_Operations (Id : E) return L is
7368 begin
7369 if Is_Concurrent_Type (Id) then
7370 if Present (Corresponding_Record_Type (Id)) then
7371 return Direct_Primitive_Operations
7372 (Corresponding_Record_Type (Id));
7373
7374 -- If expansion is disabled the corresponding record type is absent,
7375 -- but if the type has ancestors it may have primitive operations.
7376
7377 elsif Is_Tagged_Type (Id) then
7378 return Direct_Primitive_Operations (Id);
7379
7380 else
7381 return No_Elist;
7382 end if;
7383 else
7384 return Direct_Primitive_Operations (Id);
7385 end if;
7386 end Primitive_Operations;
7387
7388 ---------------------
7389 -- Record_Rep_Item --
7390 ---------------------
7391
7392 procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is
7393 begin
7394 Set_Next_Rep_Item (N, First_Rep_Item (E));
7395 Set_First_Rep_Item (E, N);
7396 end Record_Rep_Item;
7397
7398 ---------------
7399 -- Root_Type --
7400 ---------------
7401
7402 function Root_Type (Id : E) return E is
7403 T, Etyp : E;
7404
7405 begin
7406 pragma Assert (Nkind (Id) in N_Entity);
7407
7408 T := Base_Type (Id);
7409
7410 if Ekind (T) = E_Class_Wide_Type then
7411 return Etype (T);
7412
7413 -- Other cases
7414
7415 else
7416 loop
7417 Etyp := Etype (T);
7418
7419 if T = Etyp then
7420 return T;
7421
7422 -- Following test catches some error cases resulting from
7423 -- previous errors.
7424
7425 elsif No (Etyp) then
7426 Check_Error_Detected;
7427 return T;
7428
7429 elsif Is_Private_Type (T) and then Etyp = Full_View (T) then
7430 return T;
7431
7432 elsif Is_Private_Type (Etyp) and then Full_View (Etyp) = T then
7433 return T;
7434 end if;
7435
7436 T := Etyp;
7437
7438 -- Return if there is a circularity in the inheritance chain. This
7439 -- happens in some error situations and we do not want to get
7440 -- stuck in this loop.
7441
7442 if T = Base_Type (Id) then
7443 return T;
7444 end if;
7445 end loop;
7446 end if;
7447 end Root_Type;
7448
7449 ---------------------
7450 -- Safe_Emax_Value --
7451 ---------------------
7452
7453 function Safe_Emax_Value (Id : E) return Uint is
7454 begin
7455 return Machine_Emax_Value (Id);
7456 end Safe_Emax_Value;
7457
7458 ----------------------
7459 -- Safe_First_Value --
7460 ----------------------
7461
7462 function Safe_First_Value (Id : E) return Ureal is
7463 begin
7464 return -Safe_Last_Value (Id);
7465 end Safe_First_Value;
7466
7467 ---------------------
7468 -- Safe_Last_Value --
7469 ---------------------
7470
7471 function Safe_Last_Value (Id : E) return Ureal is
7472 Radix : constant Uint := Machine_Radix_Value (Id);
7473 Mantissa : constant Uint := Machine_Mantissa_Value (Id);
7474 Emax : constant Uint := Safe_Emax_Value (Id);
7475 Significand : constant Uint := Radix ** Mantissa - 1;
7476 Exponent : constant Uint := Emax - Mantissa;
7477
7478 begin
7479 if Radix = 2 then
7480 return
7481 UR_From_Components
7482 (Num => Significand * 2 ** (Exponent mod 4),
7483 Den => -Exponent / 4,
7484 Rbase => 16);
7485
7486 else
7487 return
7488 UR_From_Components
7489 (Num => Significand,
7490 Den => -Exponent,
7491 Rbase => 16);
7492 end if;
7493 end Safe_Last_Value;
7494
7495 -----------------
7496 -- Scope_Depth --
7497 -----------------
7498
7499 function Scope_Depth (Id : E) return Uint is
7500 Scop : Entity_Id;
7501
7502 begin
7503 Scop := Id;
7504 while Is_Record_Type (Scop) loop
7505 Scop := Scope (Scop);
7506 end loop;
7507
7508 return Scope_Depth_Value (Scop);
7509 end Scope_Depth;
7510
7511 ---------------------
7512 -- Scope_Depth_Set --
7513 ---------------------
7514
7515 function Scope_Depth_Set (Id : E) return B is
7516 begin
7517 return not Is_Record_Type (Id)
7518 and then Field22 (Id) /= Union_Id (Empty);
7519 end Scope_Depth_Set;
7520
7521 -----------------------------
7522 -- Set_Component_Alignment --
7523 -----------------------------
7524
7525 -- Component Alignment is encoded using two flags, Flag128/129 as
7526 -- follows. Note that both flags False = Align_Default, so that the
7527 -- default initialization of flags to False initializes component
7528 -- alignment to the default value as required.
7529
7530 -- Flag128 Flag129 Value
7531 -- ------- ------- -----
7532 -- False False Calign_Default
7533 -- False True Calign_Component_Size
7534 -- True False Calign_Component_Size_4
7535 -- True True Calign_Storage_Unit
7536
7537 procedure Set_Component_Alignment (Id : E; V : C) is
7538 begin
7539 pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
7540 and then Is_Base_Type (Id));
7541
7542 case V is
7543 when Calign_Default =>
7544 Set_Flag128 (Id, False);
7545 Set_Flag129 (Id, False);
7546
7547 when Calign_Component_Size =>
7548 Set_Flag128 (Id, False);
7549 Set_Flag129 (Id, True);
7550
7551 when Calign_Component_Size_4 =>
7552 Set_Flag128 (Id, True);
7553 Set_Flag129 (Id, False);
7554
7555 when Calign_Storage_Unit =>
7556 Set_Flag128 (Id, True);
7557 Set_Flag129 (Id, True);
7558 end case;
7559 end Set_Component_Alignment;
7560
7561 -----------------------------
7562 -- Set_Invariant_Procedure --
7563 -----------------------------
7564
7565 procedure Set_Invariant_Procedure (Id : E; V : E) is
7566 S : Entity_Id;
7567
7568 begin
7569 pragma Assert (Is_Type (Id) and then Has_Invariants (Id));
7570
7571 S := Subprograms_For_Type (Id);
7572 Set_Subprograms_For_Type (Id, V);
7573 Set_Subprograms_For_Type (V, S);
7574
7575 -- Check for duplicate entry
7576
7577 while Present (S) loop
7578 if Is_Invariant_Procedure (S) then
7579 raise Program_Error;
7580 else
7581 S := Subprograms_For_Type (S);
7582 end if;
7583 end loop;
7584 end Set_Invariant_Procedure;
7585
7586 ----------------------------
7587 -- Set_Predicate_Function --
7588 ----------------------------
7589
7590 procedure Set_Predicate_Function (Id : E; V : E) is
7591 S : Entity_Id;
7592
7593 begin
7594 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
7595
7596 S := Subprograms_For_Type (Id);
7597 Set_Subprograms_For_Type (Id, V);
7598 Set_Subprograms_For_Type (V, S);
7599
7600 while Present (S) loop
7601 if Is_Predicate_Function (S) then
7602 raise Program_Error;
7603 else
7604 S := Subprograms_For_Type (S);
7605 end if;
7606 end loop;
7607 end Set_Predicate_Function;
7608
7609 ------------------------------
7610 -- Set_Predicate_Function_M --
7611 ------------------------------
7612
7613 procedure Set_Predicate_Function_M (Id : E; V : E) is
7614 S : Entity_Id;
7615
7616 begin
7617 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
7618
7619 S := Subprograms_For_Type (Id);
7620 Set_Subprograms_For_Type (Id, V);
7621 Set_Subprograms_For_Type (V, S);
7622
7623 -- Check for duplicates
7624
7625 while Present (S) loop
7626 if Is_Predicate_Function_M (S) then
7627 raise Program_Error;
7628 else
7629 S := Subprograms_For_Type (S);
7630 end if;
7631 end loop;
7632 end Set_Predicate_Function_M;
7633
7634 -----------------
7635 -- Size_Clause --
7636 -----------------
7637
7638 function Size_Clause (Id : E) return N is
7639 begin
7640 return Get_Attribute_Definition_Clause (Id, Attribute_Size);
7641 end Size_Clause;
7642
7643 ------------------------
7644 -- Stream_Size_Clause --
7645 ------------------------
7646
7647 function Stream_Size_Clause (Id : E) return N is
7648 begin
7649 return Get_Attribute_Definition_Clause (Id, Attribute_Stream_Size);
7650 end Stream_Size_Clause;
7651
7652 ------------------
7653 -- Subtype_Kind --
7654 ------------------
7655
7656 function Subtype_Kind (K : Entity_Kind) return Entity_Kind is
7657 Kind : Entity_Kind;
7658
7659 begin
7660 case K is
7661 when Access_Kind =>
7662 Kind := E_Access_Subtype;
7663
7664 when E_Array_Type |
7665 E_Array_Subtype =>
7666 Kind := E_Array_Subtype;
7667
7668 when E_Class_Wide_Type |
7669 E_Class_Wide_Subtype =>
7670 Kind := E_Class_Wide_Subtype;
7671
7672 when E_Decimal_Fixed_Point_Type |
7673 E_Decimal_Fixed_Point_Subtype =>
7674 Kind := E_Decimal_Fixed_Point_Subtype;
7675
7676 when E_Ordinary_Fixed_Point_Type |
7677 E_Ordinary_Fixed_Point_Subtype =>
7678 Kind := E_Ordinary_Fixed_Point_Subtype;
7679
7680 when E_Private_Type |
7681 E_Private_Subtype =>
7682 Kind := E_Private_Subtype;
7683
7684 when E_Limited_Private_Type |
7685 E_Limited_Private_Subtype =>
7686 Kind := E_Limited_Private_Subtype;
7687
7688 when E_Record_Type_With_Private |
7689 E_Record_Subtype_With_Private =>
7690 Kind := E_Record_Subtype_With_Private;
7691
7692 when E_Record_Type |
7693 E_Record_Subtype =>
7694 Kind := E_Record_Subtype;
7695
7696 when E_String_Type |
7697 E_String_Subtype =>
7698 Kind := E_String_Subtype;
7699
7700 when Enumeration_Kind =>
7701 Kind := E_Enumeration_Subtype;
7702
7703 when Float_Kind =>
7704 Kind := E_Floating_Point_Subtype;
7705
7706 when Signed_Integer_Kind =>
7707 Kind := E_Signed_Integer_Subtype;
7708
7709 when Modular_Integer_Kind =>
7710 Kind := E_Modular_Integer_Subtype;
7711
7712 when Protected_Kind =>
7713 Kind := E_Protected_Subtype;
7714
7715 when Task_Kind =>
7716 Kind := E_Task_Subtype;
7717
7718 when others =>
7719 Kind := E_Void;
7720 raise Program_Error;
7721 end case;
7722
7723 return Kind;
7724 end Subtype_Kind;
7725
7726 ---------------------
7727 -- Type_High_Bound --
7728 ---------------------
7729
7730 function Type_High_Bound (Id : E) return Node_Id is
7731 Rng : constant Node_Id := Scalar_Range (Id);
7732 begin
7733 if Nkind (Rng) = N_Subtype_Indication then
7734 return High_Bound (Range_Expression (Constraint (Rng)));
7735 else
7736 return High_Bound (Rng);
7737 end if;
7738 end Type_High_Bound;
7739
7740 --------------------
7741 -- Type_Low_Bound --
7742 --------------------
7743
7744 function Type_Low_Bound (Id : E) return Node_Id is
7745 Rng : constant Node_Id := Scalar_Range (Id);
7746 begin
7747 if Nkind (Rng) = N_Subtype_Indication then
7748 return Low_Bound (Range_Expression (Constraint (Rng)));
7749 else
7750 return Low_Bound (Rng);
7751 end if;
7752 end Type_Low_Bound;
7753
7754 ---------------------
7755 -- Underlying_Type --
7756 ---------------------
7757
7758 function Underlying_Type (Id : E) return E is
7759 begin
7760 -- For record_with_private the underlying type is always the direct
7761 -- full view. Never try to take the full view of the parent it
7762 -- doesn't make sense.
7763
7764 if Ekind (Id) = E_Record_Type_With_Private then
7765 return Full_View (Id);
7766
7767 elsif Ekind (Id) in Incomplete_Or_Private_Kind then
7768
7769 -- If we have an incomplete or private type with a full view,
7770 -- then we return the Underlying_Type of this full view
7771
7772 if Present (Full_View (Id)) then
7773 if Id = Full_View (Id) then
7774
7775 -- Previous error in declaration
7776
7777 return Empty;
7778
7779 else
7780 return Underlying_Type (Full_View (Id));
7781 end if;
7782
7783 -- If we have an incomplete entity that comes from the limited
7784 -- view then we return the Underlying_Type of its non-limited
7785 -- view.
7786
7787 elsif From_With_Type (Id)
7788 and then Present (Non_Limited_View (Id))
7789 then
7790 return Underlying_Type (Non_Limited_View (Id));
7791
7792 -- Otherwise check for the case where we have a derived type or
7793 -- subtype, and if so get the Underlying_Type of the parent type.
7794
7795 elsif Etype (Id) /= Id then
7796 return Underlying_Type (Etype (Id));
7797
7798 -- Otherwise we have an incomplete or private type that has
7799 -- no full view, which means that we have not encountered the
7800 -- completion, so return Empty to indicate the underlying type
7801 -- is not yet known.
7802
7803 else
7804 return Empty;
7805 end if;
7806
7807 -- For non-incomplete, non-private types, return the type itself
7808 -- Also for entities that are not types at all return the entity
7809 -- itself.
7810
7811 else
7812 return Id;
7813 end if;
7814 end Underlying_Type;
7815
7816 ---------------
7817 -- Vax_Float --
7818 ---------------
7819
7820 function Vax_Float (Id : E) return B is
7821 begin
7822 return Is_Floating_Point_Type (Id) and then Float_Rep (Id) = VAX_Native;
7823 end Vax_Float;
7824
7825 ------------------------
7826 -- Write_Entity_Flags --
7827 ------------------------
7828
7829 procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String) is
7830
7831 procedure W (Flag_Name : String; Flag : Boolean);
7832 -- Write out given flag if it is set
7833
7834 -------
7835 -- W --
7836 -------
7837
7838 procedure W (Flag_Name : String; Flag : Boolean) is
7839 begin
7840 if Flag then
7841 Write_Str (Prefix);
7842 Write_Str (Flag_Name);
7843 Write_Str (" = True");
7844 Write_Eol;
7845 end if;
7846 end W;
7847
7848 -- Start of processing for Write_Entity_Flags
7849
7850 begin
7851 if (Is_Array_Type (Id) or else Is_Record_Type (Id))
7852 and then Is_Base_Type (Id)
7853 then
7854 Write_Str (Prefix);
7855 Write_Str ("Component_Alignment = ");
7856
7857 case Component_Alignment (Id) is
7858 when Calign_Default =>
7859 Write_Str ("Calign_Default");
7860
7861 when Calign_Component_Size =>
7862 Write_Str ("Calign_Component_Size");
7863
7864 when Calign_Component_Size_4 =>
7865 Write_Str ("Calign_Component_Size_4");
7866
7867 when Calign_Storage_Unit =>
7868 Write_Str ("Calign_Storage_Unit");
7869 end case;
7870
7871 Write_Eol;
7872 end if;
7873
7874 W ("Address_Taken", Flag104 (Id));
7875 W ("Body_Needed_For_SAL", Flag40 (Id));
7876 W ("C_Pass_By_Copy", Flag125 (Id));
7877 W ("Can_Never_Be_Null", Flag38 (Id));
7878 W ("Checks_May_Be_Suppressed", Flag31 (Id));
7879 W ("Debug_Info_Off", Flag166 (Id));
7880 W ("Default_Expressions_Processed", Flag108 (Id));
7881 W ("Delay_Cleanups", Flag114 (Id));
7882 W ("Delay_Subprogram_Descriptors", Flag50 (Id));
7883 W ("Depends_On_Private", Flag14 (Id));
7884 W ("Discard_Names", Flag88 (Id));
7885 W ("Elaboration_Entity_Required", Flag174 (Id));
7886 W ("Elaborate_Body_Desirable", Flag210 (Id));
7887 W ("Entry_Accepted", Flag152 (Id));
7888 W ("Can_Use_Internal_Rep", Flag229 (Id));
7889 W ("Finalize_Storage_Only", Flag158 (Id));
7890 W ("From_With_Type", Flag159 (Id));
7891 W ("Has_Aliased_Components", Flag135 (Id));
7892 W ("Has_Alignment_Clause", Flag46 (Id));
7893 W ("Has_All_Calls_Remote", Flag79 (Id));
7894 W ("Has_Anonymous_Master", Flag253 (Id));
7895 W ("Has_Atomic_Components", Flag86 (Id));
7896 W ("Has_Biased_Representation", Flag139 (Id));
7897 W ("Has_Completion", Flag26 (Id));
7898 W ("Has_Completion_In_Body", Flag71 (Id));
7899 W ("Has_Complex_Representation", Flag140 (Id));
7900 W ("Has_Component_Size_Clause", Flag68 (Id));
7901 W ("Has_Contiguous_Rep", Flag181 (Id));
7902 W ("Has_Controlled_Component", Flag43 (Id));
7903 W ("Has_Controlling_Result", Flag98 (Id));
7904 W ("Has_Convention_Pragma", Flag119 (Id));
7905 W ("Has_Default_Aspect", Flag39 (Id));
7906 W ("Has_Delayed_Aspects", Flag200 (Id));
7907 W ("Has_Delayed_Freeze", Flag18 (Id));
7908 W ("Has_Delayed_Rep_Aspects", Flag261 (Id));
7909 W ("Has_Discriminants", Flag5 (Id));
7910 W ("Has_Dispatch_Table", Flag220 (Id));
7911 W ("Has_Dynamic_Predicate_Aspect", Flag258 (Id));
7912 W ("Has_Enumeration_Rep_Clause", Flag66 (Id));
7913 W ("Has_Exit", Flag47 (Id));
7914 W ("Has_External_Tag_Rep_Clause", Flag110 (Id));
7915 W ("Has_Forward_Instantiation", Flag175 (Id));
7916 W ("Has_Fully_Qualified_Name", Flag173 (Id));
7917 W ("Has_Gigi_Rep_Item", Flag82 (Id));
7918 W ("Has_Homonym", Flag56 (Id));
7919 W ("Has_Implicit_Dereference", Flag251 (Id));
7920 W ("Has_Inheritable_Invariants", Flag248 (Id));
7921 W ("Has_Initial_Value", Flag219 (Id));
7922 W ("Has_Invariants", Flag232 (Id));
7923 W ("Has_Loop_Entry_Attributes", Flag260 (Id));
7924 W ("Has_Machine_Radix_Clause", Flag83 (Id));
7925 W ("Has_Master_Entity", Flag21 (Id));
7926 W ("Has_Missing_Return", Flag142 (Id));
7927 W ("Has_Nested_Block_With_Handler", Flag101 (Id));
7928 W ("Has_Non_Standard_Rep", Flag75 (Id));
7929 W ("Has_Object_Size_Clause", Flag172 (Id));
7930 W ("Has_Per_Object_Constraint", Flag154 (Id));
7931 W ("Has_Postconditions", Flag240 (Id));
7932 W ("Has_Pragma_Controlled", Flag27 (Id));
7933 W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
7934 W ("Has_Pragma_Inline", Flag157 (Id));
7935 W ("Has_Pragma_Inline_Always", Flag230 (Id));
7936 W ("Has_Pragma_No_Inline", Flag201 (Id));
7937 W ("Has_Pragma_Ordered", Flag198 (Id));
7938 W ("Has_Pragma_Pack", Flag121 (Id));
7939 W ("Has_Pragma_Preelab_Init", Flag221 (Id));
7940 W ("Has_Pragma_Pure", Flag203 (Id));
7941 W ("Has_Pragma_Pure_Function", Flag179 (Id));
7942 W ("Has_Pragma_Thread_Local_Storage", Flag169 (Id));
7943 W ("Has_Pragma_Unmodified", Flag233 (Id));
7944 W ("Has_Pragma_Unreferenced", Flag180 (Id));
7945 W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id));
7946 W ("Has_Predicates", Flag250 (Id));
7947 W ("Has_Primitive_Operations", Flag120 (Id));
7948 W ("Has_Private_Ancestor", Flag151 (Id));
7949 W ("Has_Private_Declaration", Flag155 (Id));
7950 W ("Has_Qualified_Name", Flag161 (Id));
7951 W ("Has_RACW", Flag214 (Id));
7952 W ("Has_Record_Rep_Clause", Flag65 (Id));
7953 W ("Has_Recursive_Call", Flag143 (Id));
7954 W ("Has_Size_Clause", Flag29 (Id));
7955 W ("Has_Small_Clause", Flag67 (Id));
7956 W ("Has_Specified_Layout", Flag100 (Id));
7957 W ("Has_Specified_Stream_Input", Flag190 (Id));
7958 W ("Has_Specified_Stream_Output", Flag191 (Id));
7959 W ("Has_Specified_Stream_Read", Flag192 (Id));
7960 W ("Has_Specified_Stream_Write", Flag193 (Id));
7961 W ("Has_Static_Discriminants", Flag211 (Id));
7962 W ("Has_Static_Predicate_Aspect", Flag259 (Id));
7963 W ("Has_Storage_Size_Clause", Flag23 (Id));
7964 W ("Has_Stream_Size_Clause", Flag184 (Id));
7965 W ("Has_Task", Flag30 (Id));
7966 W ("Has_Thunks", Flag228 (Id));
7967 W ("Has_Unchecked_Union", Flag123 (Id));
7968 W ("Has_Unknown_Discriminants", Flag72 (Id));
7969 W ("Has_Up_Level_Access", Flag215 (Id));
7970 W ("Has_Volatile_Components", Flag87 (Id));
7971 W ("Has_Xref_Entry", Flag182 (Id));
7972 W ("In_Package_Body", Flag48 (Id));
7973 W ("In_Private_Part", Flag45 (Id));
7974 W ("In_Use", Flag8 (Id));
7975 W ("Is_AST_Entry", Flag132 (Id));
7976 W ("Is_Abstract_Subprogram", Flag19 (Id));
7977 W ("Is_Abstract_Type", Flag146 (Id));
7978 W ("Is_Local_Anonymous_Access", Flag194 (Id));
7979 W ("Is_Access_Constant", Flag69 (Id));
7980 W ("Is_Ada_2005_Only", Flag185 (Id));
7981 W ("Is_Ada_2012_Only", Flag199 (Id));
7982 W ("Is_Aliased", Flag15 (Id));
7983 W ("Is_Asynchronous", Flag81 (Id));
7984 W ("Is_Atomic", Flag85 (Id));
7985 W ("Is_Bit_Packed_Array", Flag122 (Id));
7986 W ("Is_CPP_Class", Flag74 (Id));
7987 W ("Is_Called", Flag102 (Id));
7988 W ("Is_Character_Type", Flag63 (Id));
7989 W ("Is_Child_Unit", Flag73 (Id));
7990 W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
7991 W ("Is_Compilation_Unit", Flag149 (Id));
7992 W ("Is_Completely_Hidden", Flag103 (Id));
7993 W ("Is_Concurrent_Record_Type", Flag20 (Id));
7994 W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id));
7995 W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
7996 W ("Is_Constrained", Flag12 (Id));
7997 W ("Is_Constructor", Flag76 (Id));
7998 W ("Is_Controlled", Flag42 (Id));
7999 W ("Is_Controlling_Formal", Flag97 (Id));
8000 W ("Is_Descendent_Of_Address", Flag223 (Id));
8001 W ("Is_Discrim_SO_Function", Flag176 (Id));
8002 W ("Is_Dispatch_Table_Entity", Flag234 (Id));
8003 W ("Is_Dispatching_Operation", Flag6 (Id));
8004 W ("Is_Eliminated", Flag124 (Id));
8005 W ("Is_Entry_Formal", Flag52 (Id));
8006 W ("Is_Exported", Flag99 (Id));
8007 W ("Is_First_Subtype", Flag70 (Id));
8008 W ("Is_For_Access_Subtype", Flag118 (Id));
8009 W ("Is_Formal_Subprogram", Flag111 (Id));
8010 W ("Is_Frozen", Flag4 (Id));
8011 W ("Is_Generic_Actual_Type", Flag94 (Id));
8012 W ("Is_Generic_Instance", Flag130 (Id));
8013 W ("Is_Generic_Type", Flag13 (Id));
8014 W ("Is_Hidden", Flag57 (Id));
8015 W ("Is_Hidden_Open_Scope", Flag171 (Id));
8016 W ("Is_Immediately_Visible", Flag7 (Id));
8017 W ("Is_Implementation_Defined", Flag254 (Id));
8018 W ("Is_Imported", Flag24 (Id));
8019 W ("Is_Inlined", Flag11 (Id));
8020 W ("Is_Instantiated", Flag126 (Id));
8021 W ("Is_Interface", Flag186 (Id));
8022 W ("Is_Internal", Flag17 (Id));
8023 W ("Is_Interrupt_Handler", Flag89 (Id));
8024 W ("Is_Intrinsic_Subprogram", Flag64 (Id));
8025 W ("Is_Invariant_Procedure", Flag257 (Id));
8026 W ("Is_Itype", Flag91 (Id));
8027 W ("Is_Known_Non_Null", Flag37 (Id));
8028 W ("Is_Known_Null", Flag204 (Id));
8029 W ("Is_Known_Valid", Flag170 (Id));
8030 W ("Is_Limited_Composite", Flag106 (Id));
8031 W ("Is_Limited_Interface", Flag197 (Id));
8032 W ("Is_Limited_Record", Flag25 (Id));
8033 W ("Is_Machine_Code_Subprogram", Flag137 (Id));
8034 W ("Is_Non_Static_Subtype", Flag109 (Id));
8035 W ("Is_Null_Init_Proc", Flag178 (Id));
8036 W ("Is_Obsolescent", Flag153 (Id));
8037 W ("Is_Only_Out_Parameter", Flag226 (Id));
8038 W ("Is_Optional_Parameter", Flag134 (Id));
8039 W ("Is_Package_Body_Entity", Flag160 (Id));
8040 W ("Is_Packed", Flag51 (Id));
8041 W ("Is_Packed_Array_Type", Flag138 (Id));
8042 W ("Is_Potentially_Use_Visible", Flag9 (Id));
8043 W ("Is_Predicate_Function", Flag255 (Id));
8044 W ("Is_Predicate_Function_M", Flag256 (Id));
8045 W ("Is_Preelaborated", Flag59 (Id));
8046 W ("Is_Primitive", Flag218 (Id));
8047 W ("Is_Primitive_Wrapper", Flag195 (Id));
8048 W ("Is_Private_Composite", Flag107 (Id));
8049 W ("Is_Private_Descendant", Flag53 (Id));
8050 W ("Is_Private_Primitive", Flag245 (Id));
8051 W ("Is_Processed_Transient", Flag252 (Id));
8052 W ("Is_Public", Flag10 (Id));
8053 W ("Is_Pure", Flag44 (Id));
8054 W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
8055 W ("Is_RACW_Stub_Type", Flag244 (Id));
8056 W ("Is_Raised", Flag224 (Id));
8057 W ("Is_Remote_Call_Interface", Flag62 (Id));
8058 W ("Is_Remote_Types", Flag61 (Id));
8059 W ("Is_Renaming_Of_Object", Flag112 (Id));
8060 W ("Is_Return_Object", Flag209 (Id));
8061 W ("Is_Safe_To_Reevaluate", Flag249 (Id));
8062 W ("Is_Shared_Passive", Flag60 (Id));
8063 W ("Is_Statically_Allocated", Flag28 (Id));
8064 W ("Is_Tag", Flag78 (Id));
8065 W ("Is_Tagged_Type", Flag55 (Id));
8066 W ("Is_Thunk", Flag225 (Id));
8067 W ("Is_Trivial_Subprogram", Flag235 (Id));
8068 W ("Is_True_Constant", Flag163 (Id));
8069 W ("Is_Unchecked_Union", Flag117 (Id));
8070 W ("Is_Underlying_Record_View", Flag246 (Id));
8071 W ("Is_Unsigned_Type", Flag144 (Id));
8072 W ("Is_VMS_Exception", Flag133 (Id));
8073 W ("Is_Valued_Procedure", Flag127 (Id));
8074 W ("Is_Visible_Formal", Flag206 (Id));
8075 W ("Is_Visible_Lib_Unit", Flag116 (Id));
8076 W ("Is_Volatile", Flag16 (Id));
8077 W ("Itype_Printed", Flag202 (Id));
8078 W ("Kill_Elaboration_Checks", Flag32 (Id));
8079 W ("Kill_Range_Checks", Flag33 (Id));
8080 W ("Known_To_Have_Preelab_Init", Flag207 (Id));
8081 W ("Low_Bound_Tested", Flag205 (Id));
8082 W ("Machine_Radix_10", Flag84 (Id));
8083 W ("Materialize_Entity", Flag168 (Id));
8084 W ("May_Inherit_Delayed_Rep_Aspects", Flag262 (Id));
8085 W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
8086 W ("Must_Have_Preelab_Init", Flag208 (Id));
8087 W ("Needs_Debug_Info", Flag147 (Id));
8088 W ("Needs_No_Actuals", Flag22 (Id));
8089 W ("Never_Set_In_Source", Flag115 (Id));
8090 W ("No_Pool_Assigned", Flag131 (Id));
8091 W ("No_Return", Flag113 (Id));
8092 W ("No_Strict_Aliasing", Flag136 (Id));
8093 W ("Non_Binary_Modulus", Flag58 (Id));
8094 W ("Nonzero_Is_True", Flag162 (Id));
8095 W ("OK_To_Rename", Flag247 (Id));
8096 W ("OK_To_Reorder_Components", Flag239 (Id));
8097 W ("Optimize_Alignment_Space", Flag241 (Id));
8098 W ("Optimize_Alignment_Time", Flag242 (Id));
8099 W ("Overlays_Constant", Flag243 (Id));
8100 W ("Reachable", Flag49 (Id));
8101 W ("Referenced", Flag156 (Id));
8102 W ("Referenced_As_LHS", Flag36 (Id));
8103 W ("Referenced_As_Out_Parameter", Flag227 (Id));
8104 W ("Renamed_In_Spec", Flag231 (Id));
8105 W ("Requires_Overriding", Flag213 (Id));
8106 W ("Return_Present", Flag54 (Id));
8107 W ("Returns_By_Ref", Flag90 (Id));
8108 W ("Reverse_Bit_Order", Flag164 (Id));
8109 W ("Reverse_Storage_Order", Flag93 (Id));
8110 W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
8111 W ("Size_Depends_On_Discriminant", Flag177 (Id));
8112 W ("Size_Known_At_Compile_Time", Flag92 (Id));
8113 W ("Static_Elaboration_Desired", Flag77 (Id));
8114 W ("Strict_Alignment", Flag145 (Id));
8115 W ("Suppress_Elaboration_Warnings", Flag148 (Id));
8116 W ("Suppress_Initialization", Flag105 (Id));
8117 W ("Suppress_Style_Checks", Flag165 (Id));
8118 W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
8119 W ("Treat_As_Volatile", Flag41 (Id));
8120 W ("Universal_Aliasing", Flag216 (Id));
8121 W ("Used_As_Generic_Actual", Flag222 (Id));
8122 W ("Uses_Sec_Stack", Flag95 (Id));
8123 W ("Warnings_Off", Flag96 (Id));
8124 W ("Warnings_Off_Used", Flag236 (Id));
8125 W ("Warnings_Off_Used_Unmodified", Flag237 (Id));
8126 W ("Warnings_Off_Used_Unreferenced", Flag238 (Id));
8127 W ("Was_Hidden", Flag196 (Id));
8128 end Write_Entity_Flags;
8129
8130 -----------------------
8131 -- Write_Entity_Info --
8132 -----------------------
8133
8134 procedure Write_Entity_Info (Id : Entity_Id; Prefix : String) is
8135
8136 procedure Write_Attribute (Which : String; Nam : E);
8137 -- Write attribute value with given string name
8138
8139 procedure Write_Kind (Id : Entity_Id);
8140 -- Write Ekind field of entity
8141
8142 ---------------------
8143 -- Write_Attribute --
8144 ---------------------
8145
8146 procedure Write_Attribute (Which : String; Nam : E) is
8147 begin
8148 Write_Str (Prefix);
8149 Write_Str (Which);
8150 Write_Int (Int (Nam));
8151 Write_Str (" ");
8152 Write_Name (Chars (Nam));
8153 Write_Str (" ");
8154 end Write_Attribute;
8155
8156 ----------------
8157 -- Write_Kind --
8158 ----------------
8159
8160 procedure Write_Kind (Id : Entity_Id) is
8161 K : constant String := Entity_Kind'Image (Ekind (Id));
8162
8163 begin
8164 Write_Str (Prefix);
8165 Write_Str (" Kind ");
8166
8167 if Is_Type (Id) and then Is_Tagged_Type (Id) then
8168 Write_Str ("TAGGED ");
8169 end if;
8170
8171 Write_Str (K (3 .. K'Length));
8172 Write_Str (" ");
8173
8174 if Is_Type (Id) and then Depends_On_Private (Id) then
8175 Write_Str ("Depends_On_Private ");
8176 end if;
8177 end Write_Kind;
8178
8179 -- Start of processing for Write_Entity_Info
8180
8181 begin
8182 Write_Eol;
8183 Write_Attribute ("Name ", Id);
8184 Write_Int (Int (Id));
8185 Write_Eol;
8186 Write_Kind (Id);
8187 Write_Eol;
8188 Write_Attribute (" Type ", Etype (Id));
8189 Write_Eol;
8190 Write_Attribute (" Scope ", Scope (Id));
8191 Write_Eol;
8192
8193 case Ekind (Id) is
8194
8195 when Discrete_Kind =>
8196 Write_Str ("Bounds: Id = ");
8197
8198 if Present (Scalar_Range (Id)) then
8199 Write_Int (Int (Type_Low_Bound (Id)));
8200 Write_Str (" .. Id = ");
8201 Write_Int (Int (Type_High_Bound (Id)));
8202 else
8203 Write_Str ("Empty");
8204 end if;
8205
8206 Write_Eol;
8207
8208 when Array_Kind =>
8209 declare
8210 Index : E;
8211
8212 begin
8213 Write_Attribute
8214 (" Component Type ", Component_Type (Id));
8215 Write_Eol;
8216 Write_Str (Prefix);
8217 Write_Str (" Indexes ");
8218
8219 Index := First_Index (Id);
8220 while Present (Index) loop
8221 Write_Attribute (" ", Etype (Index));
8222 Index := Next_Index (Index);
8223 end loop;
8224
8225 Write_Eol;
8226 end;
8227
8228 when Access_Kind =>
8229 Write_Attribute
8230 (" Directly Designated Type ",
8231 Directly_Designated_Type (Id));
8232 Write_Eol;
8233
8234 when Overloadable_Kind =>
8235 if Present (Homonym (Id)) then
8236 Write_Str (" Homonym ");
8237 Write_Name (Chars (Homonym (Id)));
8238 Write_Str (" ");
8239 Write_Int (Int (Homonym (Id)));
8240 Write_Eol;
8241 end if;
8242
8243 Write_Eol;
8244
8245 when E_Component =>
8246 if Ekind (Scope (Id)) in Record_Kind then
8247 Write_Attribute (
8248 " Original_Record_Component ",
8249 Original_Record_Component (Id));
8250 Write_Int (Int (Original_Record_Component (Id)));
8251 Write_Eol;
8252 end if;
8253
8254 when others => null;
8255 end case;
8256 end Write_Entity_Info;
8257
8258 -----------------------
8259 -- Write_Field6_Name --
8260 -----------------------
8261
8262 procedure Write_Field6_Name (Id : Entity_Id) is
8263 pragma Warnings (Off, Id);
8264 begin
8265 Write_Str ("First_Rep_Item");
8266 end Write_Field6_Name;
8267
8268 -----------------------
8269 -- Write_Field7_Name --
8270 -----------------------
8271
8272 procedure Write_Field7_Name (Id : Entity_Id) is
8273 pragma Warnings (Off, Id);
8274 begin
8275 Write_Str ("Freeze_Node");
8276 end Write_Field7_Name;
8277
8278 -----------------------
8279 -- Write_Field8_Name --
8280 -----------------------
8281
8282 procedure Write_Field8_Name (Id : Entity_Id) is
8283 begin
8284 case Ekind (Id) is
8285 when Type_Kind =>
8286 Write_Str ("Associated_Node_For_Itype");
8287
8288 when E_Package =>
8289 Write_Str ("Dependent_Instances");
8290
8291 when E_Loop =>
8292 Write_Str ("First_Exit_Statement");
8293
8294 when E_Variable =>
8295 Write_Str ("Hiding_Loop_Variable");
8296
8297 when Formal_Kind |
8298 E_Function |
8299 E_Subprogram_Body =>
8300 Write_Str ("Mechanism");
8301
8302 when E_Component |
8303 E_Discriminant =>
8304 Write_Str ("Normalized_First_Bit");
8305
8306 when E_Procedure =>
8307 Write_Str ("Postcondition_Proc");
8308
8309 when E_Package_Body =>
8310 Write_Str ("Refined_State_Pragma");
8311
8312 when E_Return_Statement =>
8313 Write_Str ("Return_Applies_To");
8314
8315 when others =>
8316 Write_Str ("Field8??");
8317 end case;
8318 end Write_Field8_Name;
8319
8320 -----------------------
8321 -- Write_Field9_Name --
8322 -----------------------
8323
8324 procedure Write_Field9_Name (Id : Entity_Id) is
8325 begin
8326 case Ekind (Id) is
8327 when Type_Kind =>
8328 Write_Str ("Class_Wide_Type");
8329
8330 when Object_Kind =>
8331 Write_Str ("Current_Value");
8332
8333 when E_Function |
8334 E_Generic_Function |
8335 E_Generic_Package |
8336 E_Generic_Procedure |
8337 E_Package |
8338 E_Procedure =>
8339 Write_Str ("Renaming_Map");
8340
8341 when others =>
8342 Write_Str ("Field9??");
8343 end case;
8344 end Write_Field9_Name;
8345
8346 ------------------------
8347 -- Write_Field10_Name --
8348 ------------------------
8349
8350 procedure Write_Field10_Name (Id : Entity_Id) is
8351 begin
8352 case Ekind (Id) is
8353 when Class_Wide_Kind |
8354 Incomplete_Kind |
8355 E_Record_Type |
8356 E_Record_Subtype |
8357 Private_Kind |
8358 Concurrent_Kind =>
8359 Write_Str ("Direct_Primitive_Operations");
8360
8361 when Float_Kind =>
8362 Write_Str ("Float_Rep");
8363
8364 when E_In_Parameter |
8365 E_Constant =>
8366 Write_Str ("Discriminal_Link");
8367
8368 when E_Function |
8369 E_Package |
8370 E_Package_Body |
8371 E_Procedure =>
8372 Write_Str ("Handler_Records");
8373
8374 when E_Component |
8375 E_Discriminant =>
8376 Write_Str ("Normalized_Position_Max");
8377
8378 when others =>
8379 Write_Str ("Field10??");
8380 end case;
8381 end Write_Field10_Name;
8382
8383 ------------------------
8384 -- Write_Field11_Name --
8385 ------------------------
8386
8387 procedure Write_Field11_Name (Id : Entity_Id) is
8388 begin
8389 case Ekind (Id) is
8390 when E_Block =>
8391 Write_Str ("Block_Node");
8392
8393 when E_Component |
8394 E_Discriminant =>
8395 Write_Str ("Component_Bit_Offset");
8396
8397 when Formal_Kind =>
8398 Write_Str ("Entry_Component");
8399
8400 when E_Enumeration_Literal =>
8401 Write_Str ("Enumeration_Pos");
8402
8403 when Type_Kind |
8404 E_Constant =>
8405 Write_Str ("Full_View");
8406
8407 when E_Generic_Package =>
8408 Write_Str ("Generic_Homonym");
8409
8410 when E_Function |
8411 E_Procedure |
8412 E_Entry |
8413 E_Entry_Family =>
8414 Write_Str ("Protected_Body_Subprogram");
8415
8416 when others =>
8417 Write_Str ("Field11??");
8418 end case;
8419 end Write_Field11_Name;
8420
8421 ------------------------
8422 -- Write_Field12_Name --
8423 ------------------------
8424
8425 procedure Write_Field12_Name (Id : Entity_Id) is
8426 begin
8427 case Ekind (Id) is
8428 when E_Package =>
8429 Write_Str ("Associated_Formal_Package");
8430
8431 when Entry_Kind =>
8432 Write_Str ("Barrier_Function");
8433
8434 when E_Enumeration_Literal =>
8435 Write_Str ("Enumeration_Rep");
8436
8437 when Type_Kind |
8438 E_Component |
8439 E_Constant |
8440 E_Discriminant |
8441 E_Exception |
8442 E_In_Parameter |
8443 E_In_Out_Parameter |
8444 E_Out_Parameter |
8445 E_Loop_Parameter |
8446 E_Variable =>
8447 Write_Str ("Esize");
8448
8449 when E_Function |
8450 E_Procedure =>
8451 Write_Str ("Next_Inlined_Subprogram");
8452
8453 when others =>
8454 Write_Str ("Field12??");
8455 end case;
8456 end Write_Field12_Name;
8457
8458 ------------------------
8459 -- Write_Field13_Name --
8460 ------------------------
8461
8462 procedure Write_Field13_Name (Id : Entity_Id) is
8463 begin
8464 case Ekind (Id) is
8465 when E_Component |
8466 E_Discriminant =>
8467 Write_Str ("Component_Clause");
8468
8469 when E_Function =>
8470 Write_Str ("Elaboration_Entity");
8471
8472 when E_Procedure |
8473 E_Package |
8474 Generic_Unit_Kind =>
8475 Write_Str ("Elaboration_Entity");
8476
8477 when Formal_Kind |
8478 E_Variable =>
8479 Write_Str ("Extra_Accessibility");
8480
8481 when Type_Kind =>
8482 Write_Str ("RM_Size");
8483
8484 when others =>
8485 Write_Str ("Field13??");
8486 end case;
8487 end Write_Field13_Name;
8488
8489 -----------------------
8490 -- Write_Field14_Name --
8491 -----------------------
8492
8493 procedure Write_Field14_Name (Id : Entity_Id) is
8494 begin
8495 case Ekind (Id) is
8496 when Type_Kind |
8497 Formal_Kind |
8498 E_Constant |
8499 E_Exception |
8500 E_Variable |
8501 E_Loop_Parameter =>
8502 Write_Str ("Alignment");
8503
8504 when E_Function |
8505 E_Procedure =>
8506 Write_Str ("First_Optional_Parameter");
8507
8508 when E_Component |
8509 E_Discriminant =>
8510 Write_Str ("Normalized_Position");
8511
8512 when E_Package |
8513 E_Generic_Package =>
8514 Write_Str ("Shadow_Entities");
8515
8516 when others =>
8517 Write_Str ("Field14??");
8518 end case;
8519 end Write_Field14_Name;
8520
8521 ------------------------
8522 -- Write_Field15_Name --
8523 ------------------------
8524
8525 procedure Write_Field15_Name (Id : Entity_Id) is
8526 begin
8527 case Ekind (Id) is
8528 when E_Discriminant =>
8529 Write_Str ("Discriminant_Number");
8530
8531 when E_Component =>
8532 Write_Str ("DT_Entry_Count");
8533
8534 when E_Function |
8535 E_Procedure =>
8536 Write_Str ("DT_Position");
8537
8538 when E_Protected_Type =>
8539 Write_Str ("Entry_Bodies_Array");
8540
8541 when Entry_Kind =>
8542 Write_Str ("Entry_Parameters_Type");
8543
8544 when Formal_Kind =>
8545 Write_Str ("Extra_Formal");
8546
8547 when Enumeration_Kind =>
8548 Write_Str ("Lit_Indexes");
8549
8550 when E_Package |
8551 E_Package_Body =>
8552 Write_Str ("Related_Instance");
8553
8554 when Decimal_Fixed_Point_Kind =>
8555 Write_Str ("Scale_Value");
8556
8557 when E_Constant |
8558 E_Variable =>
8559 Write_Str ("Status_Flag_Or_Transient_Decl");
8560
8561 when Access_Kind |
8562 Task_Kind =>
8563 Write_Str ("Storage_Size_Variable");
8564
8565 when E_String_Literal_Subtype =>
8566 Write_Str ("String_Literal_Low_Bound");
8567
8568 when others =>
8569 Write_Str ("Field15??");
8570 end case;
8571 end Write_Field15_Name;
8572
8573 ------------------------
8574 -- Write_Field16_Name --
8575 ------------------------
8576
8577 procedure Write_Field16_Name (Id : Entity_Id) is
8578 begin
8579 case Ekind (Id) is
8580 when E_Record_Type |
8581 E_Record_Type_With_Private =>
8582 Write_Str ("Access_Disp_Table");
8583
8584 when E_Record_Subtype |
8585 E_Class_Wide_Subtype =>
8586 Write_Str ("Cloned_Subtype");
8587
8588 when E_Function |
8589 E_Procedure =>
8590 Write_Str ("DTC_Entity");
8591
8592 when E_Component =>
8593 Write_Str ("Entry_Formal");
8594
8595 when E_Package |
8596 E_Generic_Package |
8597 Concurrent_Kind =>
8598 Write_Str ("First_Private_Entity");
8599
8600 when Enumeration_Kind =>
8601 Write_Str ("Lit_Strings");
8602
8603 when E_String_Literal_Subtype =>
8604 Write_Str ("String_Literal_Length");
8605
8606 when E_Variable |
8607 E_Out_Parameter =>
8608 Write_Str ("Unset_Reference");
8609
8610 when others =>
8611 Write_Str ("Field16??");
8612 end case;
8613 end Write_Field16_Name;
8614
8615 ------------------------
8616 -- Write_Field17_Name --
8617 ------------------------
8618
8619 procedure Write_Field17_Name (Id : Entity_Id) is
8620 begin
8621 case Ekind (Id) is
8622 when Formal_Kind |
8623 E_Constant |
8624 E_Generic_In_Out_Parameter |
8625 E_Variable =>
8626 Write_Str ("Actual_Subtype");
8627
8628 when Digits_Kind =>
8629 Write_Str ("Digits_Value");
8630
8631 when E_Discriminant =>
8632 Write_Str ("Discriminal");
8633
8634 when E_Block |
8635 Class_Wide_Kind |
8636 Concurrent_Kind |
8637 Private_Kind |
8638 E_Entry |
8639 E_Entry_Family |
8640 E_Function |
8641 E_Generic_Function |
8642 E_Generic_Package |
8643 E_Generic_Procedure |
8644 E_Loop |
8645 E_Operator |
8646 E_Package |
8647 E_Package_Body |
8648 E_Procedure |
8649 E_Record_Type |
8650 E_Record_Subtype |
8651 E_Return_Statement |
8652 E_Subprogram_Body |
8653 E_Subprogram_Type =>
8654 Write_Str ("First_Entity");
8655
8656 when Array_Kind =>
8657 Write_Str ("First_Index");
8658
8659 when Enumeration_Kind =>
8660 Write_Str ("First_Literal");
8661
8662 when Access_Kind =>
8663 Write_Str ("Master_Id");
8664
8665 when Modular_Integer_Kind =>
8666 Write_Str ("Modulus");
8667
8668 when E_Incomplete_Type =>
8669 Write_Str ("Non_Limited_View");
8670
8671 when E_Incomplete_Subtype =>
8672 if From_With_Type (Id) then
8673 Write_Str ("Non_Limited_View");
8674 end if;
8675
8676 when E_Component =>
8677 Write_Str ("Prival");
8678
8679 when others =>
8680 Write_Str ("Field17??");
8681 end case;
8682 end Write_Field17_Name;
8683
8684 ------------------------
8685 -- Write_Field18_Name --
8686 ------------------------
8687
8688 procedure Write_Field18_Name (Id : Entity_Id) is
8689 begin
8690 case Ekind (Id) is
8691 when E_Enumeration_Literal |
8692 E_Function |
8693 E_Operator |
8694 E_Procedure =>
8695 Write_Str ("Alias");
8696
8697 when E_Record_Type =>
8698 Write_Str ("Corresponding_Concurrent_Type");
8699
8700 when E_Subprogram_Body =>
8701 Write_Str ("Corresponding_Protected_Entry");
8702
8703 when Concurrent_Kind =>
8704 Write_Str ("Corresponding_Record_Type");
8705
8706 when E_Label |
8707 E_Loop |
8708 E_Block =>
8709 Write_Str ("Enclosing_Scope");
8710
8711 when E_Entry_Index_Parameter =>
8712 Write_Str ("Entry_Index_Constant");
8713
8714 when E_Class_Wide_Subtype |
8715 E_Access_Protected_Subprogram_Type |
8716 E_Anonymous_Access_Protected_Subprogram_Type |
8717 E_Access_Subprogram_Type |
8718 E_Exception_Type =>
8719 Write_Str ("Equivalent_Type");
8720
8721 when Fixed_Point_Kind =>
8722 Write_Str ("Delta_Value");
8723
8724 when Incomplete_Or_Private_Kind |
8725 E_Record_Subtype =>
8726 Write_Str ("Private_Dependents");
8727
8728 when Object_Kind =>
8729 Write_Str ("Renamed_Object");
8730
8731 when E_Exception |
8732 E_Package |
8733 E_Generic_Function |
8734 E_Generic_Procedure |
8735 E_Generic_Package =>
8736 Write_Str ("Renamed_Entity");
8737
8738 when others =>
8739 Write_Str ("Field18??");
8740 end case;
8741 end Write_Field18_Name;
8742
8743 -----------------------
8744 -- Write_Field19_Name --
8745 -----------------------
8746
8747 procedure Write_Field19_Name (Id : Entity_Id) is
8748 begin
8749 case Ekind (Id) is
8750 when E_Package |
8751 E_Generic_Package =>
8752 Write_Str ("Body_Entity");
8753
8754 when E_Discriminant =>
8755 Write_Str ("Corresponding_Discriminant");
8756
8757 when Scalar_Kind =>
8758 Write_Str ("Default_Aspect_Value");
8759
8760 when E_Array_Type =>
8761 Write_Str ("Default_Component_Value");
8762
8763 when E_Record_Type =>
8764 Write_Str ("Parent_Subtype");
8765
8766 when E_Constant |
8767 E_Variable =>
8768 Write_Str ("Size_Check_Code");
8769
8770 when E_Package_Body |
8771 Formal_Kind =>
8772 Write_Str ("Spec_Entity");
8773
8774 when Private_Kind =>
8775 Write_Str ("Underlying_Full_View");
8776
8777 when E_Function | E_Operator | E_Subprogram_Type =>
8778 Write_Str ("Extra_Accessibility_Of_Result");
8779
8780 when others =>
8781 Write_Str ("Field19??");
8782 end case;
8783 end Write_Field19_Name;
8784
8785 -----------------------
8786 -- Write_Field20_Name --
8787 -----------------------
8788
8789 procedure Write_Field20_Name (Id : Entity_Id) is
8790 begin
8791 case Ekind (Id) is
8792 when Array_Kind =>
8793 Write_Str ("Component_Type");
8794
8795 when E_In_Parameter |
8796 E_Generic_In_Parameter =>
8797 Write_Str ("Default_Value");
8798
8799 when Access_Kind =>
8800 Write_Str ("Directly_Designated_Type");
8801
8802 when E_Component =>
8803 Write_Str ("Discriminant_Checking_Func");
8804
8805 when E_Discriminant =>
8806 Write_Str ("Discriminant_Default_Value");
8807
8808 when E_Block |
8809 Class_Wide_Kind |
8810 Concurrent_Kind |
8811 Private_Kind |
8812 E_Entry |
8813 E_Entry_Family |
8814 E_Function |
8815 E_Generic_Function |
8816 E_Generic_Package |
8817 E_Generic_Procedure |
8818 E_Loop |
8819 E_Operator |
8820 E_Package |
8821 E_Package_Body |
8822 E_Procedure |
8823 E_Record_Type |
8824 E_Record_Subtype |
8825 E_Return_Statement |
8826 E_Subprogram_Body |
8827 E_Subprogram_Type =>
8828 Write_Str ("Last_Entity");
8829
8830 when E_Constant |
8831 E_Variable =>
8832 Write_Str ("Prival_Link");
8833
8834 when Scalar_Kind =>
8835 Write_Str ("Scalar_Range");
8836
8837 when E_Exception =>
8838 Write_Str ("Register_Exception_Call");
8839
8840 when others =>
8841 Write_Str ("Field20??");
8842 end case;
8843 end Write_Field20_Name;
8844
8845 -----------------------
8846 -- Write_Field21_Name --
8847 -----------------------
8848
8849 procedure Write_Field21_Name (Id : Entity_Id) is
8850 begin
8851 case Ekind (Id) is
8852 when Entry_Kind =>
8853 Write_Str ("Accept_Address");
8854
8855 when E_In_Parameter =>
8856 Write_Str ("Default_Expr_Function");
8857
8858 when Concurrent_Kind |
8859 Incomplete_Or_Private_Kind |
8860 Class_Wide_Kind |
8861 E_Record_Type |
8862 E_Record_Subtype =>
8863 Write_Str ("Discriminant_Constraint");
8864
8865 when E_Constant |
8866 E_Exception |
8867 E_Function |
8868 E_Generic_Function |
8869 E_Procedure |
8870 E_Generic_Procedure |
8871 E_Variable =>
8872 Write_Str ("Interface_Name");
8873
8874 when Array_Kind |
8875 Modular_Integer_Kind =>
8876 Write_Str ("Original_Array_Type");
8877
8878 when Fixed_Point_Kind =>
8879 Write_Str ("Small_Value");
8880
8881 when others =>
8882 Write_Str ("Field21??");
8883 end case;
8884 end Write_Field21_Name;
8885
8886 -----------------------
8887 -- Write_Field22_Name --
8888 -----------------------
8889
8890 procedure Write_Field22_Name (Id : Entity_Id) is
8891 begin
8892 case Ekind (Id) is
8893 when Access_Kind =>
8894 Write_Str ("Associated_Storage_Pool");
8895
8896 when Array_Kind =>
8897 Write_Str ("Component_Size");
8898
8899 when E_Record_Type =>
8900 Write_Str ("Corresponding_Remote_Type");
8901
8902 when E_Component |
8903 E_Discriminant =>
8904 Write_Str ("Original_Record_Component");
8905
8906 when E_Enumeration_Literal =>
8907 Write_Str ("Enumeration_Rep_Expr");
8908
8909 when E_Exception =>
8910 Write_Str ("Exception_Code");
8911
8912 when E_Record_Type_With_Private |
8913 E_Record_Subtype_With_Private |
8914 E_Private_Type |
8915 E_Private_Subtype |
8916 E_Limited_Private_Type |
8917 E_Limited_Private_Subtype =>
8918 Write_Str ("Private_View");
8919
8920 when Formal_Kind =>
8921 Write_Str ("Protected_Formal");
8922
8923 when E_Block |
8924 E_Entry |
8925 E_Entry_Family |
8926 E_Function |
8927 E_Loop |
8928 E_Package |
8929 E_Package_Body |
8930 E_Generic_Package |
8931 E_Generic_Function |
8932 E_Generic_Procedure |
8933 E_Procedure |
8934 E_Protected_Type |
8935 E_Return_Statement |
8936 E_Subprogram_Body |
8937 E_Task_Type =>
8938 Write_Str ("Scope_Depth_Value");
8939
8940 when E_Variable =>
8941 Write_Str ("Shared_Var_Procs_Instance");
8942
8943 when others =>
8944 Write_Str ("Field22??");
8945 end case;
8946 end Write_Field22_Name;
8947
8948 ------------------------
8949 -- Write_Field23_Name --
8950 ------------------------
8951
8952 procedure Write_Field23_Name (Id : Entity_Id) is
8953 begin
8954 case Ekind (Id) is
8955 when E_Discriminant =>
8956 Write_Str ("CR_Discriminant");
8957
8958 when E_Block =>
8959 Write_Str ("Entry_Cancel_Parameter");
8960
8961 when E_Enumeration_Type =>
8962 Write_Str ("Enum_Pos_To_Rep");
8963
8964 when Formal_Kind |
8965 E_Variable =>
8966 Write_Str ("Extra_Constrained");
8967
8968 when Access_Kind =>
8969 Write_Str ("Finalization_Master");
8970
8971 when E_Generic_Function |
8972 E_Generic_Package |
8973 E_Generic_Procedure =>
8974 Write_Str ("Inner_Instances");
8975
8976 when Array_Kind =>
8977 Write_Str ("Packed_Array_Type");
8978
8979 when Entry_Kind =>
8980 Write_Str ("Protection_Object");
8981
8982 when Concurrent_Kind |
8983 Incomplete_Or_Private_Kind |
8984 Class_Wide_Kind |
8985 E_Record_Type |
8986 E_Record_Subtype =>
8987 Write_Str ("Stored_Constraint");
8988
8989 when E_Function |
8990 E_Procedure =>
8991 if Present (Scope (Id))
8992 and then Is_Protected_Type (Scope (Id))
8993 then
8994 Write_Str ("Protection_Object");
8995 else
8996 Write_Str ("Generic_Renamings");
8997 end if;
8998
8999 when E_Package =>
9000 if Is_Generic_Instance (Id) then
9001 Write_Str ("Generic_Renamings");
9002 else
9003 Write_Str ("Limited_View");
9004 end if;
9005
9006 when others =>
9007 Write_Str ("Field23??");
9008 end case;
9009 end Write_Field23_Name;
9010
9011 ------------------------
9012 -- Write_Field24_Name --
9013 ------------------------
9014
9015 procedure Write_Field24_Name (Id : Entity_Id) is
9016 begin
9017 case Ekind (Id) is
9018 when E_Package |
9019 E_Package_Body =>
9020 Write_Str ("Finalizer");
9021
9022 when E_Constant |
9023 E_Variable |
9024 Type_Kind =>
9025 Write_Str ("Related_Expression");
9026
9027 when E_Entry |
9028 E_Entry_Family |
9029 E_Subprogram_Body |
9030 Subprogram_Kind |
9031 Generic_Subprogram_Kind =>
9032 Write_Str ("Contract");
9033
9034 when others =>
9035 Write_Str ("Field24???");
9036 end case;
9037 end Write_Field24_Name;
9038
9039 ------------------------
9040 -- Write_Field25_Name --
9041 ------------------------
9042
9043 procedure Write_Field25_Name (Id : Entity_Id) is
9044 begin
9045 case Ekind (Id) is
9046 when E_Package =>
9047 Write_Str ("Abstract_States");
9048
9049 when E_Variable =>
9050 Write_Str ("Debug_Renaming_Link");
9051
9052 when E_Component =>
9053 Write_Str ("DT_Offset_To_Top_Func");
9054
9055 when E_Procedure |
9056 E_Function =>
9057 Write_Str ("Interface_Alias");
9058
9059 when E_Record_Type |
9060 E_Record_Subtype |
9061 E_Record_Type_With_Private |
9062 E_Record_Subtype_With_Private =>
9063 Write_Str ("Interfaces");
9064
9065 when E_Array_Type |
9066 E_Array_Subtype =>
9067 Write_Str ("Related_Array_Object");
9068
9069 when Task_Kind =>
9070 Write_Str ("Task_Body_Procedure");
9071
9072 when E_Entry |
9073 E_Entry_Family =>
9074 Write_Str ("PPC_Wrapper");
9075
9076 when E_Enumeration_Subtype |
9077 E_Modular_Integer_Subtype |
9078 E_Signed_Integer_Subtype =>
9079 Write_Str ("Static_Predicate");
9080
9081 when others =>
9082 Write_Str ("Field25??");
9083 end case;
9084 end Write_Field25_Name;
9085
9086 ------------------------
9087 -- Write_Field26_Name --
9088 ------------------------
9089
9090 procedure Write_Field26_Name (Id : Entity_Id) is
9091 begin
9092 case Ekind (Id) is
9093 when E_Record_Type |
9094 E_Record_Type_With_Private =>
9095 Write_Str ("Dispatch_Table_Wrappers");
9096
9097 when E_In_Out_Parameter |
9098 E_Out_Parameter |
9099 E_Variable =>
9100 Write_Str ("Last_Assignment");
9101
9102 when E_Access_Subprogram_Type =>
9103 Write_Str ("Original_Access_Type");
9104
9105 when E_Generic_Package |
9106 E_Package =>
9107 Write_Str ("Package_Instantiation");
9108
9109 when E_Component |
9110 E_Constant =>
9111 Write_Str ("Related_Type");
9112
9113 when Task_Kind =>
9114 Write_Str ("Relative_Deadline_Variable");
9115
9116 when E_Procedure |
9117 E_Function =>
9118 Write_Str ("Overridden_Operation");
9119
9120 when others =>
9121 Write_Str ("Field26??");
9122 end case;
9123 end Write_Field26_Name;
9124
9125 ------------------------
9126 -- Write_Field27_Name --
9127 ------------------------
9128
9129 procedure Write_Field27_Name (Id : Entity_Id) is
9130 begin
9131 case Ekind (Id) is
9132 when E_Package |
9133 Type_Kind =>
9134 Write_Str ("Current_Use_Clause");
9135
9136 when E_Component |
9137 E_Constant |
9138 E_Variable =>
9139 Write_Str ("Related_Type");
9140
9141 when E_Procedure |
9142 E_Function =>
9143 Write_Str ("Wrapped_Entity");
9144
9145 when others =>
9146 Write_Str ("Field27??");
9147 end case;
9148 end Write_Field27_Name;
9149
9150 ------------------------
9151 -- Write_Field28_Name --
9152 ------------------------
9153
9154 procedure Write_Field28_Name (Id : Entity_Id) is
9155 begin
9156 case Ekind (Id) is
9157 when E_Entry |
9158 E_Entry_Family |
9159 E_Function |
9160 E_Procedure |
9161 E_Subprogram_Body |
9162 E_Subprogram_Type =>
9163 Write_Str ("Extra_Formals");
9164
9165 when E_Constant | E_Variable =>
9166 Write_Str ("Initialization_Statements");
9167
9168 when E_Record_Type =>
9169 Write_Str ("Underlying_Record_View");
9170
9171 when others =>
9172 Write_Str ("Field28??");
9173 end case;
9174 end Write_Field28_Name;
9175
9176 ------------------------
9177 -- Write_Field29_Name --
9178 ------------------------
9179
9180 procedure Write_Field29_Name (Id : Entity_Id) is
9181 begin
9182 case Ekind (Id) is
9183 when Type_Kind =>
9184 Write_Str ("Subprograms_For_Type");
9185
9186 when others =>
9187 Write_Str ("Field29??");
9188 end case;
9189 end Write_Field29_Name;
9190
9191 ------------------------
9192 -- Write_Field30_Name --
9193 ------------------------
9194
9195 procedure Write_Field30_Name (Id : Entity_Id) is
9196 begin
9197 case Ekind (Id) is
9198 when E_Function =>
9199 Write_Str ("Corresponding_Equality");
9200
9201 when E_Procedure =>
9202 Write_Str ("Static_Initialization");
9203
9204 when others =>
9205 Write_Str ("Field30??");
9206 end case;
9207 end Write_Field30_Name;
9208
9209 ------------------------
9210 -- Write_Field31_Name --
9211 ------------------------
9212
9213 procedure Write_Field31_Name (Id : Entity_Id) is
9214 begin
9215 case Ekind (Id) is
9216 when E_Procedure |
9217 E_Function =>
9218 Write_Str ("Thunk_Entity");
9219
9220 when others =>
9221 Write_Str ("Field31??");
9222 end case;
9223 end Write_Field31_Name;
9224
9225 ------------------------
9226 -- Write_Field32_Name --
9227 ------------------------
9228
9229 procedure Write_Field32_Name (Id : Entity_Id) is
9230 begin
9231 case Ekind (Id) is
9232 when E_Function |
9233 E_Generic_Function |
9234 E_Generic_Package |
9235 E_Generic_Procedure |
9236 E_Package |
9237 E_Package_Body |
9238 E_Procedure |
9239 E_Subprogram_Body =>
9240 Write_Str ("SPARK_Mode_Pragmas");
9241
9242 when others =>
9243 Write_Str ("Field32??");
9244 end case;
9245 end Write_Field32_Name;
9246
9247 ------------------------
9248 -- Write_Field33_Name --
9249 ------------------------
9250
9251 procedure Write_Field33_Name (Id : Entity_Id) is
9252 begin
9253 case Ekind (Id) is
9254 when others =>
9255 Write_Str ("Field33??");
9256 end case;
9257 end Write_Field33_Name;
9258
9259 ------------------------
9260 -- Write_Field34_Name --
9261 ------------------------
9262
9263 procedure Write_Field34_Name (Id : Entity_Id) is
9264 begin
9265 case Ekind (Id) is
9266 when others =>
9267 Write_Str ("Field34??");
9268 end case;
9269 end Write_Field34_Name;
9270
9271 ------------------------
9272 -- Write_Field35_Name --
9273 ------------------------
9274
9275 procedure Write_Field35_Name (Id : Entity_Id) is
9276 begin
9277 case Ekind (Id) is
9278 when others =>
9279 Write_Str ("Field35??");
9280 end case;
9281 end Write_Field35_Name;
9282
9283 -------------------------
9284 -- Iterator Procedures --
9285 -------------------------
9286
9287 procedure Proc_Next_Component (N : in out Node_Id) is
9288 begin
9289 N := Next_Component (N);
9290 end Proc_Next_Component;
9291
9292 procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id) is
9293 begin
9294 N := Next_Entity (N);
9295 while Present (N) loop
9296 exit when Ekind_In (N, E_Component, E_Discriminant);
9297 N := Next_Entity (N);
9298 end loop;
9299 end Proc_Next_Component_Or_Discriminant;
9300
9301 procedure Proc_Next_Discriminant (N : in out Node_Id) is
9302 begin
9303 N := Next_Discriminant (N);
9304 end Proc_Next_Discriminant;
9305
9306 procedure Proc_Next_Formal (N : in out Node_Id) is
9307 begin
9308 N := Next_Formal (N);
9309 end Proc_Next_Formal;
9310
9311 procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is
9312 begin
9313 N := Next_Formal_With_Extras (N);
9314 end Proc_Next_Formal_With_Extras;
9315
9316 procedure Proc_Next_Index (N : in out Node_Id) is
9317 begin
9318 N := Next_Index (N);
9319 end Proc_Next_Index;
9320
9321 procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is
9322 begin
9323 N := Next_Inlined_Subprogram (N);
9324 end Proc_Next_Inlined_Subprogram;
9325
9326 procedure Proc_Next_Literal (N : in out Node_Id) is
9327 begin
9328 N := Next_Literal (N);
9329 end Proc_Next_Literal;
9330
9331 procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is
9332 begin
9333 N := Next_Stored_Discriminant (N);
9334 end Proc_Next_Stored_Discriminant;
9335
9336 end Einfo;