more autogen definiton
[official-gcc.git] / gcc / ada / einfo.adb
blob0fdc83c3086633ece3a65ab41119cabee99caca5
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E I N F O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2012, 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 ------------------------------------------------------------------------------
32 pragma Style_Checks (All_Checks);
33 -- Turn off subprogram ordering, not used for this unit
35 with Atree; use Atree;
36 with Nlists; use Nlists;
37 with Output; use Output;
38 with Sinfo; use Sinfo;
39 with Stand; use Stand;
41 package body Einfo is
43 use Atree.Unchecked_Access;
44 -- This is one of the packages that is allowed direct untyped access to
45 -- the fields in a node, since it provides the next level abstraction
46 -- which incorporates appropriate checks.
48 ----------------------------------------------
49 -- Usage of Fields in Defining Entity Nodes --
50 ----------------------------------------------
52 -- Four of these fields are defined in Sinfo, since they in are the base
53 -- part of the node. The access routines for these four fields and the
54 -- corresponding set procedures are defined in Sinfo. These fields are
55 -- present in all entities. Note that Homonym is also in the base part of
56 -- the node, but has access routines that are more properly part of Einfo,
57 -- which is why they are defined here.
59 -- Chars Name1
60 -- Next_Entity Node2
61 -- Scope Node3
62 -- Etype Node5
64 -- Remaining fields are present only in extended nodes (i.e. entities)
66 -- The following fields are present in all entities
68 -- Homonym Node4
69 -- First_Rep_Item Node6
70 -- Freeze_Node Node7
72 -- The usage of other fields (and the entity kinds to which it applies)
73 -- depends on the particular field (see Einfo spec for details).
75 -- Associated_Node_For_Itype Node8
76 -- Dependent_Instances Elist8
77 -- Hiding_Loop_Variable Node8
78 -- Mechanism Uint8 (but returns Mechanism_Type)
79 -- Normalized_First_Bit Uint8
80 -- Postcondition_Proc Node8
81 -- Return_Applies_To Node8
82 -- First_Exit_Statement Node8
84 -- Class_Wide_Type Node9
85 -- Current_Value Node9
86 -- Renaming_Map Uint9
88 -- Direct_Primitive_Operations Elist10
89 -- Discriminal_Link Node10
90 -- Float_Rep Uint10 (but returns Float_Rep_Kind)
91 -- Handler_Records List10
92 -- Normalized_Position_Max Uint10
94 -- Component_Bit_Offset Uint11
95 -- Full_View Node11
96 -- Entry_Component Node11
97 -- Enumeration_Pos Uint11
98 -- Generic_Homonym Node11
99 -- Protected_Body_Subprogram Node11
100 -- Block_Node Node11
102 -- Barrier_Function Node12
103 -- Enumeration_Rep Uint12
104 -- Esize Uint12
105 -- Next_Inlined_Subprogram Node12
107 -- Corresponding_Equality Node13
108 -- Component_Clause Node13
109 -- Elaboration_Entity Node13
110 -- Extra_Accessibility Node13
111 -- RM_Size Uint13
113 -- Alignment Uint14
114 -- First_Optional_Parameter Node14
115 -- Normalized_Position Uint14
116 -- Shadow_Entities List14
118 -- Discriminant_Number Uint15
119 -- DT_Position Uint15
120 -- DT_Entry_Count Uint15
121 -- Entry_Bodies_Array Node15
122 -- Entry_Parameters_Type Node15
123 -- Extra_Formal Node15
124 -- Lit_Indexes Node15
125 -- Related_Instance Node15
126 -- Return_Flag_Or_Transient_Decl Node15
127 -- Scale_Value Uint15
128 -- Storage_Size_Variable Node15
129 -- String_Literal_Low_Bound Node15
131 -- Access_Disp_Table Elist16
132 -- Cloned_Subtype Node16
133 -- DTC_Entity Node16
134 -- Entry_Formal Node16
135 -- First_Private_Entity Node16
136 -- Lit_Strings Node16
137 -- String_Literal_Length Uint16
138 -- Unset_Reference Node16
140 -- Actual_Subtype Node17
141 -- Digits_Value Uint17
142 -- Discriminal Node17
143 -- First_Entity Node17
144 -- First_Index Node17
145 -- First_Literal Node17
146 -- Master_Id Node17
147 -- Modulus Uint17
148 -- Non_Limited_View Node17
149 -- Prival Node17
151 -- Alias Node18
152 -- Corresponding_Concurrent_Type Node18
153 -- Corresponding_Protected_Entry Node18
154 -- Corresponding_Record_Type Node18
155 -- Delta_Value Ureal18
156 -- Enclosing_Scope Node18
157 -- Equivalent_Type Node18
158 -- Private_Dependents Elist18
159 -- Renamed_Entity Node18
160 -- Renamed_Object Node18
162 -- Body_Entity Node19
163 -- Corresponding_Discriminant Node19
164 -- Default_Aspect_Component_Value Node19
165 -- Default_Aspect_Value Node19
166 -- Extra_Accessibility_Of_Result Node19
167 -- Parent_Subtype Node19
168 -- Size_Check_Code Node19
169 -- Spec_Entity Node19
170 -- Underlying_Full_View Node19
172 -- Component_Type Node20
173 -- Default_Value Node20
174 -- Directly_Designated_Type Node20
175 -- Discriminant_Checking_Func Node20
176 -- Discriminant_Default_Value Node20
177 -- Last_Entity Node20
178 -- Prival_Link Node20
179 -- Register_Exception_Call Node20
180 -- Scalar_Range Node20
182 -- Accept_Address Elist21
183 -- Default_Expr_Function Node21
184 -- Discriminant_Constraint Elist21
185 -- Interface_Name Node21
186 -- Original_Array_Type Node21
187 -- Small_Value Ureal21
189 -- Associated_Storage_Pool Node22
190 -- Component_Size Uint22
191 -- Corresponding_Remote_Type Node22
192 -- Enumeration_Rep_Expr Node22
193 -- Exception_Code Uint22
194 -- Original_Record_Component Node22
195 -- Private_View Node22
196 -- Protected_Formal Node22
197 -- Scope_Depth_Value Uint22
198 -- Shared_Var_Procs_Instance Node22
200 -- CR_Discriminant Node23
201 -- Entry_Cancel_Parameter Node23
202 -- Enum_Pos_To_Rep Node23
203 -- Extra_Constrained Node23
204 -- Finalization_Master Node23
205 -- Generic_Renamings Elist23
206 -- Inner_Instances Elist23
207 -- Limited_View Node23
208 -- Packed_Array_Type Node23
209 -- Protection_Object Node23
210 -- Stored_Constraint Elist23
212 -- Finalizer Node24
213 -- Related_Expression Node24
214 -- Contract Node24
216 -- Interface_Alias Node25
217 -- Interfaces Elist25
218 -- Debug_Renaming_Link Node25
219 -- DT_Offset_To_Top_Func Node25
220 -- PPC_Wrapper Node25
221 -- Related_Array_Object Node25
222 -- Static_Predicate List25
223 -- Task_Body_Procedure Node25
225 -- Dispatch_Table_Wrappers Elist26
226 -- Last_Assignment Node26
227 -- Original_Access_Type Node26
228 -- Overridden_Operation Node26
229 -- Package_Instantiation Node26
230 -- Relative_Deadline_Variable Node26
231 -- Static_Initialization Node26
233 -- Current_Use_Clause Node27
234 -- Related_Type Node27
235 -- Wrapped_Entity Node27
237 -- Extra_Formals Node28
238 -- Underlying_Record_View Node28
240 -- Subprograms_For_Type Node29
242 ---------------------------------------------
243 -- Usage of Flags in Defining Entity Nodes --
244 ---------------------------------------------
246 -- All flags are unique, there is no overlaying, so each flag is physically
247 -- present in every entity. However, for many of the flags, it only makes
248 -- sense for them to be set true for certain subsets of entity kinds. See
249 -- the spec of Einfo for further details.
251 -- Note: Flag1-Flag3 are absent from this list, for historical reasons
253 -- Is_Frozen Flag4
254 -- Has_Discriminants Flag5
255 -- Is_Dispatching_Operation Flag6
256 -- Is_Immediately_Visible Flag7
257 -- In_Use Flag8
258 -- Is_Potentially_Use_Visible Flag9
259 -- Is_Public Flag10
261 -- Is_Inlined Flag11
262 -- Is_Constrained Flag12
263 -- Is_Generic_Type Flag13
264 -- Depends_On_Private Flag14
265 -- Is_Aliased Flag15
266 -- Is_Volatile Flag16
267 -- Is_Internal Flag17
268 -- Has_Delayed_Freeze Flag18
269 -- Is_Abstract_Subprogram Flag19
270 -- Is_Concurrent_Record_Type Flag20
272 -- Has_Master_Entity Flag21
273 -- Needs_No_Actuals Flag22
274 -- Has_Storage_Size_Clause Flag23
275 -- Is_Imported Flag24
276 -- Is_Limited_Record Flag25
277 -- Has_Completion Flag26
278 -- Has_Pragma_Controlled Flag27
279 -- Is_Statically_Allocated Flag28
280 -- Has_Size_Clause Flag29
281 -- Has_Task Flag30
283 -- Checks_May_Be_Suppressed Flag31
284 -- Kill_Elaboration_Checks Flag32
285 -- Kill_Range_Checks Flag33
286 -- Kill_Tag_Checks Flag34
287 -- Is_Class_Wide_Equivalent_Type Flag35
288 -- Referenced_As_LHS Flag36
289 -- Is_Known_Non_Null Flag37
290 -- Can_Never_Be_Null Flag38
291 -- Has_Default_Aspect Flag39
292 -- Body_Needed_For_SAL Flag40
294 -- Treat_As_Volatile Flag41
295 -- Is_Controlled Flag42
296 -- Has_Controlled_Component Flag43
297 -- Is_Pure Flag44
298 -- In_Private_Part Flag45
299 -- Has_Alignment_Clause Flag46
300 -- Has_Exit Flag47
301 -- In_Package_Body Flag48
302 -- Reachable Flag49
303 -- Delay_Subprogram_Descriptors Flag50
305 -- Is_Packed Flag51
306 -- Is_Entry_Formal Flag52
307 -- Is_Private_Descendant Flag53
308 -- Return_Present Flag54
309 -- Is_Tagged_Type Flag55
310 -- Has_Homonym Flag56
311 -- Is_Hidden Flag57
312 -- Non_Binary_Modulus Flag58
313 -- Is_Preelaborated Flag59
314 -- Is_Shared_Passive Flag60
316 -- Is_Remote_Types Flag61
317 -- Is_Remote_Call_Interface Flag62
318 -- Is_Character_Type Flag63
319 -- Is_Intrinsic_Subprogram Flag64
320 -- Has_Record_Rep_Clause Flag65
321 -- Has_Enumeration_Rep_Clause Flag66
322 -- Has_Small_Clause Flag67
323 -- Has_Component_Size_Clause Flag68
324 -- Is_Access_Constant Flag69
325 -- Is_First_Subtype Flag70
327 -- Has_Completion_In_Body Flag71
328 -- Has_Unknown_Discriminants Flag72
329 -- Is_Child_Unit Flag73
330 -- Is_CPP_Class Flag74
331 -- Has_Non_Standard_Rep Flag75
332 -- Is_Constructor Flag76
333 -- Static_Elaboration_Desired Flag77
334 -- Is_Tag Flag78
335 -- Has_All_Calls_Remote Flag79
336 -- Is_Constr_Subt_For_U_Nominal Flag80
338 -- Is_Asynchronous Flag81
339 -- Has_Gigi_Rep_Item Flag82
340 -- Has_Machine_Radix_Clause Flag83
341 -- Machine_Radix_10 Flag84
342 -- Is_Atomic Flag85
343 -- Has_Atomic_Components Flag86
344 -- Has_Volatile_Components Flag87
345 -- Discard_Names Flag88
346 -- Is_Interrupt_Handler Flag89
347 -- Returns_By_Ref Flag90
349 -- Is_Itype Flag91
350 -- Size_Known_At_Compile_Time Flag92
351 -- Reverse_Storage_Order Flag93
352 -- Is_Generic_Actual_Type Flag94
353 -- Uses_Sec_Stack Flag95
354 -- Warnings_Off Flag96
355 -- Is_Controlling_Formal Flag97
356 -- Has_Controlling_Result Flag98
357 -- Is_Exported Flag99
358 -- Has_Specified_Layout Flag100
360 -- Has_Nested_Block_With_Handler Flag101
361 -- Is_Called Flag102
362 -- Is_Completely_Hidden Flag103
363 -- Address_Taken Flag104
364 -- Suppress_Initialization Flag105
365 -- Is_Limited_Composite Flag106
366 -- Is_Private_Composite Flag107
367 -- Default_Expressions_Processed Flag108
368 -- Is_Non_Static_Subtype Flag109
369 -- Has_External_Tag_Rep_Clause Flag110
371 -- Is_Formal_Subprogram Flag111
372 -- Is_Renaming_Of_Object Flag112
373 -- No_Return Flag113
374 -- Delay_Cleanups Flag114
375 -- Never_Set_In_Source Flag115
376 -- Is_Visible_Child_Unit Flag116
377 -- Is_Unchecked_Union Flag117
378 -- Is_For_Access_Subtype Flag118
379 -- Has_Convention_Pragma Flag119
380 -- Has_Primitive_Operations Flag120
382 -- Has_Pragma_Pack Flag121
383 -- Is_Bit_Packed_Array Flag122
384 -- Has_Unchecked_Union Flag123
385 -- Is_Eliminated Flag124
386 -- C_Pass_By_Copy Flag125
387 -- Is_Instantiated Flag126
388 -- Is_Valued_Procedure Flag127
389 -- (used for Component_Alignment) Flag128
390 -- (used for Component_Alignment) Flag129
391 -- Is_Generic_Instance Flag130
393 -- No_Pool_Assigned Flag131
394 -- Is_AST_Entry Flag132
395 -- Is_VMS_Exception Flag133
396 -- Is_Optional_Parameter Flag134
397 -- Has_Aliased_Components Flag135
398 -- No_Strict_Aliasing Flag136
399 -- Is_Machine_Code_Subprogram Flag137
400 -- Is_Packed_Array_Type Flag138
401 -- Has_Biased_Representation Flag139
402 -- Has_Complex_Representation Flag140
404 -- Is_Constr_Subt_For_UN_Aliased Flag141
405 -- Has_Missing_Return Flag142
406 -- Has_Recursive_Call Flag143
407 -- Is_Unsigned_Type Flag144
408 -- Strict_Alignment Flag145
409 -- Is_Abstract_Type Flag146
410 -- Needs_Debug_Info Flag147
411 -- Suppress_Elaboration_Warnings Flag148
412 -- Is_Compilation_Unit Flag149
413 -- Has_Pragma_Elaborate_Body Flag150
415 -- Has_Private_Ancestor Flag151
416 -- Entry_Accepted Flag152
417 -- Is_Obsolescent Flag153
418 -- Has_Per_Object_Constraint Flag154
419 -- Has_Private_Declaration Flag155
420 -- Referenced Flag156
421 -- Has_Pragma_Inline Flag157
422 -- Finalize_Storage_Only Flag158
423 -- From_With_Type Flag159
424 -- Is_Package_Body_Entity Flag160
426 -- Has_Qualified_Name Flag161
427 -- Nonzero_Is_True Flag162
428 -- Is_True_Constant Flag163
429 -- Reverse_Bit_Order Flag164
430 -- Suppress_Style_Checks Flag165
431 -- Debug_Info_Off Flag166
432 -- Sec_Stack_Needed_For_Return Flag167
433 -- Materialize_Entity Flag168
434 -- Has_Pragma_Thread_Local_Storage Flag169
435 -- Is_Known_Valid Flag170
437 -- Is_Hidden_Open_Scope Flag171
438 -- Has_Object_Size_Clause Flag172
439 -- Has_Fully_Qualified_Name Flag173
440 -- Elaboration_Entity_Required Flag174
441 -- Has_Forward_Instantiation Flag175
442 -- Is_Discrim_SO_Function Flag176
443 -- Size_Depends_On_Discriminant Flag177
444 -- Is_Null_Init_Proc Flag178
445 -- Has_Pragma_Pure_Function Flag179
446 -- Has_Pragma_Unreferenced Flag180
448 -- Has_Contiguous_Rep Flag181
449 -- Has_Xref_Entry Flag182
450 -- Must_Be_On_Byte_Boundary Flag183
451 -- Has_Stream_Size_Clause Flag184
452 -- Is_Ada_2005_Only Flag185
453 -- Is_Interface Flag186
454 -- Has_Constrained_Partial_View Flag187
455 -- Is_Pure_Unit_Access_Type Flag189
456 -- Has_Specified_Stream_Input Flag190
458 -- Has_Specified_Stream_Output Flag191
459 -- Has_Specified_Stream_Read Flag192
460 -- Has_Specified_Stream_Write Flag193
461 -- Is_Local_Anonymous_Access Flag194
462 -- Is_Primitive_Wrapper Flag195
463 -- Was_Hidden Flag196
464 -- Is_Limited_Interface Flag197
465 -- Has_Pragma_Ordered Flag198
466 -- Is_Ada_2012_Only Flag199
468 -- Has_Delayed_Aspects Flag200
469 -- Itype_Printed Flag202
470 -- Has_Pragma_Pure Flag203
471 -- Is_Known_Null Flag204
472 -- Low_Bound_Tested Flag205
473 -- Is_Visible_Formal Flag206
474 -- Known_To_Have_Preelab_Init Flag207
475 -- Must_Have_Preelab_Init Flag208
476 -- Is_Return_Object Flag209
477 -- Elaborate_Body_Desirable Flag210
479 -- Has_Static_Discriminants Flag211
480 -- Has_Pragma_Unreferenced_Objects Flag212
481 -- Requires_Overriding Flag213
482 -- Has_RACW Flag214
483 -- Has_Up_Level_Access Flag215
484 -- Universal_Aliasing Flag216
485 -- Suppress_Value_Tracking_On_Call Flag217
486 -- Is_Primitive Flag218
487 -- Has_Initial_Value Flag219
488 -- Has_Dispatch_Table Flag220
490 -- Has_Pragma_Preelab_Init Flag221
491 -- Used_As_Generic_Actual Flag222
492 -- Is_Descendent_Of_Address Flag223
493 -- Is_Raised Flag224
494 -- Is_Thunk Flag225
495 -- Is_Only_Out_Parameter Flag226
496 -- Referenced_As_Out_Parameter Flag227
497 -- Has_Thunks Flag228
498 -- Can_Use_Internal_Rep Flag229
499 -- Has_Pragma_Inline_Always Flag230
501 -- Renamed_In_Spec Flag231
502 -- Has_Invariants Flag232
503 -- Has_Pragma_Unmodified Flag233
504 -- Is_Dispatch_Table_Entity Flag234
505 -- Is_Trivial_Subprogram Flag235
506 -- Warnings_Off_Used Flag236
507 -- Warnings_Off_Used_Unmodified Flag237
508 -- Warnings_Off_Used_Unreferenced Flag238
509 -- OK_To_Reorder_Components Flag239
510 -- Has_Postconditions Flag240
512 -- Optimize_Alignment_Space Flag241
513 -- Optimize_Alignment_Time Flag242
514 -- Overlays_Constant Flag243
515 -- Is_RACW_Stub_Type Flag244
516 -- Is_Private_Primitive Flag245
517 -- Is_Underlying_Record_View Flag246
518 -- OK_To_Rename Flag247
519 -- Has_Inheritable_Invariants Flag248
520 -- Is_Safe_To_Reevaluate Flag249
521 -- Has_Predicates Flag250
523 -- Has_Implicit_Dereference Flag251
524 -- Is_Processed_Transient Flag252
525 -- Has_Anonymous_Master Flag253
526 -- Is_Implementation_Defined Flag254
528 -- (unused) Flag188
529 -- (unused) Flag201
531 -----------------------
532 -- Local subprograms --
533 -----------------------
535 function Rep_Clause (Id : E; Rep_Name : Name_Id) return N;
536 -- Returns the attribute definition clause for Id whose name is Rep_Name.
537 -- Returns Empty if no matching attribute definition clause found for Id.
539 ---------------
540 -- Float_Rep --
541 ---------------
543 function Float_Rep (Id : E) return F is
544 pragma Assert (Is_Floating_Point_Type (Id));
545 begin
546 return F'Val (UI_To_Int (Uint10 (Base_Type (Id))));
547 end Float_Rep;
549 ----------------
550 -- Rep_Clause --
551 ----------------
553 function Rep_Clause (Id : E; Rep_Name : Name_Id) return N is
554 Ritem : Node_Id;
556 begin
557 Ritem := First_Rep_Item (Id);
558 while Present (Ritem) loop
559 if Nkind (Ritem) = N_Attribute_Definition_Clause
560 and then Chars (Ritem) = Rep_Name
561 then
562 return Ritem;
563 else
564 Next_Rep_Item (Ritem);
565 end if;
566 end loop;
568 return Empty;
569 end Rep_Clause;
571 --------------------------------
572 -- Attribute Access Functions --
573 --------------------------------
575 function Accept_Address (Id : E) return L is
576 begin
577 return Elist21 (Id);
578 end Accept_Address;
580 function Access_Disp_Table (Id : E) return L is
581 begin
582 pragma Assert (Ekind_In (Id, E_Record_Type,
583 E_Record_Subtype));
584 return Elist16 (Implementation_Base_Type (Id));
585 end Access_Disp_Table;
587 function Actual_Subtype (Id : E) return E is
588 begin
589 pragma Assert
590 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
591 or else Is_Formal (Id));
592 return Node17 (Id);
593 end Actual_Subtype;
595 function Address_Taken (Id : E) return B is
596 begin
597 return Flag104 (Id);
598 end Address_Taken;
600 function Alias (Id : E) return E is
601 begin
602 pragma Assert
603 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
604 return Node18 (Id);
605 end Alias;
607 function Alignment (Id : E) return U is
608 begin
609 pragma Assert (Is_Type (Id)
610 or else Is_Formal (Id)
611 or else Ekind_In (Id, E_Loop_Parameter,
612 E_Constant,
613 E_Exception,
614 E_Variable));
615 return Uint14 (Id);
616 end Alignment;
618 function Associated_Formal_Package (Id : E) return E is
619 begin
620 pragma Assert (Ekind (Id) = E_Package);
621 return Node12 (Id);
622 end Associated_Formal_Package;
624 function Associated_Node_For_Itype (Id : E) return N is
625 begin
626 return Node8 (Id);
627 end Associated_Node_For_Itype;
629 function Associated_Storage_Pool (Id : E) return E is
630 begin
631 pragma Assert (Is_Access_Type (Id));
632 return Node22 (Root_Type (Id));
633 end Associated_Storage_Pool;
635 function Barrier_Function (Id : E) return N is
636 begin
637 pragma Assert (Is_Entry (Id));
638 return Node12 (Id);
639 end Barrier_Function;
641 function Block_Node (Id : E) return N is
642 begin
643 pragma Assert (Ekind (Id) = E_Block);
644 return Node11 (Id);
645 end Block_Node;
647 function Body_Entity (Id : E) return E is
648 begin
649 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
650 return Node19 (Id);
651 end Body_Entity;
653 function Body_Needed_For_SAL (Id : E) return B is
654 begin
655 pragma Assert
656 (Ekind (Id) = E_Package
657 or else Is_Subprogram (Id)
658 or else Is_Generic_Unit (Id));
659 return Flag40 (Id);
660 end Body_Needed_For_SAL;
662 function C_Pass_By_Copy (Id : E) return B is
663 begin
664 pragma Assert (Is_Record_Type (Id));
665 return Flag125 (Implementation_Base_Type (Id));
666 end C_Pass_By_Copy;
668 function Can_Never_Be_Null (Id : E) return B is
669 begin
670 return Flag38 (Id);
671 end Can_Never_Be_Null;
673 function Checks_May_Be_Suppressed (Id : E) return B is
674 begin
675 return Flag31 (Id);
676 end Checks_May_Be_Suppressed;
678 function Class_Wide_Type (Id : E) return E is
679 begin
680 pragma Assert (Is_Type (Id));
681 return Node9 (Id);
682 end Class_Wide_Type;
684 function Cloned_Subtype (Id : E) return E is
685 begin
686 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
687 return Node16 (Id);
688 end Cloned_Subtype;
690 function Component_Bit_Offset (Id : E) return U is
691 begin
692 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
693 return Uint11 (Id);
694 end Component_Bit_Offset;
696 function Component_Clause (Id : E) return N is
697 begin
698 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
699 return Node13 (Id);
700 end Component_Clause;
702 function Component_Size (Id : E) return U is
703 begin
704 pragma Assert (Is_Array_Type (Id));
705 return Uint22 (Implementation_Base_Type (Id));
706 end Component_Size;
708 function Component_Type (Id : E) return E is
709 begin
710 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
711 return Node20 (Implementation_Base_Type (Id));
712 end Component_Type;
714 function Corresponding_Concurrent_Type (Id : E) return E is
715 begin
716 pragma Assert (Ekind (Id) = E_Record_Type);
717 return Node18 (Id);
718 end Corresponding_Concurrent_Type;
720 function Corresponding_Discriminant (Id : E) return E is
721 begin
722 pragma Assert (Ekind (Id) = E_Discriminant);
723 return Node19 (Id);
724 end Corresponding_Discriminant;
726 function Corresponding_Equality (Id : E) return E is
727 begin
728 pragma Assert
729 (Ekind (Id) = E_Function
730 and then not Comes_From_Source (Id)
731 and then Chars (Id) = Name_Op_Ne);
732 return Node13 (Id);
733 end Corresponding_Equality;
735 function Corresponding_Protected_Entry (Id : E) return E is
736 begin
737 pragma Assert (Ekind (Id) = E_Subprogram_Body);
738 return Node18 (Id);
739 end Corresponding_Protected_Entry;
741 function Corresponding_Record_Type (Id : E) return E is
742 begin
743 pragma Assert (Is_Concurrent_Type (Id));
744 return Node18 (Id);
745 end Corresponding_Record_Type;
747 function Corresponding_Remote_Type (Id : E) return E is
748 begin
749 return Node22 (Id);
750 end Corresponding_Remote_Type;
752 function Current_Use_Clause (Id : E) return E is
753 begin
754 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
755 return Node27 (Id);
756 end Current_Use_Clause;
758 function Current_Value (Id : E) return N is
759 begin
760 pragma Assert (Ekind (Id) in Object_Kind);
761 return Node9 (Id);
762 end Current_Value;
764 function CR_Discriminant (Id : E) return E is
765 begin
766 return Node23 (Id);
767 end CR_Discriminant;
769 function Debug_Info_Off (Id : E) return B is
770 begin
771 return Flag166 (Id);
772 end Debug_Info_Off;
774 function Debug_Renaming_Link (Id : E) return E is
775 begin
776 return Node25 (Id);
777 end Debug_Renaming_Link;
779 function Default_Aspect_Component_Value (Id : E) return N is
780 begin
781 pragma Assert (Is_Array_Type (Id));
782 return Node19 (Id);
783 end Default_Aspect_Component_Value;
785 function Default_Aspect_Value (Id : E) return N is
786 begin
787 pragma Assert (Is_Scalar_Type (Id));
788 return Node19 (Id);
789 end Default_Aspect_Value;
791 function Default_Expr_Function (Id : E) return E is
792 begin
793 pragma Assert (Is_Formal (Id));
794 return Node21 (Id);
795 end Default_Expr_Function;
797 function Default_Expressions_Processed (Id : E) return B is
798 begin
799 return Flag108 (Id);
800 end Default_Expressions_Processed;
802 function Default_Value (Id : E) return N is
803 begin
804 pragma Assert (Is_Formal (Id));
805 return Node20 (Id);
806 end Default_Value;
808 function Delay_Cleanups (Id : E) return B is
809 begin
810 return Flag114 (Id);
811 end Delay_Cleanups;
813 function Delay_Subprogram_Descriptors (Id : E) return B is
814 begin
815 return Flag50 (Id);
816 end Delay_Subprogram_Descriptors;
818 function Delta_Value (Id : E) return R is
819 begin
820 pragma Assert (Is_Fixed_Point_Type (Id));
821 return Ureal18 (Id);
822 end Delta_Value;
824 function Dependent_Instances (Id : E) return L is
825 begin
826 pragma Assert (Is_Generic_Instance (Id));
827 return Elist8 (Id);
828 end Dependent_Instances;
830 function Depends_On_Private (Id : E) return B is
831 begin
832 pragma Assert (Nkind (Id) in N_Entity);
833 return Flag14 (Id);
834 end Depends_On_Private;
836 function Digits_Value (Id : E) return U is
837 begin
838 pragma Assert
839 (Is_Floating_Point_Type (Id)
840 or else Is_Decimal_Fixed_Point_Type (Id));
841 return Uint17 (Id);
842 end Digits_Value;
844 function Direct_Primitive_Operations (Id : E) return L is
845 begin
846 pragma Assert (Is_Tagged_Type (Id));
847 return Elist10 (Id);
848 end Direct_Primitive_Operations;
850 function Directly_Designated_Type (Id : E) return E is
851 begin
852 pragma Assert (Is_Access_Type (Id));
853 return Node20 (Id);
854 end Directly_Designated_Type;
856 function Discard_Names (Id : E) return B is
857 begin
858 return Flag88 (Id);
859 end Discard_Names;
861 function Discriminal (Id : E) return E is
862 begin
863 pragma Assert (Ekind (Id) = E_Discriminant);
864 return Node17 (Id);
865 end Discriminal;
867 function Discriminal_Link (Id : E) return N is
868 begin
869 return Node10 (Id);
870 end Discriminal_Link;
872 function Discriminant_Checking_Func (Id : E) return E is
873 begin
874 pragma Assert (Ekind (Id) = E_Component);
875 return Node20 (Id);
876 end Discriminant_Checking_Func;
878 function Discriminant_Constraint (Id : E) return L is
879 begin
880 pragma Assert (Is_Composite_Type (Id) and then Has_Discriminants (Id));
881 return Elist21 (Id);
882 end Discriminant_Constraint;
884 function Discriminant_Default_Value (Id : E) return N is
885 begin
886 pragma Assert (Ekind (Id) = E_Discriminant);
887 return Node20 (Id);
888 end Discriminant_Default_Value;
890 function Discriminant_Number (Id : E) return U is
891 begin
892 pragma Assert (Ekind (Id) = E_Discriminant);
893 return Uint15 (Id);
894 end Discriminant_Number;
896 function Dispatch_Table_Wrappers (Id : E) return L is
897 begin
898 pragma Assert (Ekind_In (Id, E_Record_Type,
899 E_Record_Subtype));
900 return Elist26 (Implementation_Base_Type (Id));
901 end Dispatch_Table_Wrappers;
903 function DT_Entry_Count (Id : E) return U is
904 begin
905 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
906 return Uint15 (Id);
907 end DT_Entry_Count;
909 function DT_Offset_To_Top_Func (Id : E) return E is
910 begin
911 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
912 return Node25 (Id);
913 end DT_Offset_To_Top_Func;
915 function DT_Position (Id : E) return U is
916 begin
917 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
918 and then Present (DTC_Entity (Id)));
919 return Uint15 (Id);
920 end DT_Position;
922 function DTC_Entity (Id : E) return E is
923 begin
924 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
925 return Node16 (Id);
926 end DTC_Entity;
928 function Elaborate_Body_Desirable (Id : E) return B is
929 begin
930 pragma Assert (Ekind (Id) = E_Package);
931 return Flag210 (Id);
932 end Elaborate_Body_Desirable;
934 function Elaboration_Entity (Id : E) return E is
935 begin
936 pragma Assert
937 (Is_Subprogram (Id)
938 or else
939 Ekind (Id) = E_Package
940 or else
941 Is_Generic_Unit (Id));
942 return Node13 (Id);
943 end Elaboration_Entity;
945 function Elaboration_Entity_Required (Id : E) return B is
946 begin
947 pragma Assert
948 (Is_Subprogram (Id)
949 or else
950 Ekind (Id) = E_Package
951 or else
952 Is_Generic_Unit (Id));
953 return Flag174 (Id);
954 end Elaboration_Entity_Required;
956 function Enclosing_Scope (Id : E) return E is
957 begin
958 return Node18 (Id);
959 end Enclosing_Scope;
961 function Entry_Accepted (Id : E) return B is
962 begin
963 pragma Assert (Is_Entry (Id));
964 return Flag152 (Id);
965 end Entry_Accepted;
967 function Entry_Bodies_Array (Id : E) return E is
968 begin
969 return Node15 (Id);
970 end Entry_Bodies_Array;
972 function Entry_Cancel_Parameter (Id : E) return E is
973 begin
974 return Node23 (Id);
975 end Entry_Cancel_Parameter;
977 function Entry_Component (Id : E) return E is
978 begin
979 return Node11 (Id);
980 end Entry_Component;
982 function Entry_Formal (Id : E) return E is
983 begin
984 return Node16 (Id);
985 end Entry_Formal;
987 function Entry_Index_Constant (Id : E) return N is
988 begin
989 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
990 return Node18 (Id);
991 end Entry_Index_Constant;
993 function Contract (Id : E) return N is
994 begin
995 pragma Assert
996 (Ekind_In (Id, E_Entry, E_Entry_Family)
997 or else Is_Subprogram (Id)
998 or else Is_Generic_Subprogram (Id));
999 return Node24 (Id);
1000 end Contract;
1002 function Entry_Parameters_Type (Id : E) return E is
1003 begin
1004 return Node15 (Id);
1005 end Entry_Parameters_Type;
1007 function Enum_Pos_To_Rep (Id : E) return E is
1008 begin
1009 pragma Assert (Ekind (Id) = E_Enumeration_Type);
1010 return Node23 (Id);
1011 end Enum_Pos_To_Rep;
1013 function Enumeration_Pos (Id : E) return Uint is
1014 begin
1015 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1016 return Uint11 (Id);
1017 end Enumeration_Pos;
1019 function Enumeration_Rep (Id : E) return U is
1020 begin
1021 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1022 return Uint12 (Id);
1023 end Enumeration_Rep;
1025 function Enumeration_Rep_Expr (Id : E) return N is
1026 begin
1027 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1028 return Node22 (Id);
1029 end Enumeration_Rep_Expr;
1031 function Equivalent_Type (Id : E) return E is
1032 begin
1033 pragma Assert
1034 (Ekind_In (Id, E_Class_Wide_Type,
1035 E_Class_Wide_Subtype,
1036 E_Access_Protected_Subprogram_Type,
1037 E_Anonymous_Access_Protected_Subprogram_Type,
1038 E_Access_Subprogram_Type,
1039 E_Exception_Type));
1040 return Node18 (Id);
1041 end Equivalent_Type;
1043 function Esize (Id : E) return Uint is
1044 begin
1045 return Uint12 (Id);
1046 end Esize;
1048 function Exception_Code (Id : E) return Uint is
1049 begin
1050 pragma Assert (Ekind (Id) = E_Exception);
1051 return Uint22 (Id);
1052 end Exception_Code;
1054 function Extra_Accessibility (Id : E) return E is
1055 begin
1056 pragma Assert
1057 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
1058 return Node13 (Id);
1059 end Extra_Accessibility;
1061 function Extra_Accessibility_Of_Result (Id : E) return E is
1062 begin
1063 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
1064 return Node19 (Id);
1065 end Extra_Accessibility_Of_Result;
1067 function Extra_Constrained (Id : E) return E is
1068 begin
1069 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
1070 return Node23 (Id);
1071 end Extra_Constrained;
1073 function Extra_Formal (Id : E) return E is
1074 begin
1075 return Node15 (Id);
1076 end Extra_Formal;
1078 function Extra_Formals (Id : E) return E is
1079 begin
1080 pragma Assert
1081 (Is_Overloadable (Id)
1082 or else Ekind_In (Id, E_Entry_Family,
1083 E_Subprogram_Body,
1084 E_Subprogram_Type));
1085 return Node28 (Id);
1086 end Extra_Formals;
1088 function Can_Use_Internal_Rep (Id : E) return B is
1089 begin
1090 pragma Assert (Is_Access_Subprogram_Type (Base_Type (Id)));
1091 return Flag229 (Base_Type (Id));
1092 end Can_Use_Internal_Rep;
1094 function Finalization_Master (Id : E) return E is
1095 begin
1096 pragma Assert (Is_Access_Type (Id));
1097 return Node23 (Root_Type (Id));
1098 end Finalization_Master;
1100 function Finalize_Storage_Only (Id : E) return B is
1101 begin
1102 pragma Assert (Is_Type (Id));
1103 return Flag158 (Base_Type (Id));
1104 end Finalize_Storage_Only;
1106 function Finalizer (Id : E) return E is
1107 begin
1108 pragma Assert
1109 (Ekind (Id) = E_Package
1110 or else Ekind (Id) = E_Package_Body);
1111 return Node24 (Id);
1112 end Finalizer;
1114 function First_Entity (Id : E) return E is
1115 begin
1116 return Node17 (Id);
1117 end First_Entity;
1119 function First_Exit_Statement (Id : E) return N is
1120 begin
1121 pragma Assert (Ekind (Id) = E_Loop);
1122 return Node8 (Id);
1123 end First_Exit_Statement;
1125 function First_Index (Id : E) return N is
1126 begin
1127 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
1128 return Node17 (Id);
1129 end First_Index;
1131 function First_Literal (Id : E) return E is
1132 begin
1133 pragma Assert (Is_Enumeration_Type (Id));
1134 return Node17 (Id);
1135 end First_Literal;
1137 function First_Optional_Parameter (Id : E) return E is
1138 begin
1139 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
1140 return Node14 (Id);
1141 end First_Optional_Parameter;
1143 function First_Private_Entity (Id : E) return E is
1144 begin
1145 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
1146 or else Ekind (Id) in Concurrent_Kind);
1147 return Node16 (Id);
1148 end First_Private_Entity;
1150 function First_Rep_Item (Id : E) return E is
1151 begin
1152 return Node6 (Id);
1153 end First_Rep_Item;
1155 function Freeze_Node (Id : E) return N is
1156 begin
1157 return Node7 (Id);
1158 end Freeze_Node;
1160 function From_With_Type (Id : E) return B is
1161 begin
1162 return Flag159 (Id);
1163 end From_With_Type;
1165 function Full_View (Id : E) return E is
1166 begin
1167 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
1168 return Node11 (Id);
1169 end Full_View;
1171 function Generic_Homonym (Id : E) return E is
1172 begin
1173 pragma Assert (Ekind (Id) = E_Generic_Package);
1174 return Node11 (Id);
1175 end Generic_Homonym;
1177 function Generic_Renamings (Id : E) return L is
1178 begin
1179 return Elist23 (Id);
1180 end Generic_Renamings;
1182 function Handler_Records (Id : E) return S is
1183 begin
1184 return List10 (Id);
1185 end Handler_Records;
1187 function Has_Aliased_Components (Id : E) return B is
1188 begin
1189 return Flag135 (Implementation_Base_Type (Id));
1190 end Has_Aliased_Components;
1192 function Has_Alignment_Clause (Id : E) return B is
1193 begin
1194 return Flag46 (Id);
1195 end Has_Alignment_Clause;
1197 function Has_All_Calls_Remote (Id : E) return B is
1198 begin
1199 return Flag79 (Id);
1200 end Has_All_Calls_Remote;
1202 function Has_Anonymous_Master (Id : E) return B is
1203 begin
1204 pragma Assert
1205 (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
1206 return Flag253 (Id);
1207 end Has_Anonymous_Master;
1209 function Has_Atomic_Components (Id : E) return B is
1210 begin
1211 return Flag86 (Implementation_Base_Type (Id));
1212 end Has_Atomic_Components;
1214 function Has_Biased_Representation (Id : E) return B is
1215 begin
1216 return Flag139 (Id);
1217 end Has_Biased_Representation;
1219 function Has_Completion (Id : E) return B is
1220 begin
1221 return Flag26 (Id);
1222 end Has_Completion;
1224 function Has_Completion_In_Body (Id : E) return B is
1225 begin
1226 pragma Assert (Is_Type (Id));
1227 return Flag71 (Id);
1228 end Has_Completion_In_Body;
1230 function Has_Complex_Representation (Id : E) return B is
1231 begin
1232 pragma Assert (Is_Type (Id));
1233 return Flag140 (Implementation_Base_Type (Id));
1234 end Has_Complex_Representation;
1236 function Has_Component_Size_Clause (Id : E) return B is
1237 begin
1238 pragma Assert (Is_Array_Type (Id));
1239 return Flag68 (Implementation_Base_Type (Id));
1240 end Has_Component_Size_Clause;
1242 function Has_Constrained_Partial_View (Id : E) return B is
1243 begin
1244 pragma Assert (Is_Type (Id));
1245 return Flag187 (Id);
1246 end Has_Constrained_Partial_View;
1248 function Has_Controlled_Component (Id : E) return B is
1249 begin
1250 return Flag43 (Base_Type (Id));
1251 end Has_Controlled_Component;
1253 function Has_Contiguous_Rep (Id : E) return B is
1254 begin
1255 return Flag181 (Id);
1256 end Has_Contiguous_Rep;
1258 function Has_Controlling_Result (Id : E) return B is
1259 begin
1260 return Flag98 (Id);
1261 end Has_Controlling_Result;
1263 function Has_Convention_Pragma (Id : E) return B is
1264 begin
1265 return Flag119 (Id);
1266 end Has_Convention_Pragma;
1268 function Has_Default_Aspect (Id : E) return B is
1269 begin
1270 return Flag39 (Base_Type (Id));
1271 end Has_Default_Aspect;
1273 function Has_Delayed_Aspects (Id : E) return B is
1274 begin
1275 pragma Assert (Nkind (Id) in N_Entity);
1276 return Flag200 (Id);
1277 end Has_Delayed_Aspects;
1279 function Has_Delayed_Freeze (Id : E) return B is
1280 begin
1281 pragma Assert (Nkind (Id) in N_Entity);
1282 return Flag18 (Id);
1283 end Has_Delayed_Freeze;
1285 function Has_Discriminants (Id : E) return B is
1286 begin
1287 pragma Assert (Nkind (Id) in N_Entity);
1288 return Flag5 (Id);
1289 end Has_Discriminants;
1291 function Has_Dispatch_Table (Id : E) return B is
1292 begin
1293 pragma Assert (Is_Tagged_Type (Id));
1294 return Flag220 (Id);
1295 end Has_Dispatch_Table;
1297 function Has_Enumeration_Rep_Clause (Id : E) return B is
1298 begin
1299 pragma Assert (Is_Enumeration_Type (Id));
1300 return Flag66 (Id);
1301 end Has_Enumeration_Rep_Clause;
1303 function Has_Exit (Id : E) return B is
1304 begin
1305 return Flag47 (Id);
1306 end Has_Exit;
1308 function Has_External_Tag_Rep_Clause (Id : E) return B is
1309 begin
1310 pragma Assert (Is_Tagged_Type (Id));
1311 return Flag110 (Id);
1312 end Has_External_Tag_Rep_Clause;
1314 function Has_Forward_Instantiation (Id : E) return B is
1315 begin
1316 return Flag175 (Id);
1317 end Has_Forward_Instantiation;
1319 function Has_Fully_Qualified_Name (Id : E) return B is
1320 begin
1321 return Flag173 (Id);
1322 end Has_Fully_Qualified_Name;
1324 function Has_Gigi_Rep_Item (Id : E) return B is
1325 begin
1326 return Flag82 (Id);
1327 end Has_Gigi_Rep_Item;
1329 function Has_Homonym (Id : E) return B is
1330 begin
1331 return Flag56 (Id);
1332 end Has_Homonym;
1334 function Has_Implicit_Dereference (Id : E) return B is
1335 begin
1336 return Flag251 (Id);
1337 end Has_Implicit_Dereference;
1339 function Has_Inheritable_Invariants (Id : E) return B is
1340 begin
1341 pragma Assert (Is_Type (Id));
1342 return Flag248 (Id);
1343 end Has_Inheritable_Invariants;
1345 function Has_Initial_Value (Id : E) return B is
1346 begin
1347 pragma Assert (Ekind (Id) = E_Variable or else Is_Formal (Id));
1348 return Flag219 (Id);
1349 end Has_Initial_Value;
1351 function Has_Invariants (Id : E) return B is
1352 begin
1353 pragma Assert (Is_Type (Id)
1354 or else Ekind (Id) = E_Procedure
1355 or else Ekind (Id) = E_Generic_Procedure);
1356 return Flag232 (Id);
1357 end Has_Invariants;
1359 function Has_Machine_Radix_Clause (Id : E) return B is
1360 begin
1361 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
1362 return Flag83 (Id);
1363 end Has_Machine_Radix_Clause;
1365 function Has_Master_Entity (Id : E) return B is
1366 begin
1367 return Flag21 (Id);
1368 end Has_Master_Entity;
1370 function Has_Missing_Return (Id : E) return B is
1371 begin
1372 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
1373 return Flag142 (Id);
1374 end Has_Missing_Return;
1376 function Has_Nested_Block_With_Handler (Id : E) return B is
1377 begin
1378 return Flag101 (Id);
1379 end Has_Nested_Block_With_Handler;
1381 function Has_Non_Standard_Rep (Id : E) return B is
1382 begin
1383 return Flag75 (Implementation_Base_Type (Id));
1384 end Has_Non_Standard_Rep;
1386 function Has_Object_Size_Clause (Id : E) return B is
1387 begin
1388 pragma Assert (Is_Type (Id));
1389 return Flag172 (Id);
1390 end Has_Object_Size_Clause;
1392 function Has_Per_Object_Constraint (Id : E) return B is
1393 begin
1394 return Flag154 (Id);
1395 end Has_Per_Object_Constraint;
1397 function Has_Postconditions (Id : E) return B is
1398 begin
1399 pragma Assert (Is_Subprogram (Id));
1400 return Flag240 (Id);
1401 end Has_Postconditions;
1403 function Has_Pragma_Controlled (Id : E) return B is
1404 begin
1405 pragma Assert (Is_Access_Type (Id));
1406 return Flag27 (Implementation_Base_Type (Id));
1407 end Has_Pragma_Controlled;
1409 function Has_Pragma_Elaborate_Body (Id : E) return B is
1410 begin
1411 return Flag150 (Id);
1412 end Has_Pragma_Elaborate_Body;
1414 function Has_Pragma_Inline (Id : E) return B is
1415 begin
1416 return Flag157 (Id);
1417 end Has_Pragma_Inline;
1419 function Has_Pragma_Inline_Always (Id : E) return B is
1420 begin
1421 return Flag230 (Id);
1422 end Has_Pragma_Inline_Always;
1424 function Has_Pragma_Ordered (Id : E) return B is
1425 begin
1426 pragma Assert (Is_Enumeration_Type (Id));
1427 return Flag198 (Implementation_Base_Type (Id));
1428 end Has_Pragma_Ordered;
1430 function Has_Pragma_Pack (Id : E) return B is
1431 begin
1432 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
1433 return Flag121 (Implementation_Base_Type (Id));
1434 end Has_Pragma_Pack;
1436 function Has_Pragma_Preelab_Init (Id : E) return B is
1437 begin
1438 return Flag221 (Id);
1439 end Has_Pragma_Preelab_Init;
1441 function Has_Pragma_Pure (Id : E) return B is
1442 begin
1443 return Flag203 (Id);
1444 end Has_Pragma_Pure;
1446 function Has_Pragma_Pure_Function (Id : E) return B is
1447 begin
1448 return Flag179 (Id);
1449 end Has_Pragma_Pure_Function;
1451 function Has_Pragma_Thread_Local_Storage (Id : E) return B is
1452 begin
1453 return Flag169 (Id);
1454 end Has_Pragma_Thread_Local_Storage;
1456 function Has_Pragma_Unmodified (Id : E) return B is
1457 begin
1458 return Flag233 (Id);
1459 end Has_Pragma_Unmodified;
1461 function Has_Pragma_Unreferenced (Id : E) return B is
1462 begin
1463 return Flag180 (Id);
1464 end Has_Pragma_Unreferenced;
1466 function Has_Pragma_Unreferenced_Objects (Id : E) return B is
1467 begin
1468 pragma Assert (Is_Type (Id));
1469 return Flag212 (Id);
1470 end Has_Pragma_Unreferenced_Objects;
1472 function Has_Predicates (Id : E) return B is
1473 begin
1474 return Flag250 (Id);
1475 end Has_Predicates;
1477 function Has_Primitive_Operations (Id : E) return B is
1478 begin
1479 pragma Assert (Is_Type (Id));
1480 return Flag120 (Base_Type (Id));
1481 end Has_Primitive_Operations;
1483 function Has_Private_Ancestor (Id : E) return B is
1484 begin
1485 return Flag151 (Id);
1486 end Has_Private_Ancestor;
1488 function Has_Private_Declaration (Id : E) return B is
1489 begin
1490 return Flag155 (Id);
1491 end Has_Private_Declaration;
1493 function Has_Qualified_Name (Id : E) return B is
1494 begin
1495 return Flag161 (Id);
1496 end Has_Qualified_Name;
1498 function Has_RACW (Id : E) return B is
1499 begin
1500 pragma Assert (Ekind (Id) = E_Package);
1501 return Flag214 (Id);
1502 end Has_RACW;
1504 function Has_Record_Rep_Clause (Id : E) return B is
1505 begin
1506 pragma Assert (Is_Record_Type (Id));
1507 return Flag65 (Implementation_Base_Type (Id));
1508 end Has_Record_Rep_Clause;
1510 function Has_Recursive_Call (Id : E) return B is
1511 begin
1512 pragma Assert (Is_Subprogram (Id));
1513 return Flag143 (Id);
1514 end Has_Recursive_Call;
1516 function Has_Size_Clause (Id : E) return B is
1517 begin
1518 return Flag29 (Id);
1519 end Has_Size_Clause;
1521 function Has_Small_Clause (Id : E) return B is
1522 begin
1523 return Flag67 (Id);
1524 end Has_Small_Clause;
1526 function Has_Specified_Layout (Id : E) return B is
1527 begin
1528 pragma Assert (Is_Type (Id));
1529 return Flag100 (Implementation_Base_Type (Id));
1530 end Has_Specified_Layout;
1532 function Has_Specified_Stream_Input (Id : E) return B is
1533 begin
1534 pragma Assert (Is_Type (Id));
1535 return Flag190 (Id);
1536 end Has_Specified_Stream_Input;
1538 function Has_Specified_Stream_Output (Id : E) return B is
1539 begin
1540 pragma Assert (Is_Type (Id));
1541 return Flag191 (Id);
1542 end Has_Specified_Stream_Output;
1544 function Has_Specified_Stream_Read (Id : E) return B is
1545 begin
1546 pragma Assert (Is_Type (Id));
1547 return Flag192 (Id);
1548 end Has_Specified_Stream_Read;
1550 function Has_Specified_Stream_Write (Id : E) return B is
1551 begin
1552 pragma Assert (Is_Type (Id));
1553 return Flag193 (Id);
1554 end Has_Specified_Stream_Write;
1556 function Has_Static_Discriminants (Id : E) return B is
1557 begin
1558 pragma Assert (Is_Type (Id));
1559 return Flag211 (Id);
1560 end Has_Static_Discriminants;
1562 function Has_Storage_Size_Clause (Id : E) return B is
1563 begin
1564 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
1565 return Flag23 (Implementation_Base_Type (Id));
1566 end Has_Storage_Size_Clause;
1568 function Has_Stream_Size_Clause (Id : E) return B is
1569 begin
1570 return Flag184 (Id);
1571 end Has_Stream_Size_Clause;
1573 function Has_Task (Id : E) return B is
1574 begin
1575 return Flag30 (Base_Type (Id));
1576 end Has_Task;
1578 function Has_Thunks (Id : E) return B is
1579 begin
1580 return Flag228 (Id);
1581 end Has_Thunks;
1583 function Has_Unchecked_Union (Id : E) return B is
1584 begin
1585 return Flag123 (Base_Type (Id));
1586 end Has_Unchecked_Union;
1588 function Has_Unknown_Discriminants (Id : E) return B is
1589 begin
1590 pragma Assert (Is_Type (Id));
1591 return Flag72 (Id);
1592 end Has_Unknown_Discriminants;
1594 function Has_Up_Level_Access (Id : E) return B is
1595 begin
1596 pragma Assert
1597 (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter));
1598 return Flag215 (Id);
1599 end Has_Up_Level_Access;
1601 function Has_Volatile_Components (Id : E) return B is
1602 begin
1603 return Flag87 (Implementation_Base_Type (Id));
1604 end Has_Volatile_Components;
1606 function Has_Xref_Entry (Id : E) return B is
1607 begin
1608 return Flag182 (Id);
1609 end Has_Xref_Entry;
1611 function Hiding_Loop_Variable (Id : E) return E is
1612 begin
1613 pragma Assert (Ekind (Id) = E_Variable);
1614 return Node8 (Id);
1615 end Hiding_Loop_Variable;
1617 function Homonym (Id : E) return E is
1618 begin
1619 return Node4 (Id);
1620 end Homonym;
1622 function Interface_Alias (Id : E) return E is
1623 begin
1624 pragma Assert (Is_Subprogram (Id));
1625 return Node25 (Id);
1626 end Interface_Alias;
1628 function Interfaces (Id : E) return L is
1629 begin
1630 pragma Assert (Is_Record_Type (Id));
1631 return Elist25 (Id);
1632 end Interfaces;
1634 function In_Package_Body (Id : E) return B is
1635 begin
1636 return Flag48 (Id);
1637 end In_Package_Body;
1639 function In_Private_Part (Id : E) return B is
1640 begin
1641 return Flag45 (Id);
1642 end In_Private_Part;
1644 function In_Use (Id : E) return B is
1645 begin
1646 pragma Assert (Nkind (Id) in N_Entity);
1647 return Flag8 (Id);
1648 end In_Use;
1650 function Inner_Instances (Id : E) return L is
1651 begin
1652 return Elist23 (Id);
1653 end Inner_Instances;
1655 function Interface_Name (Id : E) return N is
1656 begin
1657 return Node21 (Id);
1658 end Interface_Name;
1660 function Is_Abstract_Subprogram (Id : E) return B is
1661 begin
1662 pragma Assert (Is_Overloadable (Id));
1663 return Flag19 (Id);
1664 end Is_Abstract_Subprogram;
1666 function Is_Abstract_Type (Id : E) return B is
1667 begin
1668 pragma Assert (Is_Type (Id));
1669 return Flag146 (Id);
1670 end Is_Abstract_Type;
1672 function Is_Local_Anonymous_Access (Id : E) return B is
1673 begin
1674 pragma Assert (Is_Access_Type (Id));
1675 return Flag194 (Id);
1676 end Is_Local_Anonymous_Access;
1678 function Is_Access_Constant (Id : E) return B is
1679 begin
1680 pragma Assert (Is_Access_Type (Id));
1681 return Flag69 (Id);
1682 end Is_Access_Constant;
1684 function Is_Ada_2005_Only (Id : E) return B is
1685 begin
1686 return Flag185 (Id);
1687 end Is_Ada_2005_Only;
1689 function Is_Ada_2012_Only (Id : E) return B is
1690 begin
1691 return Flag199 (Id);
1692 end Is_Ada_2012_Only;
1694 function Is_Aliased (Id : E) return B is
1695 begin
1696 pragma Assert (Nkind (Id) in N_Entity);
1697 return Flag15 (Id);
1698 end Is_Aliased;
1700 function Is_AST_Entry (Id : E) return B is
1701 begin
1702 pragma Assert (Is_Entry (Id));
1703 return Flag132 (Id);
1704 end Is_AST_Entry;
1706 function Is_Asynchronous (Id : E) return B is
1707 begin
1708 pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id));
1709 return Flag81 (Id);
1710 end Is_Asynchronous;
1712 function Is_Atomic (Id : E) return B is
1713 begin
1714 return Flag85 (Id);
1715 end Is_Atomic;
1717 function Is_Bit_Packed_Array (Id : E) return B is
1718 begin
1719 return Flag122 (Implementation_Base_Type (Id));
1720 end Is_Bit_Packed_Array;
1722 function Is_Called (Id : E) return B is
1723 begin
1724 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
1725 return Flag102 (Id);
1726 end Is_Called;
1728 function Is_Character_Type (Id : E) return B is
1729 begin
1730 return Flag63 (Id);
1731 end Is_Character_Type;
1733 function Is_Child_Unit (Id : E) return B is
1734 begin
1735 return Flag73 (Id);
1736 end Is_Child_Unit;
1738 function Is_Class_Wide_Equivalent_Type (Id : E) return B is
1739 begin
1740 return Flag35 (Id);
1741 end Is_Class_Wide_Equivalent_Type;
1743 function Is_Compilation_Unit (Id : E) return B is
1744 begin
1745 return Flag149 (Id);
1746 end Is_Compilation_Unit;
1748 function Is_Completely_Hidden (Id : E) return B is
1749 begin
1750 pragma Assert (Ekind (Id) = E_Discriminant);
1751 return Flag103 (Id);
1752 end Is_Completely_Hidden;
1754 function Is_Constr_Subt_For_U_Nominal (Id : E) return B is
1755 begin
1756 return Flag80 (Id);
1757 end Is_Constr_Subt_For_U_Nominal;
1759 function Is_Constr_Subt_For_UN_Aliased (Id : E) return B is
1760 begin
1761 return Flag141 (Id);
1762 end Is_Constr_Subt_For_UN_Aliased;
1764 function Is_Constrained (Id : E) return B is
1765 begin
1766 pragma Assert (Nkind (Id) in N_Entity);
1767 return Flag12 (Id);
1768 end Is_Constrained;
1770 function Is_Constructor (Id : E) return B is
1771 begin
1772 return Flag76 (Id);
1773 end Is_Constructor;
1775 function Is_Controlled (Id : E) return B is
1776 begin
1777 return Flag42 (Base_Type (Id));
1778 end Is_Controlled;
1780 function Is_Controlling_Formal (Id : E) return B is
1781 begin
1782 pragma Assert (Is_Formal (Id));
1783 return Flag97 (Id);
1784 end Is_Controlling_Formal;
1786 function Is_CPP_Class (Id : E) return B is
1787 begin
1788 return Flag74 (Id);
1789 end Is_CPP_Class;
1791 function Is_Descendent_Of_Address (Id : E) return B is
1792 begin
1793 pragma Assert (Is_Type (Id));
1794 return Flag223 (Id);
1795 end Is_Descendent_Of_Address;
1797 function Is_Discrim_SO_Function (Id : E) return B is
1798 begin
1799 return Flag176 (Id);
1800 end Is_Discrim_SO_Function;
1802 function Is_Dispatch_Table_Entity (Id : E) return B is
1803 begin
1804 return Flag234 (Id);
1805 end Is_Dispatch_Table_Entity;
1807 function Is_Dispatching_Operation (Id : E) return B is
1808 begin
1809 pragma Assert (Nkind (Id) in N_Entity);
1810 return Flag6 (Id);
1811 end Is_Dispatching_Operation;
1813 function Is_Eliminated (Id : E) return B is
1814 begin
1815 return Flag124 (Id);
1816 end Is_Eliminated;
1818 function Is_Entry_Formal (Id : E) return B is
1819 begin
1820 return Flag52 (Id);
1821 end Is_Entry_Formal;
1823 function Is_Exported (Id : E) return B is
1824 begin
1825 return Flag99 (Id);
1826 end Is_Exported;
1828 function Is_First_Subtype (Id : E) return B is
1829 begin
1830 return Flag70 (Id);
1831 end Is_First_Subtype;
1833 function Is_For_Access_Subtype (Id : E) return B is
1834 begin
1835 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
1836 return Flag118 (Id);
1837 end Is_For_Access_Subtype;
1839 function Is_Formal_Subprogram (Id : E) return B is
1840 begin
1841 return Flag111 (Id);
1842 end Is_Formal_Subprogram;
1844 function Is_Frozen (Id : E) return B is
1845 begin
1846 return Flag4 (Id);
1847 end Is_Frozen;
1849 function Is_Generic_Actual_Type (Id : E) return B is
1850 begin
1851 pragma Assert (Is_Type (Id));
1852 return Flag94 (Id);
1853 end Is_Generic_Actual_Type;
1855 function Is_Generic_Instance (Id : E) return B is
1856 begin
1857 return Flag130 (Id);
1858 end Is_Generic_Instance;
1860 function Is_Generic_Type (Id : E) return B is
1861 begin
1862 pragma Assert (Nkind (Id) in N_Entity);
1863 return Flag13 (Id);
1864 end Is_Generic_Type;
1866 function Is_Hidden (Id : E) return B is
1867 begin
1868 return Flag57 (Id);
1869 end Is_Hidden;
1871 function Is_Hidden_Open_Scope (Id : E) return B is
1872 begin
1873 return Flag171 (Id);
1874 end Is_Hidden_Open_Scope;
1876 function Is_Immediately_Visible (Id : E) return B is
1877 begin
1878 pragma Assert (Nkind (Id) in N_Entity);
1879 return Flag7 (Id);
1880 end Is_Immediately_Visible;
1882 function Is_Implementation_Defined (Id : E) return B is
1883 begin
1884 return Flag254 (Id);
1885 end Is_Implementation_Defined;
1887 function Is_Imported (Id : E) return B is
1888 begin
1889 return Flag24 (Id);
1890 end Is_Imported;
1892 function Is_Inlined (Id : E) return B is
1893 begin
1894 return Flag11 (Id);
1895 end Is_Inlined;
1897 function Is_Interface (Id : E) return B is
1898 begin
1899 return Flag186 (Id);
1900 end Is_Interface;
1902 function Is_Instantiated (Id : E) return B is
1903 begin
1904 return Flag126 (Id);
1905 end Is_Instantiated;
1907 function Is_Internal (Id : E) return B is
1908 begin
1909 pragma Assert (Nkind (Id) in N_Entity);
1910 return Flag17 (Id);
1911 end Is_Internal;
1913 function Is_Interrupt_Handler (Id : E) return B is
1914 begin
1915 pragma Assert (Nkind (Id) in N_Entity);
1916 return Flag89 (Id);
1917 end Is_Interrupt_Handler;
1919 function Is_Intrinsic_Subprogram (Id : E) return B is
1920 begin
1921 return Flag64 (Id);
1922 end Is_Intrinsic_Subprogram;
1924 function Is_Itype (Id : E) return B is
1925 begin
1926 return Flag91 (Id);
1927 end Is_Itype;
1929 function Is_Known_Non_Null (Id : E) return B is
1930 begin
1931 return Flag37 (Id);
1932 end Is_Known_Non_Null;
1934 function Is_Known_Null (Id : E) return B is
1935 begin
1936 return Flag204 (Id);
1937 end Is_Known_Null;
1939 function Is_Known_Valid (Id : E) return B is
1940 begin
1941 return Flag170 (Id);
1942 end Is_Known_Valid;
1944 function Is_Limited_Composite (Id : E) return B is
1945 begin
1946 return Flag106 (Id);
1947 end Is_Limited_Composite;
1949 function Is_Limited_Interface (Id : E) return B is
1950 begin
1951 return Flag197 (Id);
1952 end Is_Limited_Interface;
1954 function Is_Limited_Record (Id : E) return B is
1955 begin
1956 return Flag25 (Id);
1957 end Is_Limited_Record;
1959 function Is_Machine_Code_Subprogram (Id : E) return B is
1960 begin
1961 pragma Assert (Is_Subprogram (Id));
1962 return Flag137 (Id);
1963 end Is_Machine_Code_Subprogram;
1965 function Is_Non_Static_Subtype (Id : E) return B is
1966 begin
1967 pragma Assert (Is_Type (Id));
1968 return Flag109 (Id);
1969 end Is_Non_Static_Subtype;
1971 function Is_Null_Init_Proc (Id : E) return B is
1972 begin
1973 pragma Assert (Ekind (Id) = E_Procedure);
1974 return Flag178 (Id);
1975 end Is_Null_Init_Proc;
1977 function Is_Obsolescent (Id : E) return B is
1978 begin
1979 return Flag153 (Id);
1980 end Is_Obsolescent;
1982 function Is_Only_Out_Parameter (Id : E) return B is
1983 begin
1984 pragma Assert (Is_Formal (Id));
1985 return Flag226 (Id);
1986 end Is_Only_Out_Parameter;
1988 function Is_Optional_Parameter (Id : E) return B is
1989 begin
1990 pragma Assert (Is_Formal (Id));
1991 return Flag134 (Id);
1992 end Is_Optional_Parameter;
1994 function Is_Package_Body_Entity (Id : E) return B is
1995 begin
1996 return Flag160 (Id);
1997 end Is_Package_Body_Entity;
1999 function Is_Packed (Id : E) return B is
2000 begin
2001 return Flag51 (Implementation_Base_Type (Id));
2002 end Is_Packed;
2004 function Is_Packed_Array_Type (Id : E) return B is
2005 begin
2006 return Flag138 (Id);
2007 end Is_Packed_Array_Type;
2009 function Is_Potentially_Use_Visible (Id : E) return B is
2010 begin
2011 pragma Assert (Nkind (Id) in N_Entity);
2012 return Flag9 (Id);
2013 end Is_Potentially_Use_Visible;
2015 function Is_Preelaborated (Id : E) return B is
2016 begin
2017 return Flag59 (Id);
2018 end Is_Preelaborated;
2020 function Is_Primitive (Id : E) return B is
2021 begin
2022 pragma Assert
2023 (Is_Overloadable (Id)
2024 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
2025 return Flag218 (Id);
2026 end Is_Primitive;
2028 function Is_Primitive_Wrapper (Id : E) return B is
2029 begin
2030 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2031 return Flag195 (Id);
2032 end Is_Primitive_Wrapper;
2034 function Is_Private_Composite (Id : E) return B is
2035 begin
2036 pragma Assert (Is_Type (Id));
2037 return Flag107 (Id);
2038 end Is_Private_Composite;
2040 function Is_Private_Descendant (Id : E) return B is
2041 begin
2042 return Flag53 (Id);
2043 end Is_Private_Descendant;
2045 function Is_Private_Primitive (Id : E) return B is
2046 begin
2047 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2048 return Flag245 (Id);
2049 end Is_Private_Primitive;
2051 function Is_Processed_Transient (Id : E) return B is
2052 begin
2053 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2054 return Flag252 (Id);
2055 end Is_Processed_Transient;
2057 function Is_Public (Id : E) return B is
2058 begin
2059 pragma Assert (Nkind (Id) in N_Entity);
2060 return Flag10 (Id);
2061 end Is_Public;
2063 function Is_Pure (Id : E) return B is
2064 begin
2065 return Flag44 (Id);
2066 end Is_Pure;
2068 function Is_Pure_Unit_Access_Type (Id : E) return B is
2069 begin
2070 pragma Assert (Is_Access_Type (Id));
2071 return Flag189 (Id);
2072 end Is_Pure_Unit_Access_Type;
2074 function Is_RACW_Stub_Type (Id : E) return B is
2075 begin
2076 pragma Assert (Is_Type (Id));
2077 return Flag244 (Id);
2078 end Is_RACW_Stub_Type;
2080 function Is_Raised (Id : E) return B is
2081 begin
2082 pragma Assert (Ekind (Id) = E_Exception);
2083 return Flag224 (Id);
2084 end Is_Raised;
2086 function Is_Remote_Call_Interface (Id : E) return B is
2087 begin
2088 return Flag62 (Id);
2089 end Is_Remote_Call_Interface;
2091 function Is_Remote_Types (Id : E) return B is
2092 begin
2093 return Flag61 (Id);
2094 end Is_Remote_Types;
2096 function Is_Renaming_Of_Object (Id : E) return B is
2097 begin
2098 return Flag112 (Id);
2099 end Is_Renaming_Of_Object;
2101 function Is_Return_Object (Id : E) return B is
2102 begin
2103 return Flag209 (Id);
2104 end Is_Return_Object;
2106 function Is_Safe_To_Reevaluate (Id : E) return B is
2107 begin
2108 return Flag249 (Id);
2109 end Is_Safe_To_Reevaluate;
2111 function Is_Shared_Passive (Id : E) return B is
2112 begin
2113 return Flag60 (Id);
2114 end Is_Shared_Passive;
2116 function Is_Statically_Allocated (Id : E) return B is
2117 begin
2118 return Flag28 (Id);
2119 end Is_Statically_Allocated;
2121 function Is_Tag (Id : E) return B is
2122 begin
2123 pragma Assert (Nkind (Id) in N_Entity);
2124 return Flag78 (Id);
2125 end Is_Tag;
2127 function Is_Tagged_Type (Id : E) return B is
2128 begin
2129 return Flag55 (Id);
2130 end Is_Tagged_Type;
2132 function Is_Thunk (Id : E) return B is
2133 begin
2134 pragma Assert (Is_Subprogram (Id));
2135 return Flag225 (Id);
2136 end Is_Thunk;
2138 function Is_Trivial_Subprogram (Id : E) return B is
2139 begin
2140 return Flag235 (Id);
2141 end Is_Trivial_Subprogram;
2143 function Is_True_Constant (Id : E) return B is
2144 begin
2145 return Flag163 (Id);
2146 end Is_True_Constant;
2148 function Is_Unchecked_Union (Id : E) return B is
2149 begin
2150 return Flag117 (Implementation_Base_Type (Id));
2151 end Is_Unchecked_Union;
2153 function Is_Underlying_Record_View (Id : E) return B is
2154 begin
2155 return Flag246 (Id);
2156 end Is_Underlying_Record_View;
2158 function Is_Unsigned_Type (Id : E) return B is
2159 begin
2160 pragma Assert (Is_Type (Id));
2161 return Flag144 (Id);
2162 end Is_Unsigned_Type;
2164 function Is_Valued_Procedure (Id : E) return B is
2165 begin
2166 pragma Assert (Ekind (Id) = E_Procedure);
2167 return Flag127 (Id);
2168 end Is_Valued_Procedure;
2170 function Is_Visible_Child_Unit (Id : E) return B is
2171 begin
2172 pragma Assert (Is_Child_Unit (Id));
2173 return Flag116 (Id);
2174 end Is_Visible_Child_Unit;
2176 function Is_Visible_Formal (Id : E) return B is
2177 begin
2178 return Flag206 (Id);
2179 end Is_Visible_Formal;
2181 function Is_VMS_Exception (Id : E) return B is
2182 begin
2183 return Flag133 (Id);
2184 end Is_VMS_Exception;
2186 function Is_Volatile (Id : E) return B is
2187 begin
2188 pragma Assert (Nkind (Id) in N_Entity);
2190 if Is_Type (Id) then
2191 return Flag16 (Base_Type (Id));
2192 else
2193 return Flag16 (Id);
2194 end if;
2195 end Is_Volatile;
2197 function Itype_Printed (Id : E) return B is
2198 begin
2199 pragma Assert (Is_Itype (Id));
2200 return Flag202 (Id);
2201 end Itype_Printed;
2203 function Kill_Elaboration_Checks (Id : E) return B is
2204 begin
2205 return Flag32 (Id);
2206 end Kill_Elaboration_Checks;
2208 function Kill_Range_Checks (Id : E) return B is
2209 begin
2210 return Flag33 (Id);
2211 end Kill_Range_Checks;
2213 function Kill_Tag_Checks (Id : E) return B is
2214 begin
2215 return Flag34 (Id);
2216 end Kill_Tag_Checks;
2218 function Known_To_Have_Preelab_Init (Id : E) return B is
2219 begin
2220 pragma Assert (Is_Type (Id));
2221 return Flag207 (Id);
2222 end Known_To_Have_Preelab_Init;
2224 function Last_Assignment (Id : E) return N is
2225 begin
2226 pragma Assert (Is_Assignable (Id));
2227 return Node26 (Id);
2228 end Last_Assignment;
2230 function Last_Entity (Id : E) return E is
2231 begin
2232 return Node20 (Id);
2233 end Last_Entity;
2235 function Limited_View (Id : E) return E is
2236 begin
2237 pragma Assert (Ekind (Id) = E_Package);
2238 return Node23 (Id);
2239 end Limited_View;
2241 function Lit_Indexes (Id : E) return E is
2242 begin
2243 pragma Assert (Is_Enumeration_Type (Id));
2244 return Node15 (Id);
2245 end Lit_Indexes;
2247 function Lit_Strings (Id : E) return E is
2248 begin
2249 pragma Assert (Is_Enumeration_Type (Id));
2250 return Node16 (Id);
2251 end Lit_Strings;
2253 function Low_Bound_Tested (Id : E) return B is
2254 begin
2255 return Flag205 (Id);
2256 end Low_Bound_Tested;
2258 function Machine_Radix_10 (Id : E) return B is
2259 begin
2260 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
2261 return Flag84 (Id);
2262 end Machine_Radix_10;
2264 function Master_Id (Id : E) return E is
2265 begin
2266 pragma Assert (Is_Access_Type (Id));
2267 return Node17 (Id);
2268 end Master_Id;
2270 function Materialize_Entity (Id : E) return B is
2271 begin
2272 return Flag168 (Id);
2273 end Materialize_Entity;
2275 function Mechanism (Id : E) return M is
2276 begin
2277 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
2278 return UI_To_Int (Uint8 (Id));
2279 end Mechanism;
2281 function Modulus (Id : E) return Uint is
2282 begin
2283 pragma Assert (Is_Modular_Integer_Type (Id));
2284 return Uint17 (Base_Type (Id));
2285 end Modulus;
2287 function Must_Be_On_Byte_Boundary (Id : E) return B is
2288 begin
2289 pragma Assert (Is_Type (Id));
2290 return Flag183 (Id);
2291 end Must_Be_On_Byte_Boundary;
2293 function Must_Have_Preelab_Init (Id : E) return B is
2294 begin
2295 pragma Assert (Is_Type (Id));
2296 return Flag208 (Id);
2297 end Must_Have_Preelab_Init;
2299 function Needs_Debug_Info (Id : E) return B is
2300 begin
2301 return Flag147 (Id);
2302 end Needs_Debug_Info;
2304 function Needs_No_Actuals (Id : E) return B is
2305 begin
2306 pragma Assert
2307 (Is_Overloadable (Id)
2308 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
2309 return Flag22 (Id);
2310 end Needs_No_Actuals;
2312 function Never_Set_In_Source (Id : E) return B is
2313 begin
2314 return Flag115 (Id);
2315 end Never_Set_In_Source;
2317 function Next_Inlined_Subprogram (Id : E) return E is
2318 begin
2319 return Node12 (Id);
2320 end Next_Inlined_Subprogram;
2322 function No_Pool_Assigned (Id : E) return B is
2323 begin
2324 pragma Assert (Is_Access_Type (Id));
2325 return Flag131 (Root_Type (Id));
2326 end No_Pool_Assigned;
2328 function No_Return (Id : E) return B is
2329 begin
2330 return Flag113 (Id);
2331 end No_Return;
2333 function No_Strict_Aliasing (Id : E) return B is
2334 begin
2335 pragma Assert (Is_Access_Type (Id));
2336 return Flag136 (Base_Type (Id));
2337 end No_Strict_Aliasing;
2339 function Non_Binary_Modulus (Id : E) return B is
2340 begin
2341 pragma Assert (Is_Type (Id));
2342 return Flag58 (Base_Type (Id));
2343 end Non_Binary_Modulus;
2345 function Non_Limited_View (Id : E) return E is
2346 begin
2347 pragma Assert (Ekind (Id) in Incomplete_Kind);
2348 return Node17 (Id);
2349 end Non_Limited_View;
2351 function Nonzero_Is_True (Id : E) return B is
2352 begin
2353 pragma Assert (Root_Type (Id) = Standard_Boolean);
2354 return Flag162 (Base_Type (Id));
2355 end Nonzero_Is_True;
2357 function Normalized_First_Bit (Id : E) return U is
2358 begin
2359 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2360 return Uint8 (Id);
2361 end Normalized_First_Bit;
2363 function Normalized_Position (Id : E) return U is
2364 begin
2365 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2366 return Uint14 (Id);
2367 end Normalized_Position;
2369 function Normalized_Position_Max (Id : E) return U is
2370 begin
2371 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2372 return Uint10 (Id);
2373 end Normalized_Position_Max;
2375 function OK_To_Rename (Id : E) return B is
2376 begin
2377 pragma Assert (Ekind (Id) = E_Variable);
2378 return Flag247 (Id);
2379 end OK_To_Rename;
2381 function OK_To_Reorder_Components (Id : E) return B is
2382 begin
2383 pragma Assert (Is_Record_Type (Id));
2384 return Flag239 (Base_Type (Id));
2385 end OK_To_Reorder_Components;
2387 function Optimize_Alignment_Space (Id : E) return B is
2388 begin
2389 pragma Assert
2390 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2391 return Flag241 (Id);
2392 end Optimize_Alignment_Space;
2394 function Optimize_Alignment_Time (Id : E) return B is
2395 begin
2396 pragma Assert
2397 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2398 return Flag242 (Id);
2399 end Optimize_Alignment_Time;
2401 function Original_Access_Type (Id : E) return E is
2402 begin
2403 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
2404 return Node26 (Id);
2405 end Original_Access_Type;
2407 function Original_Array_Type (Id : E) return E is
2408 begin
2409 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
2410 return Node21 (Id);
2411 end Original_Array_Type;
2413 function Original_Record_Component (Id : E) return E is
2414 begin
2415 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
2416 return Node22 (Id);
2417 end Original_Record_Component;
2419 function Overlays_Constant (Id : E) return B is
2420 begin
2421 return Flag243 (Id);
2422 end Overlays_Constant;
2424 function Overridden_Operation (Id : E) return E is
2425 begin
2426 return Node26 (Id);
2427 end Overridden_Operation;
2429 function Package_Instantiation (Id : E) return N is
2430 begin
2431 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
2432 return Node26 (Id);
2433 end Package_Instantiation;
2435 function Packed_Array_Type (Id : E) return E is
2436 begin
2437 pragma Assert (Is_Array_Type (Id));
2438 return Node23 (Id);
2439 end Packed_Array_Type;
2441 function Parent_Subtype (Id : E) return E is
2442 begin
2443 pragma Assert (Is_Record_Type (Id));
2444 return Node19 (Base_Type (Id));
2445 end Parent_Subtype;
2447 function Postcondition_Proc (Id : E) return E is
2448 begin
2449 pragma Assert (Ekind (Id) = E_Procedure);
2450 return Node8 (Id);
2451 end Postcondition_Proc;
2453 function PPC_Wrapper (Id : E) return E is
2454 begin
2455 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
2456 return Node25 (Id);
2457 end PPC_Wrapper;
2459 function Prival (Id : E) return E is
2460 begin
2461 pragma Assert (Is_Protected_Component (Id));
2462 return Node17 (Id);
2463 end Prival;
2465 function Prival_Link (Id : E) return E is
2466 begin
2467 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2468 return Node20 (Id);
2469 end Prival_Link;
2471 function Private_Dependents (Id : E) return L is
2472 begin
2473 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
2474 return Elist18 (Id);
2475 end Private_Dependents;
2477 function Private_View (Id : E) return N is
2478 begin
2479 pragma Assert (Is_Private_Type (Id));
2480 return Node22 (Id);
2481 end Private_View;
2483 function Protected_Body_Subprogram (Id : E) return E is
2484 begin
2485 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
2486 return Node11 (Id);
2487 end Protected_Body_Subprogram;
2489 function Protected_Formal (Id : E) return E is
2490 begin
2491 pragma Assert (Is_Formal (Id));
2492 return Node22 (Id);
2493 end Protected_Formal;
2495 function Protection_Object (Id : E) return E is
2496 begin
2497 pragma Assert
2498 (Ekind_In (Id, E_Entry, E_Entry_Family, E_Function, E_Procedure));
2499 return Node23 (Id);
2500 end Protection_Object;
2502 function Reachable (Id : E) return B is
2503 begin
2504 return Flag49 (Id);
2505 end Reachable;
2507 function Referenced (Id : E) return B is
2508 begin
2509 return Flag156 (Id);
2510 end Referenced;
2512 function Referenced_As_LHS (Id : E) return B is
2513 begin
2514 return Flag36 (Id);
2515 end Referenced_As_LHS;
2517 function Referenced_As_Out_Parameter (Id : E) return B is
2518 begin
2519 return Flag227 (Id);
2520 end Referenced_As_Out_Parameter;
2522 function Register_Exception_Call (Id : E) return N is
2523 begin
2524 pragma Assert (Ekind (Id) = E_Exception);
2525 return Node20 (Id);
2526 end Register_Exception_Call;
2528 function Related_Array_Object (Id : E) return E is
2529 begin
2530 pragma Assert (Is_Array_Type (Id));
2531 return Node25 (Id);
2532 end Related_Array_Object;
2534 function Related_Expression (Id : E) return N is
2535 begin
2536 pragma Assert (Ekind (Id) in Type_Kind
2537 or else Ekind_In (Id, E_Constant, E_Variable));
2538 return Node24 (Id);
2539 end Related_Expression;
2541 function Related_Instance (Id : E) return E is
2542 begin
2543 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
2544 return Node15 (Id);
2545 end Related_Instance;
2547 function Related_Type (Id : E) return E is
2548 begin
2549 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
2550 return Node27 (Id);
2551 end Related_Type;
2553 function Relative_Deadline_Variable (Id : E) return E is
2554 begin
2555 pragma Assert (Is_Task_Type (Id));
2556 return Node26 (Implementation_Base_Type (Id));
2557 end Relative_Deadline_Variable;
2559 function Renamed_Entity (Id : E) return N is
2560 begin
2561 return Node18 (Id);
2562 end Renamed_Entity;
2564 function Renamed_In_Spec (Id : E) return B is
2565 begin
2566 pragma Assert (Ekind (Id) = E_Package);
2567 return Flag231 (Id);
2568 end Renamed_In_Spec;
2570 function Renamed_Object (Id : E) return N is
2571 begin
2572 return Node18 (Id);
2573 end Renamed_Object;
2575 function Renaming_Map (Id : E) return U is
2576 begin
2577 return Uint9 (Id);
2578 end Renaming_Map;
2580 function Requires_Overriding (Id : E) return B is
2581 begin
2582 pragma Assert (Is_Overloadable (Id));
2583 return Flag213 (Id);
2584 end Requires_Overriding;
2586 function Return_Flag_Or_Transient_Decl (Id : E) return N is
2587 begin
2588 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2589 return Node15 (Id);
2590 end Return_Flag_Or_Transient_Decl;
2592 function Return_Present (Id : E) return B is
2593 begin
2594 return Flag54 (Id);
2595 end Return_Present;
2597 function Return_Applies_To (Id : E) return N is
2598 begin
2599 return Node8 (Id);
2600 end Return_Applies_To;
2602 function Returns_By_Ref (Id : E) return B is
2603 begin
2604 return Flag90 (Id);
2605 end Returns_By_Ref;
2607 function Reverse_Bit_Order (Id : E) return B is
2608 begin
2609 pragma Assert (Is_Record_Type (Id));
2610 return Flag164 (Base_Type (Id));
2611 end Reverse_Bit_Order;
2613 function Reverse_Storage_Order (Id : E) return B is
2614 begin
2615 pragma Assert (Is_Record_Type (Id));
2616 return Flag93 (Base_Type (Id));
2617 end Reverse_Storage_Order;
2619 function RM_Size (Id : E) return U is
2620 begin
2621 pragma Assert (Is_Type (Id));
2622 return Uint13 (Id);
2623 end RM_Size;
2625 function Scalar_Range (Id : E) return N is
2626 begin
2627 return Node20 (Id);
2628 end Scalar_Range;
2630 function Scale_Value (Id : E) return U is
2631 begin
2632 return Uint15 (Id);
2633 end Scale_Value;
2635 function Scope_Depth_Value (Id : E) return U is
2636 begin
2637 return Uint22 (Id);
2638 end Scope_Depth_Value;
2640 function Sec_Stack_Needed_For_Return (Id : E) return B is
2641 begin
2642 return Flag167 (Id);
2643 end Sec_Stack_Needed_For_Return;
2645 function Shadow_Entities (Id : E) return S is
2646 begin
2647 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
2648 return List14 (Id);
2649 end Shadow_Entities;
2651 function Shared_Var_Procs_Instance (Id : E) return E is
2652 begin
2653 pragma Assert (Ekind (Id) = E_Variable);
2654 return Node22 (Id);
2655 end Shared_Var_Procs_Instance;
2657 function Size_Check_Code (Id : E) return N is
2658 begin
2659 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2660 return Node19 (Id);
2661 end Size_Check_Code;
2663 function Size_Depends_On_Discriminant (Id : E) return B is
2664 begin
2665 return Flag177 (Id);
2666 end Size_Depends_On_Discriminant;
2668 function Size_Known_At_Compile_Time (Id : E) return B is
2669 begin
2670 return Flag92 (Id);
2671 end Size_Known_At_Compile_Time;
2673 function Small_Value (Id : E) return R is
2674 begin
2675 pragma Assert (Is_Fixed_Point_Type (Id));
2676 return Ureal21 (Id);
2677 end Small_Value;
2679 function Spec_Entity (Id : E) return E is
2680 begin
2681 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
2682 return Node19 (Id);
2683 end Spec_Entity;
2685 function Static_Predicate (Id : E) return S is
2686 begin
2687 pragma Assert (Is_Discrete_Type (Id));
2688 return List25 (Id);
2689 end Static_Predicate;
2691 function Storage_Size_Variable (Id : E) return E is
2692 begin
2693 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
2694 return Node15 (Implementation_Base_Type (Id));
2695 end Storage_Size_Variable;
2697 function Static_Elaboration_Desired (Id : E) return B is
2698 begin
2699 pragma Assert (Ekind (Id) = E_Package);
2700 return Flag77 (Id);
2701 end Static_Elaboration_Desired;
2703 function Static_Initialization (Id : E) return N is
2704 begin
2705 pragma Assert
2706 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
2707 return Node26 (Id);
2708 end Static_Initialization;
2710 function Stored_Constraint (Id : E) return L is
2711 begin
2712 pragma Assert
2713 (Is_Composite_Type (Id) and then not Is_Array_Type (Id));
2714 return Elist23 (Id);
2715 end Stored_Constraint;
2717 function Strict_Alignment (Id : E) return B is
2718 begin
2719 return Flag145 (Implementation_Base_Type (Id));
2720 end Strict_Alignment;
2722 function String_Literal_Length (Id : E) return U is
2723 begin
2724 return Uint16 (Id);
2725 end String_Literal_Length;
2727 function String_Literal_Low_Bound (Id : E) return N is
2728 begin
2729 return Node15 (Id);
2730 end String_Literal_Low_Bound;
2732 function Subprograms_For_Type (Id : E) return E is
2733 begin
2734 pragma Assert (Is_Type (Id) or else Is_Subprogram (Id));
2735 return Node29 (Id);
2736 end Subprograms_For_Type;
2738 function Suppress_Elaboration_Warnings (Id : E) return B is
2739 begin
2740 return Flag148 (Id);
2741 end Suppress_Elaboration_Warnings;
2743 function Suppress_Initialization (Id : E) return B is
2744 begin
2745 pragma Assert (Is_Type (Id));
2746 return Flag105 (Id);
2747 end Suppress_Initialization;
2749 function Suppress_Style_Checks (Id : E) return B is
2750 begin
2751 return Flag165 (Id);
2752 end Suppress_Style_Checks;
2754 function Suppress_Value_Tracking_On_Call (Id : E) return B is
2755 begin
2756 return Flag217 (Id);
2757 end Suppress_Value_Tracking_On_Call;
2759 function Task_Body_Procedure (Id : E) return N is
2760 begin
2761 pragma Assert (Ekind (Id) in Task_Kind);
2762 return Node25 (Id);
2763 end Task_Body_Procedure;
2765 function Treat_As_Volatile (Id : E) return B is
2766 begin
2767 return Flag41 (Id);
2768 end Treat_As_Volatile;
2770 function Underlying_Full_View (Id : E) return E is
2771 begin
2772 pragma Assert (Ekind (Id) in Private_Kind);
2773 return Node19 (Id);
2774 end Underlying_Full_View;
2776 function Underlying_Record_View (Id : E) return E is
2777 begin
2778 return Node28 (Id);
2779 end Underlying_Record_View;
2781 function Universal_Aliasing (Id : E) return B is
2782 begin
2783 pragma Assert (Is_Type (Id));
2784 return Flag216 (Base_Type (Id));
2785 end Universal_Aliasing;
2787 function Unset_Reference (Id : E) return N is
2788 begin
2789 return Node16 (Id);
2790 end Unset_Reference;
2792 function Used_As_Generic_Actual (Id : E) return B is
2793 begin
2794 return Flag222 (Id);
2795 end Used_As_Generic_Actual;
2797 function Uses_Sec_Stack (Id : E) return B is
2798 begin
2799 return Flag95 (Id);
2800 end Uses_Sec_Stack;
2802 function Warnings_Off (Id : E) return B is
2803 begin
2804 return Flag96 (Id);
2805 end Warnings_Off;
2807 function Warnings_Off_Used (Id : E) return B is
2808 begin
2809 return Flag236 (Id);
2810 end Warnings_Off_Used;
2812 function Warnings_Off_Used_Unmodified (Id : E) return B is
2813 begin
2814 return Flag237 (Id);
2815 end Warnings_Off_Used_Unmodified;
2817 function Warnings_Off_Used_Unreferenced (Id : E) return B is
2818 begin
2819 return Flag238 (Id);
2820 end Warnings_Off_Used_Unreferenced;
2822 function Wrapped_Entity (Id : E) return E is
2823 begin
2824 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
2825 and then Is_Primitive_Wrapper (Id));
2826 return Node27 (Id);
2827 end Wrapped_Entity;
2829 function Was_Hidden (Id : E) return B is
2830 begin
2831 return Flag196 (Id);
2832 end Was_Hidden;
2834 ------------------------------
2835 -- Classification Functions --
2836 ------------------------------
2838 function Is_Access_Type (Id : E) return B is
2839 begin
2840 return Ekind (Id) in Access_Kind;
2841 end Is_Access_Type;
2843 function Is_Access_Protected_Subprogram_Type (Id : E) return B is
2844 begin
2845 return Ekind (Id) in Access_Protected_Kind;
2846 end Is_Access_Protected_Subprogram_Type;
2848 function Is_Access_Subprogram_Type (Id : E) return B is
2849 begin
2850 return Ekind (Id) in Access_Subprogram_Kind;
2851 end Is_Access_Subprogram_Type;
2853 function Is_Aggregate_Type (Id : E) return B is
2854 begin
2855 return Ekind (Id) in Aggregate_Kind;
2856 end Is_Aggregate_Type;
2858 function Is_Array_Type (Id : E) return B is
2859 begin
2860 return Ekind (Id) in Array_Kind;
2861 end Is_Array_Type;
2863 function Is_Assignable (Id : E) return B is
2864 begin
2865 return Ekind (Id) in Assignable_Kind;
2866 end Is_Assignable;
2868 function Is_Class_Wide_Type (Id : E) return B is
2869 begin
2870 return Ekind (Id) in Class_Wide_Kind;
2871 end Is_Class_Wide_Type;
2873 function Is_Composite_Type (Id : E) return B is
2874 begin
2875 return Ekind (Id) in Composite_Kind;
2876 end Is_Composite_Type;
2878 function Is_Concurrent_Body (Id : E) return B is
2879 begin
2880 return Ekind (Id) in
2881 Concurrent_Body_Kind;
2882 end Is_Concurrent_Body;
2884 function Is_Concurrent_Record_Type (Id : E) return B is
2885 begin
2886 return Flag20 (Id);
2887 end Is_Concurrent_Record_Type;
2889 function Is_Concurrent_Type (Id : E) return B is
2890 begin
2891 return Ekind (Id) in Concurrent_Kind;
2892 end Is_Concurrent_Type;
2894 function Is_Decimal_Fixed_Point_Type (Id : E) return B is
2895 begin
2896 return Ekind (Id) in
2897 Decimal_Fixed_Point_Kind;
2898 end Is_Decimal_Fixed_Point_Type;
2900 function Is_Digits_Type (Id : E) return B is
2901 begin
2902 return Ekind (Id) in Digits_Kind;
2903 end Is_Digits_Type;
2905 function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B is
2906 begin
2907 return Ekind (Id) in Discrete_Or_Fixed_Point_Kind;
2908 end Is_Discrete_Or_Fixed_Point_Type;
2910 function Is_Discrete_Type (Id : E) return B is
2911 begin
2912 return Ekind (Id) in Discrete_Kind;
2913 end Is_Discrete_Type;
2915 function Is_Elementary_Type (Id : E) return B is
2916 begin
2917 return Ekind (Id) in Elementary_Kind;
2918 end Is_Elementary_Type;
2920 function Is_Entry (Id : E) return B is
2921 begin
2922 return Ekind (Id) in Entry_Kind;
2923 end Is_Entry;
2925 function Is_Enumeration_Type (Id : E) return B is
2926 begin
2927 return Ekind (Id) in
2928 Enumeration_Kind;
2929 end Is_Enumeration_Type;
2931 function Is_Fixed_Point_Type (Id : E) return B is
2932 begin
2933 return Ekind (Id) in
2934 Fixed_Point_Kind;
2935 end Is_Fixed_Point_Type;
2937 function Is_Floating_Point_Type (Id : E) return B is
2938 begin
2939 return Ekind (Id) in Float_Kind;
2940 end Is_Floating_Point_Type;
2942 function Is_Formal (Id : E) return B is
2943 begin
2944 return Ekind (Id) in Formal_Kind;
2945 end Is_Formal;
2947 function Is_Formal_Object (Id : E) return B is
2948 begin
2949 return Ekind (Id) in Formal_Object_Kind;
2950 end Is_Formal_Object;
2952 function Is_Generic_Subprogram (Id : E) return B is
2953 begin
2954 return Ekind (Id) in Generic_Subprogram_Kind;
2955 end Is_Generic_Subprogram;
2957 function Is_Generic_Unit (Id : E) return B is
2958 begin
2959 return Ekind (Id) in Generic_Unit_Kind;
2960 end Is_Generic_Unit;
2962 function Is_Incomplete_Or_Private_Type (Id : E) return B is
2963 begin
2964 return Ekind (Id) in
2965 Incomplete_Or_Private_Kind;
2966 end Is_Incomplete_Or_Private_Type;
2968 function Is_Incomplete_Type (Id : E) return B is
2969 begin
2970 return Ekind (Id) in
2971 Incomplete_Kind;
2972 end Is_Incomplete_Type;
2974 function Is_Integer_Type (Id : E) return B is
2975 begin
2976 return Ekind (Id) in Integer_Kind;
2977 end Is_Integer_Type;
2979 function Is_Modular_Integer_Type (Id : E) return B is
2980 begin
2981 return Ekind (Id) in
2982 Modular_Integer_Kind;
2983 end Is_Modular_Integer_Type;
2985 function Is_Named_Number (Id : E) return B is
2986 begin
2987 return Ekind (Id) in Named_Kind;
2988 end Is_Named_Number;
2990 function Is_Numeric_Type (Id : E) return B is
2991 begin
2992 return Ekind (Id) in Numeric_Kind;
2993 end Is_Numeric_Type;
2995 function Is_Object (Id : E) return B is
2996 begin
2997 return Ekind (Id) in Object_Kind;
2998 end Is_Object;
3000 function Is_Ordinary_Fixed_Point_Type (Id : E) return B is
3001 begin
3002 return Ekind (Id) in
3003 Ordinary_Fixed_Point_Kind;
3004 end Is_Ordinary_Fixed_Point_Type;
3006 function Is_Overloadable (Id : E) return B is
3007 begin
3008 return Ekind (Id) in Overloadable_Kind;
3009 end Is_Overloadable;
3011 function Is_Private_Type (Id : E) return B is
3012 begin
3013 return Ekind (Id) in Private_Kind;
3014 end Is_Private_Type;
3016 function Is_Protected_Type (Id : E) return B is
3017 begin
3018 return Ekind (Id) in Protected_Kind;
3019 end Is_Protected_Type;
3021 function Is_Real_Type (Id : E) return B is
3022 begin
3023 return Ekind (Id) in Real_Kind;
3024 end Is_Real_Type;
3026 function Is_Record_Type (Id : E) return B is
3027 begin
3028 return Ekind (Id) in Record_Kind;
3029 end Is_Record_Type;
3031 function Is_Scalar_Type (Id : E) return B is
3032 begin
3033 return Ekind (Id) in Scalar_Kind;
3034 end Is_Scalar_Type;
3036 function Is_Signed_Integer_Type (Id : E) return B is
3037 begin
3038 return Ekind (Id) in Signed_Integer_Kind;
3039 end Is_Signed_Integer_Type;
3041 function Is_Subprogram (Id : E) return B is
3042 begin
3043 return Ekind (Id) in Subprogram_Kind;
3044 end Is_Subprogram;
3046 function Is_Task_Type (Id : E) return B is
3047 begin
3048 return Ekind (Id) in Task_Kind;
3049 end Is_Task_Type;
3051 function Is_Type (Id : E) return B is
3052 begin
3053 return Ekind (Id) in Type_Kind;
3054 end Is_Type;
3056 ------------------------------
3057 -- Attribute Set Procedures --
3058 ------------------------------
3060 -- Note: in many of these set procedures an "obvious" assertion is missing.
3061 -- The reason for this is that in many cases, a field is set before the
3062 -- Ekind field is set, so that the field is set when Ekind = E_Void. It
3063 -- it is possible to add assertions that specifically include the E_Void
3064 -- possibility, but in some cases, we just omit the assertions.
3066 procedure Set_Accept_Address (Id : E; V : L) is
3067 begin
3068 Set_Elist21 (Id, V);
3069 end Set_Accept_Address;
3071 procedure Set_Access_Disp_Table (Id : E; V : L) is
3072 begin
3073 pragma Assert (Ekind (Id) = E_Record_Type
3074 and then Id = Implementation_Base_Type (Id));
3075 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
3076 Set_Elist16 (Id, V);
3077 end Set_Access_Disp_Table;
3079 procedure Set_Associated_Formal_Package (Id : E; V : E) is
3080 begin
3081 Set_Node12 (Id, V);
3082 end Set_Associated_Formal_Package;
3084 procedure Set_Associated_Node_For_Itype (Id : E; V : E) is
3085 begin
3086 Set_Node8 (Id, V);
3087 end Set_Associated_Node_For_Itype;
3089 procedure Set_Associated_Storage_Pool (Id : E; V : E) is
3090 begin
3091 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
3092 Set_Node22 (Id, V);
3093 end Set_Associated_Storage_Pool;
3095 procedure Set_Actual_Subtype (Id : E; V : E) is
3096 begin
3097 pragma Assert
3098 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
3099 or else Is_Formal (Id));
3100 Set_Node17 (Id, V);
3101 end Set_Actual_Subtype;
3103 procedure Set_Address_Taken (Id : E; V : B := True) is
3104 begin
3105 Set_Flag104 (Id, V);
3106 end Set_Address_Taken;
3108 procedure Set_Alias (Id : E; V : E) is
3109 begin
3110 pragma Assert
3111 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
3112 Set_Node18 (Id, V);
3113 end Set_Alias;
3115 procedure Set_Alignment (Id : E; V : U) is
3116 begin
3117 pragma Assert (Is_Type (Id)
3118 or else Is_Formal (Id)
3119 or else Ekind_In (Id, E_Loop_Parameter,
3120 E_Constant,
3121 E_Exception,
3122 E_Variable));
3123 Set_Uint14 (Id, V);
3124 end Set_Alignment;
3126 procedure Set_Barrier_Function (Id : E; V : N) is
3127 begin
3128 pragma Assert (Is_Entry (Id));
3129 Set_Node12 (Id, V);
3130 end Set_Barrier_Function;
3132 procedure Set_Block_Node (Id : E; V : N) is
3133 begin
3134 pragma Assert (Ekind (Id) = E_Block);
3135 Set_Node11 (Id, V);
3136 end Set_Block_Node;
3138 procedure Set_Body_Entity (Id : E; V : E) is
3139 begin
3140 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
3141 Set_Node19 (Id, V);
3142 end Set_Body_Entity;
3144 procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is
3145 begin
3146 pragma Assert
3147 (Ekind (Id) = E_Package
3148 or else Is_Subprogram (Id)
3149 or else Is_Generic_Unit (Id));
3150 Set_Flag40 (Id, V);
3151 end Set_Body_Needed_For_SAL;
3153 procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is
3154 begin
3155 pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
3156 Set_Flag125 (Id, V);
3157 end Set_C_Pass_By_Copy;
3159 procedure Set_Can_Never_Be_Null (Id : E; V : B := True) is
3160 begin
3161 Set_Flag38 (Id, V);
3162 end Set_Can_Never_Be_Null;
3164 procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is
3165 begin
3166 Set_Flag31 (Id, V);
3167 end Set_Checks_May_Be_Suppressed;
3169 procedure Set_Class_Wide_Type (Id : E; V : E) is
3170 begin
3171 pragma Assert (Is_Type (Id));
3172 Set_Node9 (Id, V);
3173 end Set_Class_Wide_Type;
3175 procedure Set_Cloned_Subtype (Id : E; V : E) is
3176 begin
3177 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
3178 Set_Node16 (Id, V);
3179 end Set_Cloned_Subtype;
3181 procedure Set_Component_Bit_Offset (Id : E; V : U) is
3182 begin
3183 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
3184 Set_Uint11 (Id, V);
3185 end Set_Component_Bit_Offset;
3187 procedure Set_Component_Clause (Id : E; V : N) is
3188 begin
3189 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
3190 Set_Node13 (Id, V);
3191 end Set_Component_Clause;
3193 procedure Set_Component_Size (Id : E; V : U) is
3194 begin
3195 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3196 Set_Uint22 (Id, V);
3197 end Set_Component_Size;
3199 procedure Set_Component_Type (Id : E; V : E) is
3200 begin
3201 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3202 Set_Node20 (Id, V);
3203 end Set_Component_Type;
3205 procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is
3206 begin
3207 pragma Assert
3208 (Ekind (Id) = E_Record_Type and then Is_Concurrent_Type (V));
3209 Set_Node18 (Id, V);
3210 end Set_Corresponding_Concurrent_Type;
3212 procedure Set_Corresponding_Discriminant (Id : E; V : E) is
3213 begin
3214 pragma Assert (Ekind (Id) = E_Discriminant);
3215 Set_Node19 (Id, V);
3216 end Set_Corresponding_Discriminant;
3218 procedure Set_Corresponding_Equality (Id : E; V : E) is
3219 begin
3220 pragma Assert
3221 (Ekind (Id) = E_Function
3222 and then not Comes_From_Source (Id)
3223 and then Chars (Id) = Name_Op_Ne);
3224 Set_Node13 (Id, V);
3225 end Set_Corresponding_Equality;
3227 procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
3228 begin
3229 pragma Assert (Ekind_In (Id, E_Void, E_Subprogram_Body));
3230 Set_Node18 (Id, V);
3231 end Set_Corresponding_Protected_Entry;
3233 procedure Set_Corresponding_Record_Type (Id : E; V : E) is
3234 begin
3235 pragma Assert (Is_Concurrent_Type (Id));
3236 Set_Node18 (Id, V);
3237 end Set_Corresponding_Record_Type;
3239 procedure Set_Corresponding_Remote_Type (Id : E; V : E) is
3240 begin
3241 Set_Node22 (Id, V);
3242 end Set_Corresponding_Remote_Type;
3244 procedure Set_Current_Use_Clause (Id : E; V : E) is
3245 begin
3246 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
3247 Set_Node27 (Id, V);
3248 end Set_Current_Use_Clause;
3250 procedure Set_Current_Value (Id : E; V : N) is
3251 begin
3252 pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
3253 Set_Node9 (Id, V);
3254 end Set_Current_Value;
3256 procedure Set_CR_Discriminant (Id : E; V : E) is
3257 begin
3258 Set_Node23 (Id, V);
3259 end Set_CR_Discriminant;
3261 procedure Set_Debug_Info_Off (Id : E; V : B := True) is
3262 begin
3263 Set_Flag166 (Id, V);
3264 end Set_Debug_Info_Off;
3266 procedure Set_Debug_Renaming_Link (Id : E; V : E) is
3267 begin
3268 Set_Node25 (Id, V);
3269 end Set_Debug_Renaming_Link;
3271 procedure Set_Default_Aspect_Component_Value (Id : E; V : E) is
3272 begin
3273 pragma Assert (Is_Array_Type (Id));
3274 Set_Node19 (Id, V);
3275 end Set_Default_Aspect_Component_Value;
3277 procedure Set_Default_Aspect_Value (Id : E; V : E) is
3278 begin
3279 pragma Assert (Is_Scalar_Type (Id));
3280 Set_Node19 (Id, V);
3281 end Set_Default_Aspect_Value;
3283 procedure Set_Default_Expr_Function (Id : E; V : E) is
3284 begin
3285 pragma Assert (Is_Formal (Id));
3286 Set_Node21 (Id, V);
3287 end Set_Default_Expr_Function;
3289 procedure Set_Default_Expressions_Processed (Id : E; V : B := True) is
3290 begin
3291 Set_Flag108 (Id, V);
3292 end Set_Default_Expressions_Processed;
3294 procedure Set_Default_Value (Id : E; V : N) is
3295 begin
3296 pragma Assert (Is_Formal (Id));
3297 Set_Node20 (Id, V);
3298 end Set_Default_Value;
3300 procedure Set_Delay_Cleanups (Id : E; V : B := True) is
3301 begin
3302 pragma Assert
3303 (Is_Subprogram (Id)
3304 or else Is_Task_Type (Id)
3305 or else Ekind (Id) = E_Block);
3306 Set_Flag114 (Id, V);
3307 end Set_Delay_Cleanups;
3309 procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is
3310 begin
3311 pragma Assert
3312 (Is_Subprogram (Id) or else Ekind_In (Id, E_Package, E_Package_Body));
3314 Set_Flag50 (Id, V);
3315 end Set_Delay_Subprogram_Descriptors;
3317 procedure Set_Delta_Value (Id : E; V : R) is
3318 begin
3319 pragma Assert (Is_Fixed_Point_Type (Id));
3320 Set_Ureal18 (Id, V);
3321 end Set_Delta_Value;
3323 procedure Set_Dependent_Instances (Id : E; V : L) is
3324 begin
3325 pragma Assert (Is_Generic_Instance (Id));
3326 Set_Elist8 (Id, V);
3327 end Set_Dependent_Instances;
3329 procedure Set_Depends_On_Private (Id : E; V : B := True) is
3330 begin
3331 pragma Assert (Nkind (Id) in N_Entity);
3332 Set_Flag14 (Id, V);
3333 end Set_Depends_On_Private;
3335 procedure Set_Digits_Value (Id : E; V : U) is
3336 begin
3337 pragma Assert
3338 (Is_Floating_Point_Type (Id)
3339 or else Is_Decimal_Fixed_Point_Type (Id));
3340 Set_Uint17 (Id, V);
3341 end Set_Digits_Value;
3343 procedure Set_Directly_Designated_Type (Id : E; V : E) is
3344 begin
3345 Set_Node20 (Id, V);
3346 end Set_Directly_Designated_Type;
3348 procedure Set_Discard_Names (Id : E; V : B := True) is
3349 begin
3350 Set_Flag88 (Id, V);
3351 end Set_Discard_Names;
3353 procedure Set_Discriminal (Id : E; V : E) is
3354 begin
3355 pragma Assert (Ekind (Id) = E_Discriminant);
3356 Set_Node17 (Id, V);
3357 end Set_Discriminal;
3359 procedure Set_Discriminal_Link (Id : E; V : E) is
3360 begin
3361 Set_Node10 (Id, V);
3362 end Set_Discriminal_Link;
3364 procedure Set_Discriminant_Checking_Func (Id : E; V : E) is
3365 begin
3366 pragma Assert (Ekind (Id) = E_Component);
3367 Set_Node20 (Id, V);
3368 end Set_Discriminant_Checking_Func;
3370 procedure Set_Discriminant_Constraint (Id : E; V : L) is
3371 begin
3372 pragma Assert (Nkind (Id) in N_Entity);
3373 Set_Elist21 (Id, V);
3374 end Set_Discriminant_Constraint;
3376 procedure Set_Discriminant_Default_Value (Id : E; V : N) is
3377 begin
3378 Set_Node20 (Id, V);
3379 end Set_Discriminant_Default_Value;
3381 procedure Set_Discriminant_Number (Id : E; V : U) is
3382 begin
3383 Set_Uint15 (Id, V);
3384 end Set_Discriminant_Number;
3386 procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is
3387 begin
3388 pragma Assert (Ekind (Id) = E_Record_Type
3389 and then Id = Implementation_Base_Type (Id));
3390 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
3391 Set_Elist26 (Id, V);
3392 end Set_Dispatch_Table_Wrappers;
3394 procedure Set_DT_Entry_Count (Id : E; V : U) is
3395 begin
3396 pragma Assert (Ekind (Id) = E_Component);
3397 Set_Uint15 (Id, V);
3398 end Set_DT_Entry_Count;
3400 procedure Set_DT_Offset_To_Top_Func (Id : E; V : E) is
3401 begin
3402 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
3403 Set_Node25 (Id, V);
3404 end Set_DT_Offset_To_Top_Func;
3406 procedure Set_DT_Position (Id : E; V : U) is
3407 begin
3408 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3409 Set_Uint15 (Id, V);
3410 end Set_DT_Position;
3412 procedure Set_DTC_Entity (Id : E; V : E) is
3413 begin
3414 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3415 Set_Node16 (Id, V);
3416 end Set_DTC_Entity;
3418 procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True) is
3419 begin
3420 pragma Assert (Ekind (Id) = E_Package);
3421 Set_Flag210 (Id, V);
3422 end Set_Elaborate_Body_Desirable;
3424 procedure Set_Elaboration_Entity (Id : E; V : E) is
3425 begin
3426 pragma Assert
3427 (Is_Subprogram (Id)
3428 or else
3429 Ekind (Id) = E_Package
3430 or else
3431 Is_Generic_Unit (Id));
3432 Set_Node13 (Id, V);
3433 end Set_Elaboration_Entity;
3435 procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is
3436 begin
3437 pragma Assert
3438 (Is_Subprogram (Id)
3439 or else
3440 Ekind (Id) = E_Package
3441 or else
3442 Is_Generic_Unit (Id));
3443 Set_Flag174 (Id, V);
3444 end Set_Elaboration_Entity_Required;
3446 procedure Set_Enclosing_Scope (Id : E; V : E) is
3447 begin
3448 Set_Node18 (Id, V);
3449 end Set_Enclosing_Scope;
3451 procedure Set_Entry_Accepted (Id : E; V : B := True) is
3452 begin
3453 pragma Assert (Is_Entry (Id));
3454 Set_Flag152 (Id, V);
3455 end Set_Entry_Accepted;
3457 procedure Set_Entry_Bodies_Array (Id : E; V : E) is
3458 begin
3459 Set_Node15 (Id, V);
3460 end Set_Entry_Bodies_Array;
3462 procedure Set_Entry_Cancel_Parameter (Id : E; V : E) is
3463 begin
3464 Set_Node23 (Id, V);
3465 end Set_Entry_Cancel_Parameter;
3467 procedure Set_Entry_Component (Id : E; V : E) is
3468 begin
3469 Set_Node11 (Id, V);
3470 end Set_Entry_Component;
3472 procedure Set_Entry_Formal (Id : E; V : E) is
3473 begin
3474 Set_Node16 (Id, V);
3475 end Set_Entry_Formal;
3477 procedure Set_Entry_Index_Constant (Id : E; V : E) is
3478 begin
3479 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
3480 Set_Node18 (Id, V);
3481 end Set_Entry_Index_Constant;
3483 procedure Set_Contract (Id : E; V : N) is
3484 begin
3485 pragma Assert
3486 (Ekind_In (Id, E_Entry, E_Entry_Family, E_Void)
3487 or else Is_Subprogram (Id)
3488 or else Is_Generic_Subprogram (Id));
3489 Set_Node24 (Id, V);
3490 end Set_Contract;
3492 procedure Set_Entry_Parameters_Type (Id : E; V : E) is
3493 begin
3494 Set_Node15 (Id, V);
3495 end Set_Entry_Parameters_Type;
3497 procedure Set_Enum_Pos_To_Rep (Id : E; V : E) is
3498 begin
3499 pragma Assert (Ekind (Id) = E_Enumeration_Type);
3500 Set_Node23 (Id, V);
3501 end Set_Enum_Pos_To_Rep;
3503 procedure Set_Enumeration_Pos (Id : E; V : U) is
3504 begin
3505 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
3506 Set_Uint11 (Id, V);
3507 end Set_Enumeration_Pos;
3509 procedure Set_Enumeration_Rep (Id : E; V : U) is
3510 begin
3511 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
3512 Set_Uint12 (Id, V);
3513 end Set_Enumeration_Rep;
3515 procedure Set_Enumeration_Rep_Expr (Id : E; V : N) is
3516 begin
3517 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
3518 Set_Node22 (Id, V);
3519 end Set_Enumeration_Rep_Expr;
3521 procedure Set_Equivalent_Type (Id : E; V : E) is
3522 begin
3523 pragma Assert
3524 (Ekind_In (Id, E_Class_Wide_Type,
3525 E_Class_Wide_Subtype,
3526 E_Access_Protected_Subprogram_Type,
3527 E_Anonymous_Access_Protected_Subprogram_Type,
3528 E_Access_Subprogram_Type,
3529 E_Exception_Type));
3530 Set_Node18 (Id, V);
3531 end Set_Equivalent_Type;
3533 procedure Set_Esize (Id : E; V : U) is
3534 begin
3535 Set_Uint12 (Id, V);
3536 end Set_Esize;
3538 procedure Set_Exception_Code (Id : E; V : U) is
3539 begin
3540 pragma Assert (Ekind (Id) = E_Exception);
3541 Set_Uint22 (Id, V);
3542 end Set_Exception_Code;
3544 procedure Set_Extra_Accessibility (Id : E; V : E) is
3545 begin
3546 pragma Assert
3547 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
3548 Set_Node13 (Id, V);
3549 end Set_Extra_Accessibility;
3551 procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is
3552 begin
3553 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
3554 Set_Node19 (Id, V);
3555 end Set_Extra_Accessibility_Of_Result;
3557 procedure Set_Extra_Constrained (Id : E; V : E) is
3558 begin
3559 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
3560 Set_Node23 (Id, V);
3561 end Set_Extra_Constrained;
3563 procedure Set_Extra_Formal (Id : E; V : E) is
3564 begin
3565 Set_Node15 (Id, V);
3566 end Set_Extra_Formal;
3568 procedure Set_Extra_Formals (Id : E; V : E) is
3569 begin
3570 pragma Assert
3571 (Is_Overloadable (Id)
3572 or else Ekind_In (Id, E_Entry_Family,
3573 E_Subprogram_Body,
3574 E_Subprogram_Type));
3575 Set_Node28 (Id, V);
3576 end Set_Extra_Formals;
3578 procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
3579 begin
3580 pragma Assert
3581 (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
3582 Set_Flag229 (Id, V);
3583 end Set_Can_Use_Internal_Rep;
3585 procedure Set_Finalization_Master (Id : E; V : E) is
3586 begin
3587 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
3588 Set_Node23 (Id, V);
3589 end Set_Finalization_Master;
3591 procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is
3592 begin
3593 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
3594 Set_Flag158 (Id, V);
3595 end Set_Finalize_Storage_Only;
3597 procedure Set_Finalizer (Id : E; V : E) is
3598 begin
3599 pragma Assert
3600 (Ekind (Id) = E_Package
3601 or else Ekind (Id) = E_Package_Body);
3602 Set_Node24 (Id, V);
3603 end Set_Finalizer;
3605 procedure Set_First_Entity (Id : E; V : E) is
3606 begin
3607 Set_Node17 (Id, V);
3608 end Set_First_Entity;
3610 procedure Set_First_Exit_Statement (Id : E; V : N) is
3611 begin
3612 pragma Assert (Ekind (Id) = E_Loop);
3613 Set_Node8 (Id, V);
3614 end Set_First_Exit_Statement;
3616 procedure Set_First_Index (Id : E; V : N) is
3617 begin
3618 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
3619 Set_Node17 (Id, V);
3620 end Set_First_Index;
3622 procedure Set_First_Literal (Id : E; V : E) is
3623 begin
3624 pragma Assert (Is_Enumeration_Type (Id));
3625 Set_Node17 (Id, V);
3626 end Set_First_Literal;
3628 procedure Set_First_Optional_Parameter (Id : E; V : E) is
3629 begin
3630 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3631 Set_Node14 (Id, V);
3632 end Set_First_Optional_Parameter;
3634 procedure Set_First_Private_Entity (Id : E; V : E) is
3635 begin
3636 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
3637 or else Ekind (Id) in Concurrent_Kind);
3638 Set_Node16 (Id, V);
3639 end Set_First_Private_Entity;
3641 procedure Set_First_Rep_Item (Id : E; V : N) is
3642 begin
3643 Set_Node6 (Id, V);
3644 end Set_First_Rep_Item;
3646 procedure Set_Float_Rep (Id : E; V : F) is
3647 pragma Assert (Ekind (Id) = E_Floating_Point_Type);
3648 begin
3649 Set_Uint10 (Id, UI_From_Int (F'Pos (V)));
3650 end Set_Float_Rep;
3652 procedure Set_Freeze_Node (Id : E; V : N) is
3653 begin
3654 Set_Node7 (Id, V);
3655 end Set_Freeze_Node;
3657 procedure Set_From_With_Type (Id : E; V : B := True) is
3658 begin
3659 pragma Assert
3660 (Is_Type (Id)
3661 or else Ekind (Id) = E_Package);
3662 Set_Flag159 (Id, V);
3663 end Set_From_With_Type;
3665 procedure Set_Full_View (Id : E; V : E) is
3666 begin
3667 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
3668 Set_Node11 (Id, V);
3669 end Set_Full_View;
3671 procedure Set_Generic_Homonym (Id : E; V : E) is
3672 begin
3673 Set_Node11 (Id, V);
3674 end Set_Generic_Homonym;
3676 procedure Set_Generic_Renamings (Id : E; V : L) is
3677 begin
3678 Set_Elist23 (Id, V);
3679 end Set_Generic_Renamings;
3681 procedure Set_Handler_Records (Id : E; V : S) is
3682 begin
3683 Set_List10 (Id, V);
3684 end Set_Handler_Records;
3686 procedure Set_Has_Aliased_Components (Id : E; V : B := True) is
3687 begin
3688 pragma Assert (Id = Base_Type (Id));
3689 Set_Flag135 (Id, V);
3690 end Set_Has_Aliased_Components;
3692 procedure Set_Has_Alignment_Clause (Id : E; V : B := True) is
3693 begin
3694 Set_Flag46 (Id, V);
3695 end Set_Has_Alignment_Clause;
3697 procedure Set_Has_All_Calls_Remote (Id : E; V : B := True) is
3698 begin
3699 Set_Flag79 (Id, V);
3700 end Set_Has_All_Calls_Remote;
3702 procedure Set_Has_Anonymous_Master (Id : E; V : B := True) is
3703 begin
3704 pragma Assert
3705 (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
3706 Set_Flag253 (Id, V);
3707 end Set_Has_Anonymous_Master;
3709 procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
3710 begin
3711 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
3712 Set_Flag86 (Id, V);
3713 end Set_Has_Atomic_Components;
3715 procedure Set_Has_Biased_Representation (Id : E; V : B := True) is
3716 begin
3717 pragma Assert
3718 ((V = False) or else (Is_Discrete_Type (Id) or else Is_Object (Id)));
3719 Set_Flag139 (Id, V);
3720 end Set_Has_Biased_Representation;
3722 procedure Set_Has_Completion (Id : E; V : B := True) is
3723 begin
3724 Set_Flag26 (Id, V);
3725 end Set_Has_Completion;
3727 procedure Set_Has_Completion_In_Body (Id : E; V : B := True) is
3728 begin
3729 pragma Assert (Is_Type (Id));
3730 Set_Flag71 (Id, V);
3731 end Set_Has_Completion_In_Body;
3733 procedure Set_Has_Complex_Representation (Id : E; V : B := True) is
3734 begin
3735 pragma Assert (Ekind (Id) = E_Record_Type);
3736 Set_Flag140 (Id, V);
3737 end Set_Has_Complex_Representation;
3739 procedure Set_Has_Component_Size_Clause (Id : E; V : B := True) is
3740 begin
3741 pragma Assert (Ekind (Id) = E_Array_Type);
3742 Set_Flag68 (Id, V);
3743 end Set_Has_Component_Size_Clause;
3745 procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True) is
3746 begin
3747 pragma Assert (Is_Type (Id));
3748 Set_Flag187 (Id, V);
3749 end Set_Has_Constrained_Partial_View;
3751 procedure Set_Has_Contiguous_Rep (Id : E; V : B := True) is
3752 begin
3753 Set_Flag181 (Id, V);
3754 end Set_Has_Contiguous_Rep;
3756 procedure Set_Has_Controlled_Component (Id : E; V : B := True) is
3757 begin
3758 pragma Assert (Id = Base_Type (Id));
3759 Set_Flag43 (Id, V);
3760 end Set_Has_Controlled_Component;
3762 procedure Set_Has_Controlling_Result (Id : E; V : B := True) is
3763 begin
3764 Set_Flag98 (Id, V);
3765 end Set_Has_Controlling_Result;
3767 procedure Set_Has_Convention_Pragma (Id : E; V : B := True) is
3768 begin
3769 Set_Flag119 (Id, V);
3770 end Set_Has_Convention_Pragma;
3772 procedure Set_Has_Default_Aspect (Id : E; V : B := True) is
3773 begin
3774 pragma Assert
3775 ((Is_Scalar_Type (Id) or else Is_Array_Type (Id))
3776 and then Is_Base_Type (Id));
3777 Set_Flag39 (Id, V);
3778 end Set_Has_Default_Aspect;
3780 procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is
3781 begin
3782 pragma Assert (Nkind (Id) in N_Entity);
3783 Set_Flag200 (Id, V);
3784 end Set_Has_Delayed_Aspects;
3786 procedure Set_Has_Delayed_Freeze (Id : E; V : B := True) is
3787 begin
3788 pragma Assert (Nkind (Id) in N_Entity);
3789 Set_Flag18 (Id, V);
3790 end Set_Has_Delayed_Freeze;
3792 procedure Set_Has_Discriminants (Id : E; V : B := True) is
3793 begin
3794 pragma Assert (Nkind (Id) in N_Entity);
3795 Set_Flag5 (Id, V);
3796 end Set_Has_Discriminants;
3798 procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is
3799 begin
3800 pragma Assert (Ekind (Id) = E_Record_Type
3801 and then Is_Tagged_Type (Id));
3802 Set_Flag220 (Id, V);
3803 end Set_Has_Dispatch_Table;
3805 procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True) is
3806 begin
3807 pragma Assert (Is_Enumeration_Type (Id));
3808 Set_Flag66 (Id, V);
3809 end Set_Has_Enumeration_Rep_Clause;
3811 procedure Set_Has_Exit (Id : E; V : B := True) is
3812 begin
3813 Set_Flag47 (Id, V);
3814 end Set_Has_Exit;
3816 procedure Set_Has_External_Tag_Rep_Clause (Id : E; V : B := True) is
3817 begin
3818 pragma Assert (Is_Tagged_Type (Id));
3819 Set_Flag110 (Id, V);
3820 end Set_Has_External_Tag_Rep_Clause;
3822 procedure Set_Has_Forward_Instantiation (Id : E; V : B := True) is
3823 begin
3824 Set_Flag175 (Id, V);
3825 end Set_Has_Forward_Instantiation;
3827 procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True) is
3828 begin
3829 Set_Flag173 (Id, V);
3830 end Set_Has_Fully_Qualified_Name;
3832 procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True) is
3833 begin
3834 Set_Flag82 (Id, V);
3835 end Set_Has_Gigi_Rep_Item;
3837 procedure Set_Has_Homonym (Id : E; V : B := True) is
3838 begin
3839 Set_Flag56 (Id, V);
3840 end Set_Has_Homonym;
3842 procedure Set_Has_Implicit_Dereference (Id : E; V : B := True) is
3843 begin
3844 Set_Flag251 (Id, V);
3845 end Set_Has_Implicit_Dereference;
3847 procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is
3848 begin
3849 pragma Assert (Is_Type (Id));
3850 Set_Flag248 (Id, V);
3851 end Set_Has_Inheritable_Invariants;
3853 procedure Set_Has_Initial_Value (Id : E; V : B := True) is
3854 begin
3855 pragma Assert (Ekind_In (Id, E_Variable, E_Out_Parameter));
3856 Set_Flag219 (Id, V);
3857 end Set_Has_Initial_Value;
3859 procedure Set_Has_Invariants (Id : E; V : B := True) is
3860 begin
3861 pragma Assert (Is_Type (Id)
3862 or else Ekind (Id) = E_Procedure
3863 or else Ekind (Id) = E_Void);
3864 Set_Flag232 (Id, V);
3865 end Set_Has_Invariants;
3867 procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True) is
3868 begin
3869 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
3870 Set_Flag83 (Id, V);
3871 end Set_Has_Machine_Radix_Clause;
3873 procedure Set_Has_Master_Entity (Id : E; V : B := True) is
3874 begin
3875 Set_Flag21 (Id, V);
3876 end Set_Has_Master_Entity;
3878 procedure Set_Has_Missing_Return (Id : E; V : B := True) is
3879 begin
3880 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
3881 Set_Flag142 (Id, V);
3882 end Set_Has_Missing_Return;
3884 procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True) is
3885 begin
3886 Set_Flag101 (Id, V);
3887 end Set_Has_Nested_Block_With_Handler;
3889 procedure Set_Has_Up_Level_Access (Id : E; V : B := True) is
3890 begin
3891 pragma Assert (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter));
3892 Set_Flag215 (Id, V);
3893 end Set_Has_Up_Level_Access;
3895 procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
3896 begin
3897 pragma Assert (Id = Base_Type (Id));
3898 Set_Flag75 (Id, V);
3899 end Set_Has_Non_Standard_Rep;
3901 procedure Set_Has_Object_Size_Clause (Id : E; V : B := True) is
3902 begin
3903 pragma Assert (Is_Type (Id));
3904 Set_Flag172 (Id, V);
3905 end Set_Has_Object_Size_Clause;
3907 procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True) is
3908 begin
3909 Set_Flag154 (Id, V);
3910 end Set_Has_Per_Object_Constraint;
3912 procedure Set_Has_Postconditions (Id : E; V : B := True) is
3913 begin
3914 pragma Assert (Is_Subprogram (Id));
3915 Set_Flag240 (Id, V);
3916 end Set_Has_Postconditions;
3918 procedure Set_Has_Pragma_Controlled (Id : E; V : B := True) is
3919 begin
3920 pragma Assert (Is_Access_Type (Id));
3921 Set_Flag27 (Base_Type (Id), V);
3922 end Set_Has_Pragma_Controlled;
3924 procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True) is
3925 begin
3926 Set_Flag150 (Id, V);
3927 end Set_Has_Pragma_Elaborate_Body;
3929 procedure Set_Has_Pragma_Inline (Id : E; V : B := True) is
3930 begin
3931 Set_Flag157 (Id, V);
3932 end Set_Has_Pragma_Inline;
3934 procedure Set_Has_Pragma_Inline_Always (Id : E; V : B := True) is
3935 begin
3936 Set_Flag230 (Id, V);
3937 end Set_Has_Pragma_Inline_Always;
3939 procedure Set_Has_Pragma_Ordered (Id : E; V : B := True) is
3940 begin
3941 pragma Assert (Is_Enumeration_Type (Id));
3942 pragma Assert (Id = Base_Type (Id));
3943 Set_Flag198 (Id, V);
3944 end Set_Has_Pragma_Ordered;
3946 procedure Set_Has_Pragma_Pack (Id : E; V : B := True) is
3947 begin
3948 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
3949 pragma Assert (Id = Base_Type (Id));
3950 Set_Flag121 (Id, V);
3951 end Set_Has_Pragma_Pack;
3953 procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True) is
3954 begin
3955 Set_Flag221 (Id, V);
3956 end Set_Has_Pragma_Preelab_Init;
3958 procedure Set_Has_Pragma_Pure (Id : E; V : B := True) is
3959 begin
3960 Set_Flag203 (Id, V);
3961 end Set_Has_Pragma_Pure;
3963 procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True) is
3964 begin
3965 Set_Flag179 (Id, V);
3966 end Set_Has_Pragma_Pure_Function;
3968 procedure Set_Has_Pragma_Thread_Local_Storage (Id : E; V : B := True) is
3969 begin
3970 Set_Flag169 (Id, V);
3971 end Set_Has_Pragma_Thread_Local_Storage;
3973 procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True) is
3974 begin
3975 Set_Flag233 (Id, V);
3976 end Set_Has_Pragma_Unmodified;
3978 procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True) is
3979 begin
3980 Set_Flag180 (Id, V);
3981 end Set_Has_Pragma_Unreferenced;
3983 procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True) is
3984 begin
3985 pragma Assert (Is_Type (Id));
3986 Set_Flag212 (Id, V);
3987 end Set_Has_Pragma_Unreferenced_Objects;
3989 procedure Set_Has_Predicates (Id : E; V : B := True) is
3990 begin
3991 Set_Flag250 (Id, V);
3992 end Set_Has_Predicates;
3994 procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is
3995 begin
3996 pragma Assert (Id = Base_Type (Id));
3997 Set_Flag120 (Id, V);
3998 end Set_Has_Primitive_Operations;
4000 procedure Set_Has_Private_Ancestor (Id : E; V : B := True) is
4001 begin
4002 pragma Assert (Is_Type (Id));
4003 Set_Flag151 (Id, V);
4004 end Set_Has_Private_Ancestor;
4006 procedure Set_Has_Private_Declaration (Id : E; V : B := True) is
4007 begin
4008 Set_Flag155 (Id, V);
4009 end Set_Has_Private_Declaration;
4011 procedure Set_Has_Qualified_Name (Id : E; V : B := True) is
4012 begin
4013 Set_Flag161 (Id, V);
4014 end Set_Has_Qualified_Name;
4016 procedure Set_Has_RACW (Id : E; V : B := True) is
4017 begin
4018 pragma Assert (Ekind (Id) = E_Package);
4019 Set_Flag214 (Id, V);
4020 end Set_Has_RACW;
4022 procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True) is
4023 begin
4024 pragma Assert (Id = Base_Type (Id));
4025 Set_Flag65 (Id, V);
4026 end Set_Has_Record_Rep_Clause;
4028 procedure Set_Has_Recursive_Call (Id : E; V : B := True) is
4029 begin
4030 pragma Assert (Is_Subprogram (Id));
4031 Set_Flag143 (Id, V);
4032 end Set_Has_Recursive_Call;
4034 procedure Set_Has_Size_Clause (Id : E; V : B := True) is
4035 begin
4036 Set_Flag29 (Id, V);
4037 end Set_Has_Size_Clause;
4039 procedure Set_Has_Small_Clause (Id : E; V : B := True) is
4040 begin
4041 Set_Flag67 (Id, V);
4042 end Set_Has_Small_Clause;
4044 procedure Set_Has_Specified_Layout (Id : E; V : B := True) is
4045 begin
4046 pragma Assert (Id = Base_Type (Id));
4047 Set_Flag100 (Id, V);
4048 end Set_Has_Specified_Layout;
4050 procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True) is
4051 begin
4052 pragma Assert (Is_Type (Id));
4053 Set_Flag190 (Id, V);
4054 end Set_Has_Specified_Stream_Input;
4056 procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True) is
4057 begin
4058 pragma Assert (Is_Type (Id));
4059 Set_Flag191 (Id, V);
4060 end Set_Has_Specified_Stream_Output;
4062 procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True) is
4063 begin
4064 pragma Assert (Is_Type (Id));
4065 Set_Flag192 (Id, V);
4066 end Set_Has_Specified_Stream_Read;
4068 procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True) is
4069 begin
4070 pragma Assert (Is_Type (Id));
4071 Set_Flag193 (Id, V);
4072 end Set_Has_Specified_Stream_Write;
4074 procedure Set_Has_Static_Discriminants (Id : E; V : B := True) is
4075 begin
4076 Set_Flag211 (Id, V);
4077 end Set_Has_Static_Discriminants;
4079 procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True) is
4080 begin
4081 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
4082 pragma Assert (Id = Base_Type (Id));
4083 Set_Flag23 (Id, V);
4084 end Set_Has_Storage_Size_Clause;
4086 procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True) is
4087 begin
4088 pragma Assert (Is_Elementary_Type (Id));
4089 Set_Flag184 (Id, V);
4090 end Set_Has_Stream_Size_Clause;
4092 procedure Set_Has_Task (Id : E; V : B := True) is
4093 begin
4094 pragma Assert (Id = Base_Type (Id));
4095 Set_Flag30 (Id, V);
4096 end Set_Has_Task;
4098 procedure Set_Has_Thunks (Id : E; V : B := True) is
4099 begin
4100 pragma Assert (Is_Tag (Id));
4101 Set_Flag228 (Id, V);
4102 end Set_Has_Thunks;
4104 procedure Set_Has_Unchecked_Union (Id : E; V : B := True) is
4105 begin
4106 pragma Assert (Id = Base_Type (Id));
4107 Set_Flag123 (Id, V);
4108 end Set_Has_Unchecked_Union;
4110 procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True) is
4111 begin
4112 pragma Assert (Is_Type (Id));
4113 Set_Flag72 (Id, V);
4114 end Set_Has_Unknown_Discriminants;
4116 procedure Set_Has_Volatile_Components (Id : E; V : B := True) is
4117 begin
4118 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4119 Set_Flag87 (Id, V);
4120 end Set_Has_Volatile_Components;
4122 procedure Set_Has_Xref_Entry (Id : E; V : B := True) is
4123 begin
4124 Set_Flag182 (Id, V);
4125 end Set_Has_Xref_Entry;
4127 procedure Set_Hiding_Loop_Variable (Id : E; V : E) is
4128 begin
4129 pragma Assert (Ekind (Id) = E_Variable);
4130 Set_Node8 (Id, V);
4131 end Set_Hiding_Loop_Variable;
4133 procedure Set_Homonym (Id : E; V : E) is
4134 begin
4135 pragma Assert (Id /= V);
4136 Set_Node4 (Id, V);
4137 end Set_Homonym;
4139 procedure Set_Interface_Alias (Id : E; V : E) is
4140 begin
4141 pragma Assert
4142 (Is_Internal (Id)
4143 and then Is_Hidden (Id)
4144 and then (Ekind_In (Id, E_Procedure, E_Function)));
4145 Set_Node25 (Id, V);
4146 end Set_Interface_Alias;
4148 procedure Set_Interfaces (Id : E; V : L) is
4149 begin
4150 pragma Assert (Is_Record_Type (Id));
4151 Set_Elist25 (Id, V);
4152 end Set_Interfaces;
4154 procedure Set_In_Package_Body (Id : E; V : B := True) is
4155 begin
4156 Set_Flag48 (Id, V);
4157 end Set_In_Package_Body;
4159 procedure Set_In_Private_Part (Id : E; V : B := True) is
4160 begin
4161 Set_Flag45 (Id, V);
4162 end Set_In_Private_Part;
4164 procedure Set_In_Use (Id : E; V : B := True) is
4165 begin
4166 pragma Assert (Nkind (Id) in N_Entity);
4167 Set_Flag8 (Id, V);
4168 end Set_In_Use;
4170 procedure Set_Inner_Instances (Id : E; V : L) is
4171 begin
4172 Set_Elist23 (Id, V);
4173 end Set_Inner_Instances;
4175 procedure Set_Interface_Name (Id : E; V : N) is
4176 begin
4177 Set_Node21 (Id, V);
4178 end Set_Interface_Name;
4180 procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is
4181 begin
4182 pragma Assert (Is_Overloadable (Id));
4183 Set_Flag19 (Id, V);
4184 end Set_Is_Abstract_Subprogram;
4186 procedure Set_Is_Abstract_Type (Id : E; V : B := True) is
4187 begin
4188 pragma Assert (Is_Type (Id));
4189 Set_Flag146 (Id, V);
4190 end Set_Is_Abstract_Type;
4192 procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
4193 begin
4194 pragma Assert (Is_Access_Type (Id));
4195 Set_Flag194 (Id, V);
4196 end Set_Is_Local_Anonymous_Access;
4198 procedure Set_Is_Access_Constant (Id : E; V : B := True) is
4199 begin
4200 pragma Assert (Is_Access_Type (Id));
4201 Set_Flag69 (Id, V);
4202 end Set_Is_Access_Constant;
4204 procedure Set_Is_Ada_2005_Only (Id : E; V : B := True) is
4205 begin
4206 Set_Flag185 (Id, V);
4207 end Set_Is_Ada_2005_Only;
4209 procedure Set_Is_Ada_2012_Only (Id : E; V : B := True) is
4210 begin
4211 Set_Flag199 (Id, V);
4212 end Set_Is_Ada_2012_Only;
4214 procedure Set_Is_Aliased (Id : E; V : B := True) is
4215 begin
4216 pragma Assert (Nkind (Id) in N_Entity);
4217 Set_Flag15 (Id, V);
4218 end Set_Is_Aliased;
4220 procedure Set_Is_AST_Entry (Id : E; V : B := True) is
4221 begin
4222 pragma Assert (Is_Entry (Id));
4223 Set_Flag132 (Id, V);
4224 end Set_Is_AST_Entry;
4226 procedure Set_Is_Asynchronous (Id : E; V : B := True) is
4227 begin
4228 pragma Assert
4229 (Ekind (Id) = E_Procedure or else Is_Type (Id));
4230 Set_Flag81 (Id, V);
4231 end Set_Is_Asynchronous;
4233 procedure Set_Is_Atomic (Id : E; V : B := True) is
4234 begin
4235 Set_Flag85 (Id, V);
4236 end Set_Is_Atomic;
4238 procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True) is
4239 begin
4240 pragma Assert ((not V)
4241 or else (Is_Array_Type (Id) and then Is_Base_Type (Id)));
4242 Set_Flag122 (Id, V);
4243 end Set_Is_Bit_Packed_Array;
4245 procedure Set_Is_Called (Id : E; V : B := True) is
4246 begin
4247 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
4248 Set_Flag102 (Id, V);
4249 end Set_Is_Called;
4251 procedure Set_Is_Character_Type (Id : E; V : B := True) is
4252 begin
4253 Set_Flag63 (Id, V);
4254 end Set_Is_Character_Type;
4256 procedure Set_Is_Child_Unit (Id : E; V : B := True) is
4257 begin
4258 Set_Flag73 (Id, V);
4259 end Set_Is_Child_Unit;
4261 procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is
4262 begin
4263 Set_Flag35 (Id, V);
4264 end Set_Is_Class_Wide_Equivalent_Type;
4266 procedure Set_Is_Compilation_Unit (Id : E; V : B := True) is
4267 begin
4268 Set_Flag149 (Id, V);
4269 end Set_Is_Compilation_Unit;
4271 procedure Set_Is_Completely_Hidden (Id : E; V : B := True) is
4272 begin
4273 pragma Assert (Ekind (Id) = E_Discriminant);
4274 Set_Flag103 (Id, V);
4275 end Set_Is_Completely_Hidden;
4277 procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True) is
4278 begin
4279 Set_Flag20 (Id, V);
4280 end Set_Is_Concurrent_Record_Type;
4282 procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True) is
4283 begin
4284 Set_Flag80 (Id, V);
4285 end Set_Is_Constr_Subt_For_U_Nominal;
4287 procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True) is
4288 begin
4289 Set_Flag141 (Id, V);
4290 end Set_Is_Constr_Subt_For_UN_Aliased;
4292 procedure Set_Is_Constrained (Id : E; V : B := True) is
4293 begin
4294 pragma Assert (Nkind (Id) in N_Entity);
4295 Set_Flag12 (Id, V);
4296 end Set_Is_Constrained;
4298 procedure Set_Is_Constructor (Id : E; V : B := True) is
4299 begin
4300 Set_Flag76 (Id, V);
4301 end Set_Is_Constructor;
4303 procedure Set_Is_Controlled (Id : E; V : B := True) is
4304 begin
4305 pragma Assert (Id = Base_Type (Id));
4306 Set_Flag42 (Id, V);
4307 end Set_Is_Controlled;
4309 procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is
4310 begin
4311 pragma Assert (Is_Formal (Id));
4312 Set_Flag97 (Id, V);
4313 end Set_Is_Controlling_Formal;
4315 procedure Set_Is_CPP_Class (Id : E; V : B := True) is
4316 begin
4317 Set_Flag74 (Id, V);
4318 end Set_Is_CPP_Class;
4320 procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True) is
4321 begin
4322 pragma Assert (Is_Type (Id));
4323 Set_Flag223 (Id, V);
4324 end Set_Is_Descendent_Of_Address;
4326 procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is
4327 begin
4328 Set_Flag176 (Id, V);
4329 end Set_Is_Discrim_SO_Function;
4331 procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True) is
4332 begin
4333 Set_Flag234 (Id, V);
4334 end Set_Is_Dispatch_Table_Entity;
4336 procedure Set_Is_Dispatching_Operation (Id : E; V : B := True) is
4337 begin
4338 pragma Assert
4339 (V = False
4340 or else
4341 Is_Overloadable (Id)
4342 or else
4343 Ekind (Id) = E_Subprogram_Type);
4345 Set_Flag6 (Id, V);
4346 end Set_Is_Dispatching_Operation;
4348 procedure Set_Is_Eliminated (Id : E; V : B := True) is
4349 begin
4350 Set_Flag124 (Id, V);
4351 end Set_Is_Eliminated;
4353 procedure Set_Is_Entry_Formal (Id : E; V : B := True) is
4354 begin
4355 Set_Flag52 (Id, V);
4356 end Set_Is_Entry_Formal;
4358 procedure Set_Is_Exported (Id : E; V : B := True) is
4359 begin
4360 Set_Flag99 (Id, V);
4361 end Set_Is_Exported;
4363 procedure Set_Is_First_Subtype (Id : E; V : B := True) is
4364 begin
4365 Set_Flag70 (Id, V);
4366 end Set_Is_First_Subtype;
4368 procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
4369 begin
4370 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
4371 Set_Flag118 (Id, V);
4372 end Set_Is_For_Access_Subtype;
4374 procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is
4375 begin
4376 Set_Flag111 (Id, V);
4377 end Set_Is_Formal_Subprogram;
4379 procedure Set_Is_Frozen (Id : E; V : B := True) is
4380 begin
4381 pragma Assert (Nkind (Id) in N_Entity);
4382 Set_Flag4 (Id, V);
4383 end Set_Is_Frozen;
4385 procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True) is
4386 begin
4387 pragma Assert (Is_Type (Id));
4388 Set_Flag94 (Id, V);
4389 end Set_Is_Generic_Actual_Type;
4391 procedure Set_Is_Generic_Instance (Id : E; V : B := True) is
4392 begin
4393 Set_Flag130 (Id, V);
4394 end Set_Is_Generic_Instance;
4396 procedure Set_Is_Generic_Type (Id : E; V : B := True) is
4397 begin
4398 pragma Assert (Nkind (Id) in N_Entity);
4399 Set_Flag13 (Id, V);
4400 end Set_Is_Generic_Type;
4402 procedure Set_Is_Hidden (Id : E; V : B := True) is
4403 begin
4404 Set_Flag57 (Id, V);
4405 end Set_Is_Hidden;
4407 procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True) is
4408 begin
4409 Set_Flag171 (Id, V);
4410 end Set_Is_Hidden_Open_Scope;
4412 procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
4413 begin
4414 pragma Assert (Nkind (Id) in N_Entity);
4415 Set_Flag7 (Id, V);
4416 end Set_Is_Immediately_Visible;
4418 procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is
4419 begin
4420 Set_Flag254 (Id, V);
4421 end Set_Is_Implementation_Defined;
4423 procedure Set_Is_Imported (Id : E; V : B := True) is
4424 begin
4425 Set_Flag24 (Id, V);
4426 end Set_Is_Imported;
4428 procedure Set_Is_Inlined (Id : E; V : B := True) is
4429 begin
4430 Set_Flag11 (Id, V);
4431 end Set_Is_Inlined;
4433 procedure Set_Is_Interface (Id : E; V : B := True) is
4434 begin
4435 pragma Assert (Is_Record_Type (Id));
4436 Set_Flag186 (Id, V);
4437 end Set_Is_Interface;
4439 procedure Set_Is_Instantiated (Id : E; V : B := True) is
4440 begin
4441 Set_Flag126 (Id, V);
4442 end Set_Is_Instantiated;
4444 procedure Set_Is_Internal (Id : E; V : B := True) is
4445 begin
4446 pragma Assert (Nkind (Id) in N_Entity);
4447 Set_Flag17 (Id, V);
4448 end Set_Is_Internal;
4450 procedure Set_Is_Interrupt_Handler (Id : E; V : B := True) is
4451 begin
4452 pragma Assert (Nkind (Id) in N_Entity);
4453 Set_Flag89 (Id, V);
4454 end Set_Is_Interrupt_Handler;
4456 procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True) is
4457 begin
4458 Set_Flag64 (Id, V);
4459 end Set_Is_Intrinsic_Subprogram;
4461 procedure Set_Is_Itype (Id : E; V : B := True) is
4462 begin
4463 Set_Flag91 (Id, V);
4464 end Set_Is_Itype;
4466 procedure Set_Is_Known_Non_Null (Id : E; V : B := True) is
4467 begin
4468 Set_Flag37 (Id, V);
4469 end Set_Is_Known_Non_Null;
4471 procedure Set_Is_Known_Null (Id : E; V : B := True) is
4472 begin
4473 Set_Flag204 (Id, V);
4474 end Set_Is_Known_Null;
4476 procedure Set_Is_Known_Valid (Id : E; V : B := True) is
4477 begin
4478 Set_Flag170 (Id, V);
4479 end Set_Is_Known_Valid;
4481 procedure Set_Is_Limited_Composite (Id : E; V : B := True) is
4482 begin
4483 pragma Assert (Is_Type (Id));
4484 Set_Flag106 (Id, V);
4485 end Set_Is_Limited_Composite;
4487 procedure Set_Is_Limited_Interface (Id : E; V : B := True) is
4488 begin
4489 pragma Assert (Is_Interface (Id));
4490 Set_Flag197 (Id, V);
4491 end Set_Is_Limited_Interface;
4493 procedure Set_Is_Limited_Record (Id : E; V : B := True) is
4494 begin
4495 Set_Flag25 (Id, V);
4496 end Set_Is_Limited_Record;
4498 procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
4499 begin
4500 pragma Assert (Is_Subprogram (Id));
4501 Set_Flag137 (Id, V);
4502 end Set_Is_Machine_Code_Subprogram;
4504 procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True) is
4505 begin
4506 pragma Assert (Is_Type (Id));
4507 Set_Flag109 (Id, V);
4508 end Set_Is_Non_Static_Subtype;
4510 procedure Set_Is_Null_Init_Proc (Id : E; V : B := True) is
4511 begin
4512 pragma Assert (Ekind (Id) = E_Procedure);
4513 Set_Flag178 (Id, V);
4514 end Set_Is_Null_Init_Proc;
4516 procedure Set_Is_Obsolescent (Id : E; V : B := True) is
4517 begin
4518 Set_Flag153 (Id, V);
4519 end Set_Is_Obsolescent;
4521 procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True) is
4522 begin
4523 pragma Assert (Ekind (Id) = E_Out_Parameter);
4524 Set_Flag226 (Id, V);
4525 end Set_Is_Only_Out_Parameter;
4527 procedure Set_Is_Optional_Parameter (Id : E; V : B := True) is
4528 begin
4529 pragma Assert (Is_Formal (Id));
4530 Set_Flag134 (Id, V);
4531 end Set_Is_Optional_Parameter;
4533 procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
4534 begin
4535 Set_Flag160 (Id, V);
4536 end Set_Is_Package_Body_Entity;
4538 procedure Set_Is_Packed (Id : E; V : B := True) is
4539 begin
4540 pragma Assert (Id = Base_Type (Id));
4541 Set_Flag51 (Id, V);
4542 end Set_Is_Packed;
4544 procedure Set_Is_Packed_Array_Type (Id : E; V : B := True) is
4545 begin
4546 Set_Flag138 (Id, V);
4547 end Set_Is_Packed_Array_Type;
4549 procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
4550 begin
4551 pragma Assert (Nkind (Id) in N_Entity);
4552 Set_Flag9 (Id, V);
4553 end Set_Is_Potentially_Use_Visible;
4555 procedure Set_Is_Preelaborated (Id : E; V : B := True) is
4556 begin
4557 Set_Flag59 (Id, V);
4558 end Set_Is_Preelaborated;
4560 procedure Set_Is_Primitive (Id : E; V : B := True) is
4561 begin
4562 pragma Assert
4563 (Is_Overloadable (Id)
4564 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
4565 Set_Flag218 (Id, V);
4566 end Set_Is_Primitive;
4568 procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
4569 begin
4570 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
4571 Set_Flag195 (Id, V);
4572 end Set_Is_Primitive_Wrapper;
4574 procedure Set_Is_Private_Composite (Id : E; V : B := True) is
4575 begin
4576 pragma Assert (Is_Type (Id));
4577 Set_Flag107 (Id, V);
4578 end Set_Is_Private_Composite;
4580 procedure Set_Is_Private_Descendant (Id : E; V : B := True) is
4581 begin
4582 Set_Flag53 (Id, V);
4583 end Set_Is_Private_Descendant;
4585 procedure Set_Is_Private_Primitive (Id : E; V : B := True) is
4586 begin
4587 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
4588 Set_Flag245 (Id, V);
4589 end Set_Is_Private_Primitive;
4591 procedure Set_Is_Processed_Transient (Id : E; V : B := True) is
4592 begin
4593 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
4594 Set_Flag252 (Id, V);
4595 end Set_Is_Processed_Transient;
4597 procedure Set_Is_Public (Id : E; V : B := True) is
4598 begin
4599 pragma Assert (Nkind (Id) in N_Entity);
4600 Set_Flag10 (Id, V);
4601 end Set_Is_Public;
4603 procedure Set_Is_Pure (Id : E; V : B := True) is
4604 begin
4605 Set_Flag44 (Id, V);
4606 end Set_Is_Pure;
4608 procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True) is
4609 begin
4610 pragma Assert (Is_Access_Type (Id));
4611 Set_Flag189 (Id, V);
4612 end Set_Is_Pure_Unit_Access_Type;
4614 procedure Set_Is_RACW_Stub_Type (Id : E; V : B := True) is
4615 begin
4616 pragma Assert (Is_Type (Id));
4617 Set_Flag244 (Id, V);
4618 end Set_Is_RACW_Stub_Type;
4620 procedure Set_Is_Raised (Id : E; V : B := True) is
4621 begin
4622 pragma Assert (Ekind (Id) = E_Exception);
4623 Set_Flag224 (Id, V);
4624 end Set_Is_Raised;
4626 procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is
4627 begin
4628 Set_Flag62 (Id, V);
4629 end Set_Is_Remote_Call_Interface;
4631 procedure Set_Is_Remote_Types (Id : E; V : B := True) is
4632 begin
4633 Set_Flag61 (Id, V);
4634 end Set_Is_Remote_Types;
4636 procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True) is
4637 begin
4638 Set_Flag112 (Id, V);
4639 end Set_Is_Renaming_Of_Object;
4641 procedure Set_Is_Return_Object (Id : E; V : B := True) is
4642 begin
4643 Set_Flag209 (Id, V);
4644 end Set_Is_Return_Object;
4646 procedure Set_Is_Safe_To_Reevaluate (Id : E; V : B := True) is
4647 begin
4648 pragma Assert (Ekind (Id) = E_Variable);
4649 Set_Flag249 (Id, V);
4650 end Set_Is_Safe_To_Reevaluate;
4652 procedure Set_Is_Shared_Passive (Id : E; V : B := True) is
4653 begin
4654 Set_Flag60 (Id, V);
4655 end Set_Is_Shared_Passive;
4657 procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is
4658 begin
4659 pragma Assert
4660 (Is_Type (Id)
4661 or else Ekind_In (Id, E_Exception,
4662 E_Variable,
4663 E_Constant,
4664 E_Void));
4665 Set_Flag28 (Id, V);
4666 end Set_Is_Statically_Allocated;
4668 procedure Set_Is_Tag (Id : E; V : B := True) is
4669 begin
4670 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
4671 Set_Flag78 (Id, V);
4672 end Set_Is_Tag;
4674 procedure Set_Is_Tagged_Type (Id : E; V : B := True) is
4675 begin
4676 Set_Flag55 (Id, V);
4677 end Set_Is_Tagged_Type;
4679 procedure Set_Is_Thunk (Id : E; V : B := True) is
4680 begin
4681 Set_Flag225 (Id, V);
4682 end Set_Is_Thunk;
4684 procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True) is
4685 begin
4686 Set_Flag235 (Id, V);
4687 end Set_Is_Trivial_Subprogram;
4689 procedure Set_Is_True_Constant (Id : E; V : B := True) is
4690 begin
4691 Set_Flag163 (Id, V);
4692 end Set_Is_True_Constant;
4694 procedure Set_Is_Unchecked_Union (Id : E; V : B := True) is
4695 begin
4696 pragma Assert (Id = Base_Type (Id));
4697 Set_Flag117 (Id, V);
4698 end Set_Is_Unchecked_Union;
4700 procedure Set_Is_Underlying_Record_View (Id : E; V : B := True) is
4701 begin
4702 pragma Assert (Ekind (Id) = E_Record_Type);
4703 Set_Flag246 (Id, V);
4704 end Set_Is_Underlying_Record_View;
4706 procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
4707 begin
4708 pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
4709 Set_Flag144 (Id, V);
4710 end Set_Is_Unsigned_Type;
4712 procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
4713 begin
4714 pragma Assert (Ekind (Id) = E_Procedure);
4715 Set_Flag127 (Id, V);
4716 end Set_Is_Valued_Procedure;
4718 procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True) is
4719 begin
4720 pragma Assert (Is_Child_Unit (Id));
4721 Set_Flag116 (Id, V);
4722 end Set_Is_Visible_Child_Unit;
4724 procedure Set_Is_Visible_Formal (Id : E; V : B := True) is
4725 begin
4726 Set_Flag206 (Id, V);
4727 end Set_Is_Visible_Formal;
4729 procedure Set_Is_VMS_Exception (Id : E; V : B := True) is
4730 begin
4731 pragma Assert (Ekind (Id) = E_Exception);
4732 Set_Flag133 (Id, V);
4733 end Set_Is_VMS_Exception;
4735 procedure Set_Is_Volatile (Id : E; V : B := True) is
4736 begin
4737 pragma Assert (Nkind (Id) in N_Entity);
4738 Set_Flag16 (Id, V);
4739 end Set_Is_Volatile;
4741 procedure Set_Itype_Printed (Id : E; V : B := True) is
4742 begin
4743 pragma Assert (Is_Itype (Id));
4744 Set_Flag202 (Id, V);
4745 end Set_Itype_Printed;
4747 procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
4748 begin
4749 Set_Flag32 (Id, V);
4750 end Set_Kill_Elaboration_Checks;
4752 procedure Set_Kill_Range_Checks (Id : E; V : B := True) is
4753 begin
4754 Set_Flag33 (Id, V);
4755 end Set_Kill_Range_Checks;
4757 procedure Set_Kill_Tag_Checks (Id : E; V : B := True) is
4758 begin
4759 Set_Flag34 (Id, V);
4760 end Set_Kill_Tag_Checks;
4762 procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True) is
4763 begin
4764 pragma Assert (Is_Type (Id));
4765 Set_Flag207 (Id, V);
4766 end Set_Known_To_Have_Preelab_Init;
4768 procedure Set_Last_Assignment (Id : E; V : N) is
4769 begin
4770 pragma Assert (Is_Assignable (Id));
4771 Set_Node26 (Id, V);
4772 end Set_Last_Assignment;
4774 procedure Set_Last_Entity (Id : E; V : E) is
4775 begin
4776 Set_Node20 (Id, V);
4777 end Set_Last_Entity;
4779 procedure Set_Limited_View (Id : E; V : E) is
4780 begin
4781 pragma Assert (Ekind (Id) = E_Package);
4782 Set_Node23 (Id, V);
4783 end Set_Limited_View;
4785 procedure Set_Lit_Indexes (Id : E; V : E) is
4786 begin
4787 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
4788 Set_Node15 (Id, V);
4789 end Set_Lit_Indexes;
4791 procedure Set_Lit_Strings (Id : E; V : E) is
4792 begin
4793 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
4794 Set_Node16 (Id, V);
4795 end Set_Lit_Strings;
4797 procedure Set_Low_Bound_Tested (Id : E; V : B := True) is
4798 begin
4799 pragma Assert (Is_Formal (Id));
4800 Set_Flag205 (Id, V);
4801 end Set_Low_Bound_Tested;
4803 procedure Set_Machine_Radix_10 (Id : E; V : B := True) is
4804 begin
4805 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
4806 Set_Flag84 (Id, V);
4807 end Set_Machine_Radix_10;
4809 procedure Set_Master_Id (Id : E; V : E) is
4810 begin
4811 pragma Assert (Is_Access_Type (Id));
4812 Set_Node17 (Id, V);
4813 end Set_Master_Id;
4815 procedure Set_Materialize_Entity (Id : E; V : B := True) is
4816 begin
4817 Set_Flag168 (Id, V);
4818 end Set_Materialize_Entity;
4820 procedure Set_Mechanism (Id : E; V : M) is
4821 begin
4822 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
4823 Set_Uint8 (Id, UI_From_Int (V));
4824 end Set_Mechanism;
4826 procedure Set_Modulus (Id : E; V : U) is
4827 begin
4828 pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
4829 Set_Uint17 (Id, V);
4830 end Set_Modulus;
4832 procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True) is
4833 begin
4834 pragma Assert (Is_Type (Id));
4835 Set_Flag183 (Id, V);
4836 end Set_Must_Be_On_Byte_Boundary;
4838 procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True) is
4839 begin
4840 pragma Assert (Is_Type (Id));
4841 Set_Flag208 (Id, V);
4842 end Set_Must_Have_Preelab_Init;
4844 procedure Set_Needs_Debug_Info (Id : E; V : B := True) is
4845 begin
4846 Set_Flag147 (Id, V);
4847 end Set_Needs_Debug_Info;
4849 procedure Set_Needs_No_Actuals (Id : E; V : B := True) is
4850 begin
4851 pragma Assert
4852 (Is_Overloadable (Id)
4853 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
4854 Set_Flag22 (Id, V);
4855 end Set_Needs_No_Actuals;
4857 procedure Set_Never_Set_In_Source (Id : E; V : B := True) is
4858 begin
4859 Set_Flag115 (Id, V);
4860 end Set_Never_Set_In_Source;
4862 procedure Set_Next_Inlined_Subprogram (Id : E; V : E) is
4863 begin
4864 Set_Node12 (Id, V);
4865 end Set_Next_Inlined_Subprogram;
4867 procedure Set_No_Pool_Assigned (Id : E; V : B := True) is
4868 begin
4869 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
4870 Set_Flag131 (Id, V);
4871 end Set_No_Pool_Assigned;
4873 procedure Set_No_Return (Id : E; V : B := True) is
4874 begin
4875 pragma Assert
4876 (V = False or else Ekind_In (Id, E_Procedure, E_Generic_Procedure));
4877 Set_Flag113 (Id, V);
4878 end Set_No_Return;
4880 procedure Set_No_Strict_Aliasing (Id : E; V : B := True) is
4881 begin
4882 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
4883 Set_Flag136 (Id, V);
4884 end Set_No_Strict_Aliasing;
4886 procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
4887 begin
4888 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
4889 Set_Flag58 (Id, V);
4890 end Set_Non_Binary_Modulus;
4892 procedure Set_Non_Limited_View (Id : E; V : E) is
4893 begin
4894 pragma Assert (Ekind (Id) in Incomplete_Kind);
4895 Set_Node17 (Id, V);
4896 end Set_Non_Limited_View;
4898 procedure Set_Nonzero_Is_True (Id : E; V : B := True) is
4899 begin
4900 pragma Assert
4901 (Root_Type (Id) = Standard_Boolean
4902 and then Ekind (Id) = E_Enumeration_Type);
4903 Set_Flag162 (Id, V);
4904 end Set_Nonzero_Is_True;
4906 procedure Set_Normalized_First_Bit (Id : E; V : U) is
4907 begin
4908 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
4909 Set_Uint8 (Id, V);
4910 end Set_Normalized_First_Bit;
4912 procedure Set_Normalized_Position (Id : E; V : U) is
4913 begin
4914 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
4915 Set_Uint14 (Id, V);
4916 end Set_Normalized_Position;
4918 procedure Set_Normalized_Position_Max (Id : E; V : U) is
4919 begin
4920 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
4921 Set_Uint10 (Id, V);
4922 end Set_Normalized_Position_Max;
4924 procedure Set_OK_To_Rename (Id : E; V : B := True) is
4925 begin
4926 pragma Assert (Ekind (Id) = E_Variable);
4927 Set_Flag247 (Id, V);
4928 end Set_OK_To_Rename;
4930 procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is
4931 begin
4932 pragma Assert
4933 (Is_Record_Type (Id) and then Is_Base_Type (Id));
4934 Set_Flag239 (Id, V);
4935 end Set_OK_To_Reorder_Components;
4937 procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is
4938 begin
4939 pragma Assert
4940 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
4941 Set_Flag241 (Id, V);
4942 end Set_Optimize_Alignment_Space;
4944 procedure Set_Optimize_Alignment_Time (Id : E; V : B := True) is
4945 begin
4946 pragma Assert
4947 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
4948 Set_Flag242 (Id, V);
4949 end Set_Optimize_Alignment_Time;
4951 procedure Set_Original_Access_Type (Id : E; V : E) is
4952 begin
4953 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
4954 Set_Node26 (Id, V);
4955 end Set_Original_Access_Type;
4957 procedure Set_Original_Array_Type (Id : E; V : E) is
4958 begin
4959 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
4960 Set_Node21 (Id, V);
4961 end Set_Original_Array_Type;
4963 procedure Set_Original_Record_Component (Id : E; V : E) is
4964 begin
4965 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
4966 Set_Node22 (Id, V);
4967 end Set_Original_Record_Component;
4969 procedure Set_Overlays_Constant (Id : E; V : B := True) is
4970 begin
4971 Set_Flag243 (Id, V);
4972 end Set_Overlays_Constant;
4974 procedure Set_Overridden_Operation (Id : E; V : E) is
4975 begin
4976 Set_Node26 (Id, V);
4977 end Set_Overridden_Operation;
4979 procedure Set_Package_Instantiation (Id : E; V : N) is
4980 begin
4981 pragma Assert (Ekind_In (Id, E_Void, E_Generic_Package, E_Package));
4982 Set_Node26 (Id, V);
4983 end Set_Package_Instantiation;
4985 procedure Set_Packed_Array_Type (Id : E; V : E) is
4986 begin
4987 pragma Assert (Is_Array_Type (Id));
4988 Set_Node23 (Id, V);
4989 end Set_Packed_Array_Type;
4991 procedure Set_Parent_Subtype (Id : E; V : E) is
4992 begin
4993 pragma Assert (Ekind (Id) = E_Record_Type);
4994 Set_Node19 (Id, V);
4995 end Set_Parent_Subtype;
4997 procedure Set_Postcondition_Proc (Id : E; V : E) is
4998 begin
4999 pragma Assert (Ekind (Id) = E_Procedure);
5000 Set_Node8 (Id, V);
5001 end Set_Postcondition_Proc;
5003 procedure Set_PPC_Wrapper (Id : E; V : E) is
5004 begin
5005 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
5006 Set_Node25 (Id, V);
5007 end Set_PPC_Wrapper;
5009 procedure Set_Direct_Primitive_Operations (Id : E; V : L) is
5010 begin
5011 pragma Assert (Is_Tagged_Type (Id));
5012 Set_Elist10 (Id, V);
5013 end Set_Direct_Primitive_Operations;
5015 procedure Set_Prival (Id : E; V : E) is
5016 begin
5017 pragma Assert (Is_Protected_Component (Id));
5018 Set_Node17 (Id, V);
5019 end Set_Prival;
5021 procedure Set_Prival_Link (Id : E; V : E) is
5022 begin
5023 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5024 Set_Node20 (Id, V);
5025 end Set_Prival_Link;
5027 procedure Set_Private_Dependents (Id : E; V : L) is
5028 begin
5029 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
5030 Set_Elist18 (Id, V);
5031 end Set_Private_Dependents;
5033 procedure Set_Private_View (Id : E; V : N) is
5034 begin
5035 pragma Assert (Is_Private_Type (Id));
5036 Set_Node22 (Id, V);
5037 end Set_Private_View;
5039 procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
5040 begin
5041 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
5042 Set_Node11 (Id, V);
5043 end Set_Protected_Body_Subprogram;
5045 procedure Set_Protected_Formal (Id : E; V : E) is
5046 begin
5047 pragma Assert (Is_Formal (Id));
5048 Set_Node22 (Id, V);
5049 end Set_Protected_Formal;
5051 procedure Set_Protection_Object (Id : E; V : E) is
5052 begin
5053 pragma Assert (Ekind_In (Id, E_Entry,
5054 E_Entry_Family,
5055 E_Function,
5056 E_Procedure));
5057 Set_Node23 (Id, V);
5058 end Set_Protection_Object;
5060 procedure Set_Reachable (Id : E; V : B := True) is
5061 begin
5062 Set_Flag49 (Id, V);
5063 end Set_Reachable;
5065 procedure Set_Referenced (Id : E; V : B := True) is
5066 begin
5067 Set_Flag156 (Id, V);
5068 end Set_Referenced;
5070 procedure Set_Referenced_As_LHS (Id : E; V : B := True) is
5071 begin
5072 Set_Flag36 (Id, V);
5073 end Set_Referenced_As_LHS;
5075 procedure Set_Referenced_As_Out_Parameter (Id : E; V : B := True) is
5076 begin
5077 Set_Flag227 (Id, V);
5078 end Set_Referenced_As_Out_Parameter;
5080 procedure Set_Register_Exception_Call (Id : E; V : N) is
5081 begin
5082 pragma Assert (Ekind (Id) = E_Exception);
5083 Set_Node20 (Id, V);
5084 end Set_Register_Exception_Call;
5086 procedure Set_Related_Array_Object (Id : E; V : E) is
5087 begin
5088 pragma Assert (Is_Array_Type (Id));
5089 Set_Node25 (Id, V);
5090 end Set_Related_Array_Object;
5092 procedure Set_Related_Expression (Id : E; V : N) is
5093 begin
5094 pragma Assert (Ekind (Id) in Type_Kind
5095 or else Ekind_In (Id, E_Constant, E_Variable, E_Void));
5096 Set_Node24 (Id, V);
5097 end Set_Related_Expression;
5099 procedure Set_Related_Instance (Id : E; V : E) is
5100 begin
5101 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
5102 Set_Node15 (Id, V);
5103 end Set_Related_Instance;
5105 procedure Set_Related_Type (Id : E; V : E) is
5106 begin
5107 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
5108 Set_Node27 (Id, V);
5109 end Set_Related_Type;
5111 procedure Set_Relative_Deadline_Variable (Id : E; V : E) is
5112 begin
5113 pragma Assert (Is_Task_Type (Id) and then Is_Base_Type (Id));
5114 Set_Node26 (Id, V);
5115 end Set_Relative_Deadline_Variable;
5117 procedure Set_Renamed_Entity (Id : E; V : N) is
5118 begin
5119 Set_Node18 (Id, V);
5120 end Set_Renamed_Entity;
5122 procedure Set_Renamed_In_Spec (Id : E; V : B := True) is
5123 begin
5124 pragma Assert (Ekind (Id) = E_Package);
5125 Set_Flag231 (Id, V);
5126 end Set_Renamed_In_Spec;
5128 procedure Set_Renamed_Object (Id : E; V : N) is
5129 begin
5130 Set_Node18 (Id, V);
5131 end Set_Renamed_Object;
5133 procedure Set_Renaming_Map (Id : E; V : U) is
5134 begin
5135 Set_Uint9 (Id, V);
5136 end Set_Renaming_Map;
5138 procedure Set_Requires_Overriding (Id : E; V : B := True) is
5139 begin
5140 pragma Assert (Is_Overloadable (Id));
5141 Set_Flag213 (Id, V);
5142 end Set_Requires_Overriding;
5144 procedure Set_Return_Flag_Or_Transient_Decl (Id : E; V : E) is
5145 begin
5146 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5147 Set_Node15 (Id, V);
5148 end Set_Return_Flag_Or_Transient_Decl;
5150 procedure Set_Return_Present (Id : E; V : B := True) is
5151 begin
5152 Set_Flag54 (Id, V);
5153 end Set_Return_Present;
5155 procedure Set_Return_Applies_To (Id : E; V : N) is
5156 begin
5157 Set_Node8 (Id, V);
5158 end Set_Return_Applies_To;
5160 procedure Set_Returns_By_Ref (Id : E; V : B := True) is
5161 begin
5162 Set_Flag90 (Id, V);
5163 end Set_Returns_By_Ref;
5165 procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
5166 begin
5167 pragma Assert
5168 (Is_Record_Type (Id) and then Is_Base_Type (Id));
5169 Set_Flag164 (Id, V);
5170 end Set_Reverse_Bit_Order;
5172 procedure Set_Reverse_Storage_Order (Id : E; V : B := True) is
5173 begin
5174 pragma Assert
5175 (Is_Record_Type (Id) and then Is_Base_Type (Id));
5176 Set_Flag93 (Id, V);
5177 end Set_Reverse_Storage_Order;
5179 procedure Set_RM_Size (Id : E; V : U) is
5180 begin
5181 pragma Assert (Is_Type (Id));
5182 Set_Uint13 (Id, V);
5183 end Set_RM_Size;
5185 procedure Set_Scalar_Range (Id : E; V : N) is
5186 begin
5187 Set_Node20 (Id, V);
5188 end Set_Scalar_Range;
5190 procedure Set_Scale_Value (Id : E; V : U) is
5191 begin
5192 Set_Uint15 (Id, V);
5193 end Set_Scale_Value;
5195 procedure Set_Scope_Depth_Value (Id : E; V : U) is
5196 begin
5197 pragma Assert (not Is_Record_Type (Id));
5198 Set_Uint22 (Id, V);
5199 end Set_Scope_Depth_Value;
5201 procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is
5202 begin
5203 Set_Flag167 (Id, V);
5204 end Set_Sec_Stack_Needed_For_Return;
5206 procedure Set_Shadow_Entities (Id : E; V : S) is
5207 begin
5208 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
5209 Set_List14 (Id, V);
5210 end Set_Shadow_Entities;
5212 procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is
5213 begin
5214 pragma Assert (Ekind (Id) = E_Variable);
5215 Set_Node22 (Id, V);
5216 end Set_Shared_Var_Procs_Instance;
5218 procedure Set_Size_Check_Code (Id : E; V : N) is
5219 begin
5220 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5221 Set_Node19 (Id, V);
5222 end Set_Size_Check_Code;
5224 procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True) is
5225 begin
5226 Set_Flag177 (Id, V);
5227 end Set_Size_Depends_On_Discriminant;
5229 procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True) is
5230 begin
5231 Set_Flag92 (Id, V);
5232 end Set_Size_Known_At_Compile_Time;
5234 procedure Set_Small_Value (Id : E; V : R) is
5235 begin
5236 pragma Assert (Is_Fixed_Point_Type (Id));
5237 Set_Ureal21 (Id, V);
5238 end Set_Small_Value;
5240 procedure Set_Spec_Entity (Id : E; V : E) is
5241 begin
5242 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
5243 Set_Node19 (Id, V);
5244 end Set_Spec_Entity;
5246 procedure Set_Static_Predicate (Id : E; V : S) is
5247 begin
5248 pragma Assert
5249 (Ekind_In (Id, E_Enumeration_Subtype,
5250 E_Modular_Integer_Subtype,
5251 E_Signed_Integer_Subtype)
5252 and then Has_Predicates (Id));
5253 Set_List25 (Id, V);
5254 end Set_Static_Predicate;
5256 procedure Set_Storage_Size_Variable (Id : E; V : E) is
5257 begin
5258 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
5259 pragma Assert (Id = Base_Type (Id));
5260 Set_Node15 (Id, V);
5261 end Set_Storage_Size_Variable;
5263 procedure Set_Static_Elaboration_Desired (Id : E; V : B) is
5264 begin
5265 pragma Assert (Ekind (Id) = E_Package);
5266 Set_Flag77 (Id, V);
5267 end Set_Static_Elaboration_Desired;
5269 procedure Set_Static_Initialization (Id : E; V : N) is
5270 begin
5271 pragma Assert
5272 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
5273 Set_Node26 (Id, V);
5274 end Set_Static_Initialization;
5276 procedure Set_Stored_Constraint (Id : E; V : L) is
5277 begin
5278 pragma Assert (Nkind (Id) in N_Entity);
5279 Set_Elist23 (Id, V);
5280 end Set_Stored_Constraint;
5282 procedure Set_Strict_Alignment (Id : E; V : B := True) is
5283 begin
5284 pragma Assert (Id = Base_Type (Id));
5285 Set_Flag145 (Id, V);
5286 end Set_Strict_Alignment;
5288 procedure Set_String_Literal_Length (Id : E; V : U) is
5289 begin
5290 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
5291 Set_Uint16 (Id, V);
5292 end Set_String_Literal_Length;
5294 procedure Set_String_Literal_Low_Bound (Id : E; V : N) is
5295 begin
5296 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
5297 Set_Node15 (Id, V);
5298 end Set_String_Literal_Low_Bound;
5300 procedure Set_Subprograms_For_Type (Id : E; V : E) is
5301 begin
5302 pragma Assert (Is_Type (Id) or else Is_Subprogram (Id));
5303 Set_Node29 (Id, V);
5304 end Set_Subprograms_For_Type;
5306 procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
5307 begin
5308 Set_Flag148 (Id, V);
5309 end Set_Suppress_Elaboration_Warnings;
5311 procedure Set_Suppress_Initialization (Id : E; V : B := True) is
5312 begin
5313 pragma Assert (Is_Type (Id));
5314 Set_Flag105 (Id, V);
5315 end Set_Suppress_Initialization;
5317 procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is
5318 begin
5319 Set_Flag165 (Id, V);
5320 end Set_Suppress_Style_Checks;
5322 procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True) is
5323 begin
5324 Set_Flag217 (Id, V);
5325 end Set_Suppress_Value_Tracking_On_Call;
5327 procedure Set_Task_Body_Procedure (Id : E; V : N) is
5328 begin
5329 pragma Assert (Ekind (Id) in Task_Kind);
5330 Set_Node25 (Id, V);
5331 end Set_Task_Body_Procedure;
5333 procedure Set_Treat_As_Volatile (Id : E; V : B := True) is
5334 begin
5335 Set_Flag41 (Id, V);
5336 end Set_Treat_As_Volatile;
5338 procedure Set_Underlying_Full_View (Id : E; V : E) is
5339 begin
5340 pragma Assert (Ekind (Id) in Private_Kind);
5341 Set_Node19 (Id, V);
5342 end Set_Underlying_Full_View;
5344 procedure Set_Underlying_Record_View (Id : E; V : E) is
5345 begin
5346 pragma Assert (Ekind (Id) = E_Record_Type);
5347 Set_Node28 (Id, V);
5348 end Set_Underlying_Record_View;
5350 procedure Set_Universal_Aliasing (Id : E; V : B := True) is
5351 begin
5352 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
5353 Set_Flag216 (Id, V);
5354 end Set_Universal_Aliasing;
5356 procedure Set_Unset_Reference (Id : E; V : N) is
5357 begin
5358 Set_Node16 (Id, V);
5359 end Set_Unset_Reference;
5361 procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
5362 begin
5363 Set_Flag95 (Id, V);
5364 end Set_Uses_Sec_Stack;
5366 procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
5367 begin
5368 Set_Flag222 (Id, V);
5369 end Set_Used_As_Generic_Actual;
5371 procedure Set_Warnings_Off (Id : E; V : B := True) is
5372 begin
5373 Set_Flag96 (Id, V);
5374 end Set_Warnings_Off;
5376 procedure Set_Warnings_Off_Used (Id : E; V : B := True) is
5377 begin
5378 Set_Flag236 (Id, V);
5379 end Set_Warnings_Off_Used;
5381 procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True) is
5382 begin
5383 Set_Flag237 (Id, V);
5384 end Set_Warnings_Off_Used_Unmodified;
5386 procedure Set_Warnings_Off_Used_Unreferenced (Id : E; V : B := True) is
5387 begin
5388 Set_Flag238 (Id, V);
5389 end Set_Warnings_Off_Used_Unreferenced;
5391 procedure Set_Was_Hidden (Id : E; V : B := True) is
5392 begin
5393 Set_Flag196 (Id, V);
5394 end Set_Was_Hidden;
5396 procedure Set_Wrapped_Entity (Id : E; V : E) is
5397 begin
5398 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
5399 and then Is_Primitive_Wrapper (Id));
5400 Set_Node27 (Id, V);
5401 end Set_Wrapped_Entity;
5403 -----------------------------------
5404 -- Field Initialization Routines --
5405 -----------------------------------
5407 procedure Init_Alignment (Id : E) is
5408 begin
5409 Set_Uint14 (Id, Uint_0);
5410 end Init_Alignment;
5412 procedure Init_Alignment (Id : E; V : Int) is
5413 begin
5414 Set_Uint14 (Id, UI_From_Int (V));
5415 end Init_Alignment;
5417 procedure Init_Component_Bit_Offset (Id : E) is
5418 begin
5419 Set_Uint11 (Id, No_Uint);
5420 end Init_Component_Bit_Offset;
5422 procedure Init_Component_Bit_Offset (Id : E; V : Int) is
5423 begin
5424 Set_Uint11 (Id, UI_From_Int (V));
5425 end Init_Component_Bit_Offset;
5427 procedure Init_Component_Size (Id : E) is
5428 begin
5429 Set_Uint22 (Id, Uint_0);
5430 end Init_Component_Size;
5432 procedure Init_Component_Size (Id : E; V : Int) is
5433 begin
5434 Set_Uint22 (Id, UI_From_Int (V));
5435 end Init_Component_Size;
5437 procedure Init_Digits_Value (Id : E) is
5438 begin
5439 Set_Uint17 (Id, Uint_0);
5440 end Init_Digits_Value;
5442 procedure Init_Digits_Value (Id : E; V : Int) is
5443 begin
5444 Set_Uint17 (Id, UI_From_Int (V));
5445 end Init_Digits_Value;
5447 procedure Init_Esize (Id : E) is
5448 begin
5449 Set_Uint12 (Id, Uint_0);
5450 end Init_Esize;
5452 procedure Init_Esize (Id : E; V : Int) is
5453 begin
5454 Set_Uint12 (Id, UI_From_Int (V));
5455 end Init_Esize;
5457 procedure Init_Normalized_First_Bit (Id : E) is
5458 begin
5459 Set_Uint8 (Id, No_Uint);
5460 end Init_Normalized_First_Bit;
5462 procedure Init_Normalized_First_Bit (Id : E; V : Int) is
5463 begin
5464 Set_Uint8 (Id, UI_From_Int (V));
5465 end Init_Normalized_First_Bit;
5467 procedure Init_Normalized_Position (Id : E) is
5468 begin
5469 Set_Uint14 (Id, No_Uint);
5470 end Init_Normalized_Position;
5472 procedure Init_Normalized_Position (Id : E; V : Int) is
5473 begin
5474 Set_Uint14 (Id, UI_From_Int (V));
5475 end Init_Normalized_Position;
5477 procedure Init_Normalized_Position_Max (Id : E) is
5478 begin
5479 Set_Uint10 (Id, No_Uint);
5480 end Init_Normalized_Position_Max;
5482 procedure Init_Normalized_Position_Max (Id : E; V : Int) is
5483 begin
5484 Set_Uint10 (Id, UI_From_Int (V));
5485 end Init_Normalized_Position_Max;
5487 procedure Init_RM_Size (Id : E) is
5488 begin
5489 Set_Uint13 (Id, Uint_0);
5490 end Init_RM_Size;
5492 procedure Init_RM_Size (Id : E; V : Int) is
5493 begin
5494 Set_Uint13 (Id, UI_From_Int (V));
5495 end Init_RM_Size;
5497 -----------------------------
5498 -- Init_Component_Location --
5499 -----------------------------
5501 procedure Init_Component_Location (Id : E) is
5502 begin
5503 Set_Uint8 (Id, No_Uint); -- Normalized_First_Bit
5504 Set_Uint10 (Id, No_Uint); -- Normalized_Position_Max
5505 Set_Uint11 (Id, No_Uint); -- Component_Bit_Offset
5506 Set_Uint12 (Id, Uint_0); -- Esize
5507 Set_Uint14 (Id, No_Uint); -- Normalized_Position
5508 end Init_Component_Location;
5510 ----------------------------
5511 -- Init_Object_Size_Align --
5512 ----------------------------
5514 procedure Init_Object_Size_Align (Id : E) is
5515 begin
5516 Set_Uint12 (Id, Uint_0); -- Esize
5517 Set_Uint14 (Id, Uint_0); -- Alignment
5518 end Init_Object_Size_Align;
5520 ---------------
5521 -- Init_Size --
5522 ---------------
5524 procedure Init_Size (Id : E; V : Int) is
5525 begin
5526 pragma Assert (not Is_Object (Id));
5527 Set_Uint12 (Id, UI_From_Int (V)); -- Esize
5528 Set_Uint13 (Id, UI_From_Int (V)); -- RM_Size
5529 end Init_Size;
5531 ---------------------
5532 -- Init_Size_Align --
5533 ---------------------
5535 procedure Init_Size_Align (Id : E) is
5536 begin
5537 pragma Assert (not Is_Object (Id));
5538 Set_Uint12 (Id, Uint_0); -- Esize
5539 Set_Uint13 (Id, Uint_0); -- RM_Size
5540 Set_Uint14 (Id, Uint_0); -- Alignment
5541 end Init_Size_Align;
5543 ----------------------------------------------
5544 -- Type Representation Attribute Predicates --
5545 ----------------------------------------------
5547 function Known_Alignment (E : Entity_Id) return B is
5548 begin
5549 return Uint14 (E) /= Uint_0
5550 and then Uint14 (E) /= No_Uint;
5551 end Known_Alignment;
5553 function Known_Component_Bit_Offset (E : Entity_Id) return B is
5554 begin
5555 return Uint11 (E) /= No_Uint;
5556 end Known_Component_Bit_Offset;
5558 function Known_Component_Size (E : Entity_Id) return B is
5559 begin
5560 return Uint22 (Base_Type (E)) /= Uint_0
5561 and then Uint22 (Base_Type (E)) /= No_Uint;
5562 end Known_Component_Size;
5564 function Known_Esize (E : Entity_Id) return B is
5565 begin
5566 return Uint12 (E) /= Uint_0
5567 and then Uint12 (E) /= No_Uint;
5568 end Known_Esize;
5570 function Known_Normalized_First_Bit (E : Entity_Id) return B is
5571 begin
5572 return Uint8 (E) /= No_Uint;
5573 end Known_Normalized_First_Bit;
5575 function Known_Normalized_Position (E : Entity_Id) return B is
5576 begin
5577 return Uint14 (E) /= No_Uint;
5578 end Known_Normalized_Position;
5580 function Known_Normalized_Position_Max (E : Entity_Id) return B is
5581 begin
5582 return Uint10 (E) /= No_Uint;
5583 end Known_Normalized_Position_Max;
5585 function Known_RM_Size (E : Entity_Id) return B is
5586 begin
5587 return Uint13 (E) /= No_Uint
5588 and then (Uint13 (E) /= Uint_0
5589 or else Is_Discrete_Type (E)
5590 or else Is_Fixed_Point_Type (E));
5591 end Known_RM_Size;
5593 function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is
5594 begin
5595 return Uint11 (E) /= No_Uint
5596 and then Uint11 (E) >= Uint_0;
5597 end Known_Static_Component_Bit_Offset;
5599 function Known_Static_Component_Size (E : Entity_Id) return B is
5600 begin
5601 return Uint22 (Base_Type (E)) > Uint_0;
5602 end Known_Static_Component_Size;
5604 function Known_Static_Esize (E : Entity_Id) return B is
5605 begin
5606 return Uint12 (E) > Uint_0
5607 and then not Is_Generic_Type (E);
5608 end Known_Static_Esize;
5610 function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is
5611 begin
5612 return Uint8 (E) /= No_Uint
5613 and then Uint8 (E) >= Uint_0;
5614 end Known_Static_Normalized_First_Bit;
5616 function Known_Static_Normalized_Position (E : Entity_Id) return B is
5617 begin
5618 return Uint14 (E) /= No_Uint
5619 and then Uint14 (E) >= Uint_0;
5620 end Known_Static_Normalized_Position;
5622 function Known_Static_Normalized_Position_Max (E : Entity_Id) return B is
5623 begin
5624 return Uint10 (E) /= No_Uint
5625 and then Uint10 (E) >= Uint_0;
5626 end Known_Static_Normalized_Position_Max;
5628 function Known_Static_RM_Size (E : Entity_Id) return B is
5629 begin
5630 return (Uint13 (E) > Uint_0
5631 or else Is_Discrete_Type (E)
5632 or else Is_Fixed_Point_Type (E))
5633 and then not Is_Generic_Type (E);
5634 end Known_Static_RM_Size;
5636 function Unknown_Alignment (E : Entity_Id) return B is
5637 begin
5638 return Uint14 (E) = Uint_0
5639 or else Uint14 (E) = No_Uint;
5640 end Unknown_Alignment;
5642 function Unknown_Component_Bit_Offset (E : Entity_Id) return B is
5643 begin
5644 return Uint11 (E) = No_Uint;
5645 end Unknown_Component_Bit_Offset;
5647 function Unknown_Component_Size (E : Entity_Id) return B is
5648 begin
5649 return Uint22 (Base_Type (E)) = Uint_0
5650 or else
5651 Uint22 (Base_Type (E)) = No_Uint;
5652 end Unknown_Component_Size;
5654 function Unknown_Esize (E : Entity_Id) return B is
5655 begin
5656 return Uint12 (E) = No_Uint
5657 or else
5658 Uint12 (E) = Uint_0;
5659 end Unknown_Esize;
5661 function Unknown_Normalized_First_Bit (E : Entity_Id) return B is
5662 begin
5663 return Uint8 (E) = No_Uint;
5664 end Unknown_Normalized_First_Bit;
5666 function Unknown_Normalized_Position (E : Entity_Id) return B is
5667 begin
5668 return Uint14 (E) = No_Uint;
5669 end Unknown_Normalized_Position;
5671 function Unknown_Normalized_Position_Max (E : Entity_Id) return B is
5672 begin
5673 return Uint10 (E) = No_Uint;
5674 end Unknown_Normalized_Position_Max;
5676 function Unknown_RM_Size (E : Entity_Id) return B is
5677 begin
5678 return (Uint13 (E) = Uint_0
5679 and then not Is_Discrete_Type (E)
5680 and then not Is_Fixed_Point_Type (E))
5681 or else Uint13 (E) = No_Uint;
5682 end Unknown_RM_Size;
5684 --------------------
5685 -- Address_Clause --
5686 --------------------
5688 function Address_Clause (Id : E) return N is
5689 begin
5690 return Rep_Clause (Id, Name_Address);
5691 end Address_Clause;
5693 ---------------
5694 -- Aft_Value --
5695 ---------------
5697 function Aft_Value (Id : E) return U is
5698 Result : Nat := 1;
5699 Delta_Val : Ureal := Delta_Value (Id);
5700 begin
5701 while Delta_Val < Ureal_Tenth loop
5702 Delta_Val := Delta_Val * Ureal_10;
5703 Result := Result + 1;
5704 end loop;
5706 return UI_From_Int (Result);
5707 end Aft_Value;
5709 ----------------------
5710 -- Alignment_Clause --
5711 ----------------------
5713 function Alignment_Clause (Id : E) return N is
5714 begin
5715 return Rep_Clause (Id, Name_Alignment);
5716 end Alignment_Clause;
5718 -------------------
5719 -- Append_Entity --
5720 -------------------
5722 procedure Append_Entity (Id : Entity_Id; V : Entity_Id) is
5723 begin
5724 if Last_Entity (V) = Empty then
5725 Set_First_Entity (Id => V, V => Id);
5726 else
5727 Set_Next_Entity (Last_Entity (V), Id);
5728 end if;
5730 Set_Next_Entity (Id, Empty);
5731 Set_Scope (Id, V);
5732 Set_Last_Entity (Id => V, V => Id);
5733 end Append_Entity;
5735 ---------------
5736 -- Base_Type --
5737 ---------------
5739 function Base_Type (Id : E) return E is
5740 begin
5741 if Is_Base_Type (Id) then
5742 return Id;
5743 else
5744 pragma Assert (Is_Type (Id));
5745 return Etype (Id);
5746 end if;
5747 end Base_Type;
5749 -------------------------
5750 -- Component_Alignment --
5751 -------------------------
5753 -- Component Alignment is encoded using two flags, Flag128/129 as
5754 -- follows. Note that both flags False = Align_Default, so that the
5755 -- default initialization of flags to False initializes component
5756 -- alignment to the default value as required.
5758 -- Flag128 Flag129 Value
5759 -- ------- ------- -----
5760 -- False False Calign_Default
5761 -- False True Calign_Component_Size
5762 -- True False Calign_Component_Size_4
5763 -- True True Calign_Storage_Unit
5765 function Component_Alignment (Id : E) return C is
5766 BT : constant Node_Id := Base_Type (Id);
5768 begin
5769 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
5771 if Flag128 (BT) then
5772 if Flag129 (BT) then
5773 return Calign_Storage_Unit;
5774 else
5775 return Calign_Component_Size_4;
5776 end if;
5778 else
5779 if Flag129 (BT) then
5780 return Calign_Component_Size;
5781 else
5782 return Calign_Default;
5783 end if;
5784 end if;
5785 end Component_Alignment;
5787 ----------------------
5788 -- Declaration_Node --
5789 ----------------------
5791 function Declaration_Node (Id : E) return N is
5792 P : Node_Id;
5794 begin
5795 if Ekind (Id) = E_Incomplete_Type
5796 and then Present (Full_View (Id))
5797 then
5798 P := Parent (Full_View (Id));
5799 else
5800 P := Parent (Id);
5801 end if;
5803 loop
5804 if Nkind (P) /= N_Selected_Component
5805 and then Nkind (P) /= N_Expanded_Name
5806 and then
5807 not (Nkind (P) = N_Defining_Program_Unit_Name
5808 and then Is_Child_Unit (Id))
5809 then
5810 return P;
5811 else
5812 P := Parent (P);
5813 end if;
5814 end loop;
5815 end Declaration_Node;
5817 ---------------------
5818 -- Designated_Type --
5819 ---------------------
5821 function Designated_Type (Id : E) return E is
5822 Desig_Type : E;
5824 begin
5825 Desig_Type := Directly_Designated_Type (Id);
5827 if Ekind (Desig_Type) = E_Incomplete_Type
5828 and then Present (Full_View (Desig_Type))
5829 then
5830 return Full_View (Desig_Type);
5832 elsif Is_Class_Wide_Type (Desig_Type)
5833 and then Ekind (Etype (Desig_Type)) = E_Incomplete_Type
5834 and then Present (Full_View (Etype (Desig_Type)))
5835 and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type))))
5836 then
5837 return Class_Wide_Type (Full_View (Etype (Desig_Type)));
5839 else
5840 return Desig_Type;
5841 end if;
5842 end Designated_Type;
5844 ----------------------
5845 -- Entry_Index_Type --
5846 ----------------------
5848 function Entry_Index_Type (Id : E) return N is
5849 begin
5850 pragma Assert (Ekind (Id) = E_Entry_Family);
5851 return Etype (Discrete_Subtype_Definition (Parent (Id)));
5852 end Entry_Index_Type;
5854 ---------------------
5855 -- First_Component --
5856 ---------------------
5858 function First_Component (Id : E) return E is
5859 Comp_Id : E;
5861 begin
5862 pragma Assert
5863 (Is_Record_Type (Id) or else Is_Incomplete_Or_Private_Type (Id));
5865 Comp_Id := First_Entity (Id);
5866 while Present (Comp_Id) loop
5867 exit when Ekind (Comp_Id) = E_Component;
5868 Comp_Id := Next_Entity (Comp_Id);
5869 end loop;
5871 return Comp_Id;
5872 end First_Component;
5874 -------------------------------------
5875 -- First_Component_Or_Discriminant --
5876 -------------------------------------
5878 function First_Component_Or_Discriminant (Id : E) return E is
5879 Comp_Id : E;
5881 begin
5882 pragma Assert
5883 (Is_Record_Type (Id) or else Is_Incomplete_Or_Private_Type (Id));
5885 Comp_Id := First_Entity (Id);
5886 while Present (Comp_Id) loop
5887 exit when Ekind (Comp_Id) = E_Component
5888 or else
5889 Ekind (Comp_Id) = E_Discriminant;
5890 Comp_Id := Next_Entity (Comp_Id);
5891 end loop;
5893 return Comp_Id;
5894 end First_Component_Or_Discriminant;
5896 ------------------
5897 -- First_Formal --
5898 ------------------
5900 function First_Formal (Id : E) return E is
5901 Formal : E;
5903 begin
5904 pragma Assert
5905 (Is_Overloadable (Id)
5906 or else Ekind_In (Id, E_Entry_Family,
5907 E_Subprogram_Body,
5908 E_Subprogram_Type));
5910 if Ekind (Id) = E_Enumeration_Literal then
5911 return Empty;
5913 else
5914 Formal := First_Entity (Id);
5916 if Present (Formal) and then Is_Formal (Formal) then
5917 return Formal;
5918 else
5919 return Empty;
5920 end if;
5921 end if;
5922 end First_Formal;
5924 ------------------------------
5925 -- First_Formal_With_Extras --
5926 ------------------------------
5928 function First_Formal_With_Extras (Id : E) return E is
5929 Formal : E;
5931 begin
5932 pragma Assert
5933 (Is_Overloadable (Id)
5934 or else Ekind_In (Id, E_Entry_Family,
5935 E_Subprogram_Body,
5936 E_Subprogram_Type));
5938 if Ekind (Id) = E_Enumeration_Literal then
5939 return Empty;
5941 else
5942 Formal := First_Entity (Id);
5944 if Present (Formal) and then Is_Formal (Formal) then
5945 return Formal;
5946 else
5947 return Extra_Formals (Id); -- Empty if no extra formals
5948 end if;
5949 end if;
5950 end First_Formal_With_Extras;
5952 -------------------------------------
5953 -- Get_Attribute_Definition_Clause --
5954 -------------------------------------
5956 function Get_Attribute_Definition_Clause
5957 (E : Entity_Id;
5958 Id : Attribute_Id) return Node_Id
5960 N : Node_Id;
5962 begin
5963 N := First_Rep_Item (E);
5964 while Present (N) loop
5965 if Nkind (N) = N_Attribute_Definition_Clause
5966 and then Get_Attribute_Id (Chars (N)) = Id
5967 then
5968 return N;
5969 else
5970 Next_Rep_Item (N);
5971 end if;
5972 end loop;
5974 return Empty;
5975 end Get_Attribute_Definition_Clause;
5977 -------------------
5978 -- Get_Full_View --
5979 -------------------
5981 function Get_Full_View (T : Entity_Id) return Entity_Id is
5982 begin
5983 if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then
5984 return Full_View (T);
5986 elsif Is_Class_Wide_Type (T)
5987 and then Ekind (Root_Type (T)) = E_Incomplete_Type
5988 and then Present (Full_View (Root_Type (T)))
5989 then
5990 return Class_Wide_Type (Full_View (Root_Type (T)));
5992 else
5993 return T;
5994 end if;
5995 end Get_Full_View;
5997 --------------------------------------
5998 -- Get_Record_Representation_Clause --
5999 --------------------------------------
6001 function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id is
6002 N : Node_Id;
6004 begin
6005 N := First_Rep_Item (E);
6006 while Present (N) loop
6007 if Nkind (N) = N_Record_Representation_Clause then
6008 return N;
6009 end if;
6011 Next_Rep_Item (N);
6012 end loop;
6014 return Empty;
6015 end Get_Record_Representation_Clause;
6017 -----------------------------
6018 -- Get_Rep_Item_For_Entity --
6019 -----------------------------
6021 function Get_Rep_Item_For_Entity
6022 (E : Entity_Id;
6023 Nam : Name_Id) return Node_Id
6025 N : Node_Id;
6026 Arg : Node_Id;
6028 begin
6029 N := First_Rep_Item (E);
6030 while Present (N) loop
6031 if Nkind (N) = N_Pragma and then Pragma_Name (N) = Nam then
6032 Arg := Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
6034 if Is_Entity_Name (Arg) and then Entity (Arg) = E then
6035 return N;
6036 end if;
6038 elsif Nkind (N) = N_Attribute_Definition_Clause
6039 and then Chars (N) = Nam
6040 and then Entity (N) = E
6041 then
6042 return N;
6044 elsif Nkind (N) = N_Aspect_Specification
6045 and then Chars (Identifier (N)) = Nam
6046 and then Entity (N) = E
6047 then
6048 return N;
6049 end if;
6051 Next_Rep_Item (N);
6052 end loop;
6054 return Empty;
6055 end Get_Rep_Item_For_Entity;
6057 --------------------
6058 -- Get_Rep_Pragma --
6059 --------------------
6061 function Get_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Node_Id is
6062 N : Node_Id;
6064 begin
6065 N := First_Rep_Item (E);
6066 while Present (N) loop
6067 if Nkind (N) = N_Pragma and then Pragma_Name (N) = Nam then
6068 return N;
6069 end if;
6071 Next_Rep_Item (N);
6072 end loop;
6074 return Empty;
6075 end Get_Rep_Pragma;
6077 ------------------------
6078 -- Has_Attach_Handler --
6079 ------------------------
6081 function Has_Attach_Handler (Id : E) return B is
6082 Ritem : Node_Id;
6084 begin
6085 pragma Assert (Is_Protected_Type (Id));
6087 Ritem := First_Rep_Item (Id);
6088 while Present (Ritem) loop
6089 if Nkind (Ritem) = N_Pragma
6090 and then Pragma_Name (Ritem) = Name_Attach_Handler
6091 then
6092 return True;
6093 else
6094 Next_Rep_Item (Ritem);
6095 end if;
6096 end loop;
6098 return False;
6099 end Has_Attach_Handler;
6101 -------------------------------------
6102 -- Has_Attribute_Definition_Clause --
6103 -------------------------------------
6105 function Has_Attribute_Definition_Clause
6106 (E : Entity_Id;
6107 Id : Attribute_Id) return Boolean
6109 begin
6110 return Present (Get_Attribute_Definition_Clause (E, Id));
6111 end Has_Attribute_Definition_Clause;
6113 -----------------
6114 -- Has_Entries --
6115 -----------------
6117 function Has_Entries (Id : E) return B is
6118 Ent : Entity_Id;
6120 begin
6121 pragma Assert (Is_Concurrent_Type (Id));
6123 Ent := First_Entity (Id);
6124 while Present (Ent) loop
6125 if Is_Entry (Ent) then
6126 return True;
6127 end if;
6129 Ent := Next_Entity (Ent);
6130 end loop;
6132 return False;
6133 end Has_Entries;
6135 ----------------------------
6136 -- Has_Foreign_Convention --
6137 ----------------------------
6139 function Has_Foreign_Convention (Id : E) return B is
6140 begin
6141 -- While regular Intrinsics such as the Standard operators fit in the
6142 -- "Ada" convention, those with an Interface_Name materialize GCC
6143 -- builtin imports for which Ada special treatments shouldn't apply.
6145 return Convention (Id) in Foreign_Convention
6146 or else (Convention (Id) = Convention_Intrinsic
6147 and then Present (Interface_Name (Id)));
6148 end Has_Foreign_Convention;
6150 ---------------------------
6151 -- Has_Interrupt_Handler --
6152 ---------------------------
6154 function Has_Interrupt_Handler (Id : E) return B is
6155 Ritem : Node_Id;
6157 begin
6158 pragma Assert (Is_Protected_Type (Id));
6160 Ritem := First_Rep_Item (Id);
6161 while Present (Ritem) loop
6162 if Nkind (Ritem) = N_Pragma
6163 and then Pragma_Name (Ritem) = Name_Interrupt_Handler
6164 then
6165 return True;
6166 else
6167 Next_Rep_Item (Ritem);
6168 end if;
6169 end loop;
6171 return False;
6172 end Has_Interrupt_Handler;
6174 --------------------
6175 -- Has_Rep_Pragma --
6176 --------------------
6178 function Has_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Boolean is
6179 begin
6180 return Present (Get_Rep_Pragma (E, Nam));
6181 end Has_Rep_Pragma;
6183 --------------------
6184 -- Has_Unmodified --
6185 --------------------
6187 function Has_Unmodified (E : Entity_Id) return Boolean is
6188 begin
6189 if Has_Pragma_Unmodified (E) then
6190 return True;
6191 elsif Warnings_Off (E) then
6192 Set_Warnings_Off_Used_Unmodified (E);
6193 return True;
6194 else
6195 return False;
6196 end if;
6197 end Has_Unmodified;
6199 ---------------------
6200 -- Has_Unreferenced --
6201 ---------------------
6203 function Has_Unreferenced (E : Entity_Id) return Boolean is
6204 begin
6205 if Has_Pragma_Unreferenced (E) then
6206 return True;
6207 elsif Warnings_Off (E) then
6208 Set_Warnings_Off_Used_Unreferenced (E);
6209 return True;
6210 else
6211 return False;
6212 end if;
6213 end Has_Unreferenced;
6215 ----------------------
6216 -- Has_Warnings_Off --
6217 ----------------------
6219 function Has_Warnings_Off (E : Entity_Id) return Boolean is
6220 begin
6221 if Warnings_Off (E) then
6222 Set_Warnings_Off_Used (E);
6223 return True;
6224 else
6225 return False;
6226 end if;
6227 end Has_Warnings_Off;
6229 ------------------------------
6230 -- Implementation_Base_Type --
6231 ------------------------------
6233 function Implementation_Base_Type (Id : E) return E is
6234 Bastyp : Entity_Id;
6235 Imptyp : Entity_Id;
6237 begin
6238 Bastyp := Base_Type (Id);
6240 if Is_Incomplete_Or_Private_Type (Bastyp) then
6241 Imptyp := Underlying_Type (Bastyp);
6243 -- If we have an implementation type, then just return it,
6244 -- otherwise we return the Base_Type anyway. This can only
6245 -- happen in error situations and should avoid some error bombs.
6247 if Present (Imptyp) then
6248 return Base_Type (Imptyp);
6249 else
6250 return Bastyp;
6251 end if;
6253 else
6254 return Bastyp;
6255 end if;
6256 end Implementation_Base_Type;
6258 -------------------------
6259 -- Invariant_Procedure --
6260 -------------------------
6262 function Invariant_Procedure (Id : E) return E is
6263 S : Entity_Id;
6265 begin
6266 pragma Assert (Is_Type (Id) and then Has_Invariants (Id));
6268 if No (Subprograms_For_Type (Id)) then
6269 return Empty;
6271 else
6272 S := Subprograms_For_Type (Id);
6273 while Present (S) loop
6274 if Has_Invariants (S) then
6275 return S;
6276 else
6277 S := Subprograms_For_Type (S);
6278 end if;
6279 end loop;
6281 return Empty;
6282 end if;
6283 end Invariant_Procedure;
6285 ------------------
6286 -- Is_Base_Type --
6287 ------------------
6289 -- Global flag table allowing rapid computation of this function
6291 Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean :=
6292 (E_Enumeration_Subtype |
6293 E_Incomplete_Type |
6294 E_Signed_Integer_Subtype |
6295 E_Modular_Integer_Subtype |
6296 E_Floating_Point_Subtype |
6297 E_Ordinary_Fixed_Point_Subtype |
6298 E_Decimal_Fixed_Point_Subtype |
6299 E_Array_Subtype |
6300 E_String_Subtype |
6301 E_Record_Subtype |
6302 E_Private_Subtype |
6303 E_Record_Subtype_With_Private |
6304 E_Limited_Private_Subtype |
6305 E_Access_Subtype |
6306 E_Protected_Subtype |
6307 E_Task_Subtype |
6308 E_String_Literal_Subtype |
6309 E_Class_Wide_Subtype => False,
6310 others => True);
6312 function Is_Base_Type (Id : E) return Boolean is
6313 begin
6314 return Entity_Is_Base_Type (Ekind (Id));
6315 end Is_Base_Type;
6317 ---------------------
6318 -- Is_Boolean_Type --
6319 ---------------------
6321 function Is_Boolean_Type (Id : E) return B is
6322 begin
6323 return Root_Type (Id) = Standard_Boolean;
6324 end Is_Boolean_Type;
6326 ------------------------
6327 -- Is_Constant_Object --
6328 ------------------------
6330 function Is_Constant_Object (Id : E) return B is
6331 K : constant Entity_Kind := Ekind (Id);
6332 begin
6333 return
6334 K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
6335 end Is_Constant_Object;
6337 --------------------
6338 -- Is_Discriminal --
6339 --------------------
6341 function Is_Discriminal (Id : E) return B is
6342 begin
6343 return (Ekind_In (Id, E_Constant, E_In_Parameter)
6344 and then Present (Discriminal_Link (Id)));
6345 end Is_Discriminal;
6347 ----------------------
6348 -- Is_Dynamic_Scope --
6349 ----------------------
6351 function Is_Dynamic_Scope (Id : E) return B is
6352 begin
6353 return
6354 Ekind (Id) = E_Block
6355 or else
6356 Ekind (Id) = E_Function
6357 or else
6358 Ekind (Id) = E_Procedure
6359 or else
6360 Ekind (Id) = E_Subprogram_Body
6361 or else
6362 Ekind (Id) = E_Task_Type
6363 or else
6364 (Ekind (Id) = E_Limited_Private_Type
6365 and then Present (Full_View (Id))
6366 and then Ekind (Full_View (Id)) = E_Task_Type)
6367 or else
6368 Ekind (Id) = E_Entry
6369 or else
6370 Ekind (Id) = E_Entry_Family
6371 or else
6372 Ekind (Id) = E_Return_Statement;
6373 end Is_Dynamic_Scope;
6375 --------------------
6376 -- Is_Entity_Name --
6377 --------------------
6379 function Is_Entity_Name (N : Node_Id) return Boolean is
6380 Kind : constant Node_Kind := Nkind (N);
6382 begin
6383 -- Identifiers, operator symbols, expanded names are entity names
6385 return Kind = N_Identifier
6386 or else Kind = N_Operator_Symbol
6387 or else Kind = N_Expanded_Name
6389 -- Attribute references are entity names if they refer to an entity.
6390 -- Note that we don't do this by testing for the presence of the
6391 -- Entity field in the N_Attribute_Reference node, since it may not
6392 -- have been set yet.
6394 or else (Kind = N_Attribute_Reference
6395 and then Is_Entity_Attribute_Name (Attribute_Name (N)));
6396 end Is_Entity_Name;
6398 ------------------
6399 -- Is_Finalizer --
6400 ------------------
6402 function Is_Finalizer (Id : E) return B is
6403 begin
6404 return Ekind (Id) = E_Procedure
6405 and then Chars (Id) = Name_uFinalizer;
6406 end Is_Finalizer;
6408 -----------------------------------
6409 -- Is_Package_Or_Generic_Package --
6410 -----------------------------------
6412 function Is_Package_Or_Generic_Package (Id : E) return B is
6413 begin
6414 return
6415 Ekind (Id) = E_Package
6416 or else
6417 Ekind (Id) = E_Generic_Package;
6418 end Is_Package_Or_Generic_Package;
6420 ------------------------
6421 -- Predicate_Function --
6422 ------------------------
6424 function Predicate_Function (Id : E) return E is
6425 S : Entity_Id;
6427 begin
6428 pragma Assert (Is_Type (Id));
6430 if No (Subprograms_For_Type (Id)) then
6431 return Empty;
6433 else
6434 S := Subprograms_For_Type (Id);
6435 while Present (S) loop
6436 if Has_Predicates (S) then
6437 return S;
6438 else
6439 S := Subprograms_For_Type (S);
6440 end if;
6441 end loop;
6443 return Empty;
6444 end if;
6445 end Predicate_Function;
6447 ---------------
6448 -- Is_Prival --
6449 ---------------
6451 function Is_Prival (Id : E) return B is
6452 begin
6453 return (Ekind_In (Id, E_Constant, E_Variable)
6454 and then Present (Prival_Link (Id)));
6455 end Is_Prival;
6457 ----------------------------
6458 -- Is_Protected_Component --
6459 ----------------------------
6461 function Is_Protected_Component (Id : E) return B is
6462 begin
6463 return Ekind (Id) = E_Component
6464 and then Is_Protected_Type (Scope (Id));
6465 end Is_Protected_Component;
6467 ----------------------------
6468 -- Is_Protected_Interface --
6469 ----------------------------
6471 function Is_Protected_Interface (Id : E) return B is
6472 Typ : constant Entity_Id := Base_Type (Id);
6473 begin
6474 if not Is_Interface (Typ) then
6475 return False;
6476 elsif Is_Class_Wide_Type (Typ) then
6477 return Is_Protected_Interface (Etype (Typ));
6478 else
6479 return Protected_Present (Type_Definition (Parent (Typ)));
6480 end if;
6481 end Is_Protected_Interface;
6483 ------------------------------
6484 -- Is_Protected_Record_Type --
6485 ------------------------------
6487 function Is_Protected_Record_Type (Id : E) return B is
6488 begin
6489 return
6490 Is_Concurrent_Record_Type (Id)
6491 and then Is_Protected_Type (Corresponding_Concurrent_Type (Id));
6492 end Is_Protected_Record_Type;
6494 --------------------------------
6495 -- Is_Standard_Character_Type --
6496 --------------------------------
6498 function Is_Standard_Character_Type (Id : E) return B is
6499 begin
6500 if Is_Type (Id) then
6501 declare
6502 R : constant Entity_Id := Root_Type (Id);
6503 begin
6504 return
6505 R = Standard_Character
6506 or else
6507 R = Standard_Wide_Character
6508 or else
6509 R = Standard_Wide_Wide_Character;
6510 end;
6512 else
6513 return False;
6514 end if;
6515 end Is_Standard_Character_Type;
6517 --------------------
6518 -- Is_String_Type --
6519 --------------------
6521 function Is_String_Type (Id : E) return B is
6522 begin
6523 return Ekind (Id) in String_Kind
6524 or else (Is_Array_Type (Id)
6525 and then Id /= Any_Composite
6526 and then Number_Dimensions (Id) = 1
6527 and then Is_Character_Type (Component_Type (Id)));
6528 end Is_String_Type;
6530 -------------------------------
6531 -- Is_Synchronized_Interface --
6532 -------------------------------
6534 function Is_Synchronized_Interface (Id : E) return B is
6535 Typ : constant Entity_Id := Base_Type (Id);
6537 begin
6538 if not Is_Interface (Typ) then
6539 return False;
6541 elsif Is_Class_Wide_Type (Typ) then
6542 return Is_Synchronized_Interface (Etype (Typ));
6544 else
6545 return Protected_Present (Type_Definition (Parent (Typ)))
6546 or else Synchronized_Present (Type_Definition (Parent (Typ)))
6547 or else Task_Present (Type_Definition (Parent (Typ)));
6548 end if;
6549 end Is_Synchronized_Interface;
6551 -----------------------
6552 -- Is_Task_Interface --
6553 -----------------------
6555 function Is_Task_Interface (Id : E) return B is
6556 Typ : constant Entity_Id := Base_Type (Id);
6557 begin
6558 if not Is_Interface (Typ) then
6559 return False;
6560 elsif Is_Class_Wide_Type (Typ) then
6561 return Is_Task_Interface (Etype (Typ));
6562 else
6563 return Task_Present (Type_Definition (Parent (Typ)));
6564 end if;
6565 end Is_Task_Interface;
6567 -------------------------
6568 -- Is_Task_Record_Type --
6569 -------------------------
6571 function Is_Task_Record_Type (Id : E) return B is
6572 begin
6573 return
6574 Is_Concurrent_Record_Type (Id)
6575 and then Is_Task_Type (Corresponding_Concurrent_Type (Id));
6576 end Is_Task_Record_Type;
6578 ------------------------
6579 -- Is_Wrapper_Package --
6580 ------------------------
6582 function Is_Wrapper_Package (Id : E) return B is
6583 begin
6584 return (Ekind (Id) = E_Package
6585 and then Present (Related_Instance (Id)));
6586 end Is_Wrapper_Package;
6588 -----------------
6589 -- Last_Formal --
6590 -----------------
6592 function Last_Formal (Id : E) return E is
6593 Formal : E;
6595 begin
6596 pragma Assert
6597 (Is_Overloadable (Id)
6598 or else Ekind_In (Id, E_Entry_Family,
6599 E_Subprogram_Body,
6600 E_Subprogram_Type));
6602 if Ekind (Id) = E_Enumeration_Literal then
6603 return Empty;
6605 else
6606 Formal := First_Formal (Id);
6608 if Present (Formal) then
6609 while Present (Next_Formal (Formal)) loop
6610 Formal := Next_Formal (Formal);
6611 end loop;
6612 end if;
6614 return Formal;
6615 end if;
6616 end Last_Formal;
6618 function Model_Emin_Value (Id : E) return Uint is
6619 begin
6620 return Machine_Emin_Value (Id);
6621 end Model_Emin_Value;
6623 -------------------------
6624 -- Model_Epsilon_Value --
6625 -------------------------
6627 function Model_Epsilon_Value (Id : E) return Ureal is
6628 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
6629 begin
6630 return Radix ** (1 - Model_Mantissa_Value (Id));
6631 end Model_Epsilon_Value;
6633 --------------------------
6634 -- Model_Mantissa_Value --
6635 --------------------------
6637 function Model_Mantissa_Value (Id : E) return Uint is
6638 begin
6639 return Machine_Mantissa_Value (Id);
6640 end Model_Mantissa_Value;
6642 -----------------------
6643 -- Model_Small_Value --
6644 -----------------------
6646 function Model_Small_Value (Id : E) return Ureal is
6647 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
6648 begin
6649 return Radix ** (Model_Emin_Value (Id) - 1);
6650 end Model_Small_Value;
6652 ------------------------
6653 -- Machine_Emax_Value --
6654 ------------------------
6656 function Machine_Emax_Value (Id : E) return Uint is
6657 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
6659 begin
6660 case Float_Rep (Id) is
6661 when IEEE_Binary =>
6662 case Digs is
6663 when 1 .. 6 => return Uint_128;
6664 when 7 .. 15 => return 2**10;
6665 when 16 .. 33 => return 2**14;
6666 when others => return No_Uint;
6667 end case;
6669 when VAX_Native =>
6670 case Digs is
6671 when 1 .. 9 => return 2**7 - 1;
6672 when 10 .. 15 => return 2**10 - 1;
6673 when others => return No_Uint;
6674 end case;
6676 when AAMP =>
6677 return Uint_2 ** Uint_7 - Uint_1;
6678 end case;
6679 end Machine_Emax_Value;
6681 ------------------------
6682 -- Machine_Emin_Value --
6683 ------------------------
6685 function Machine_Emin_Value (Id : E) return Uint is
6686 begin
6687 case Float_Rep (Id) is
6688 when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id);
6689 when VAX_Native => return -Machine_Emax_Value (Id);
6690 when AAMP => return -Machine_Emax_Value (Id);
6691 end case;
6692 end Machine_Emin_Value;
6694 ----------------------------
6695 -- Machine_Mantissa_Value --
6696 ----------------------------
6698 function Machine_Mantissa_Value (Id : E) return Uint is
6699 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
6701 begin
6702 case Float_Rep (Id) is
6703 when IEEE_Binary =>
6704 case Digs is
6705 when 1 .. 6 => return Uint_24;
6706 when 7 .. 15 => return UI_From_Int (53);
6707 when 16 .. 18 => return Uint_64;
6708 when 19 .. 33 => return UI_From_Int (113);
6709 when others => return No_Uint;
6710 end case;
6712 when VAX_Native =>
6713 case Digs is
6714 when 1 .. 6 => return Uint_24;
6715 when 7 .. 9 => return UI_From_Int (56);
6716 when 10 .. 15 => return UI_From_Int (53);
6717 when others => return No_Uint;
6718 end case;
6720 when AAMP =>
6721 case Digs is
6722 when 1 .. 6 => return Uint_24;
6723 when 7 .. 9 => return UI_From_Int (40);
6724 when others => return No_Uint;
6725 end case;
6726 end case;
6727 end Machine_Mantissa_Value;
6729 -------------------------
6730 -- Machine_Radix_Value --
6731 -------------------------
6733 function Machine_Radix_Value (Id : E) return U is
6734 begin
6735 case Float_Rep (Id) is
6736 when IEEE_Binary | VAX_Native | AAMP =>
6737 return Uint_2;
6738 end case;
6739 end Machine_Radix_Value;
6741 --------------------
6742 -- Next_Component --
6743 --------------------
6745 function Next_Component (Id : E) return E is
6746 Comp_Id : E;
6748 begin
6749 Comp_Id := Next_Entity (Id);
6750 while Present (Comp_Id) loop
6751 exit when Ekind (Comp_Id) = E_Component;
6752 Comp_Id := Next_Entity (Comp_Id);
6753 end loop;
6755 return Comp_Id;
6756 end Next_Component;
6758 ------------------------------------
6759 -- Next_Component_Or_Discriminant --
6760 ------------------------------------
6762 function Next_Component_Or_Discriminant (Id : E) return E is
6763 Comp_Id : E;
6765 begin
6766 Comp_Id := Next_Entity (Id);
6767 while Present (Comp_Id) loop
6768 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
6769 Comp_Id := Next_Entity (Comp_Id);
6770 end loop;
6772 return Comp_Id;
6773 end Next_Component_Or_Discriminant;
6775 -----------------------
6776 -- Next_Discriminant --
6777 -----------------------
6779 -- This function actually implements both Next_Discriminant and
6780 -- Next_Stored_Discriminant by making sure that the Discriminant
6781 -- returned is of the same variety as Id.
6783 function Next_Discriminant (Id : E) return E is
6785 -- Derived Tagged types with private extensions look like this...
6787 -- E_Discriminant d1
6788 -- E_Discriminant d2
6789 -- E_Component _tag
6790 -- E_Discriminant d1
6791 -- E_Discriminant d2
6792 -- ...
6794 -- so it is critical not to go past the leading discriminants
6796 D : E := Id;
6798 begin
6799 pragma Assert (Ekind (Id) = E_Discriminant);
6801 loop
6802 D := Next_Entity (D);
6803 if No (D)
6804 or else (Ekind (D) /= E_Discriminant
6805 and then not Is_Itype (D))
6806 then
6807 return Empty;
6808 end if;
6810 exit when Ekind (D) = E_Discriminant
6811 and then (Is_Completely_Hidden (D) = Is_Completely_Hidden (Id));
6812 end loop;
6814 return D;
6815 end Next_Discriminant;
6817 -----------------
6818 -- Next_Formal --
6819 -----------------
6821 function Next_Formal (Id : E) return E is
6822 P : E;
6824 begin
6825 -- Follow the chain of declared entities as long as the kind of the
6826 -- entity corresponds to a formal parameter. Skip internal entities
6827 -- that may have been created for implicit subtypes, in the process
6828 -- of analyzing default expressions.
6830 P := Id;
6831 loop
6832 P := Next_Entity (P);
6834 if No (P) or else Is_Formal (P) then
6835 return P;
6836 elsif not Is_Internal (P) then
6837 return Empty;
6838 end if;
6839 end loop;
6840 end Next_Formal;
6842 -----------------------------
6843 -- Next_Formal_With_Extras --
6844 -----------------------------
6846 function Next_Formal_With_Extras (Id : E) return E is
6847 begin
6848 if Present (Extra_Formal (Id)) then
6849 return Extra_Formal (Id);
6850 else
6851 return Next_Formal (Id);
6852 end if;
6853 end Next_Formal_With_Extras;
6855 ----------------
6856 -- Next_Index --
6857 ----------------
6859 function Next_Index (Id : Node_Id) return Node_Id is
6860 begin
6861 return Next (Id);
6862 end Next_Index;
6864 ------------------
6865 -- Next_Literal --
6866 ------------------
6868 function Next_Literal (Id : E) return E is
6869 begin
6870 pragma Assert (Nkind (Id) in N_Entity);
6871 return Next (Id);
6872 end Next_Literal;
6874 ------------------------------
6875 -- Next_Stored_Discriminant --
6876 ------------------------------
6878 function Next_Stored_Discriminant (Id : E) return E is
6879 begin
6880 -- See comment in Next_Discriminant
6882 return Next_Discriminant (Id);
6883 end Next_Stored_Discriminant;
6885 -----------------------
6886 -- Number_Dimensions --
6887 -----------------------
6889 function Number_Dimensions (Id : E) return Pos is
6890 N : Int;
6891 T : Node_Id;
6893 begin
6894 if Ekind (Id) in String_Kind then
6895 return 1;
6897 else
6898 N := 0;
6899 T := First_Index (Id);
6900 while Present (T) loop
6901 N := N + 1;
6902 T := Next (T);
6903 end loop;
6905 return N;
6906 end if;
6907 end Number_Dimensions;
6909 --------------------
6910 -- Number_Entries --
6911 --------------------
6913 function Number_Entries (Id : E) return Nat is
6914 N : Int;
6915 Ent : Entity_Id;
6917 begin
6918 pragma Assert (Is_Concurrent_Type (Id));
6920 N := 0;
6921 Ent := First_Entity (Id);
6922 while Present (Ent) loop
6923 if Is_Entry (Ent) then
6924 N := N + 1;
6925 end if;
6927 Ent := Next_Entity (Ent);
6928 end loop;
6930 return N;
6931 end Number_Entries;
6933 --------------------
6934 -- Number_Formals --
6935 --------------------
6937 function Number_Formals (Id : E) return Pos is
6938 N : Int;
6939 Formal : Entity_Id;
6941 begin
6942 N := 0;
6943 Formal := First_Formal (Id);
6944 while Present (Formal) loop
6945 N := N + 1;
6946 Formal := Next_Formal (Formal);
6947 end loop;
6949 return N;
6950 end Number_Formals;
6952 --------------------
6953 -- Parameter_Mode --
6954 --------------------
6956 function Parameter_Mode (Id : E) return Formal_Kind is
6957 begin
6958 return Ekind (Id);
6959 end Parameter_Mode;
6961 --------------------------
6962 -- Primitive_Operations --
6963 --------------------------
6965 function Primitive_Operations (Id : E) return L is
6966 begin
6967 if Is_Concurrent_Type (Id) then
6968 if Present (Corresponding_Record_Type (Id)) then
6969 return Direct_Primitive_Operations
6970 (Corresponding_Record_Type (Id));
6972 -- If expansion is disabled the corresponding record type is absent,
6973 -- but if the type has ancestors it may have primitive operations.
6975 elsif Is_Tagged_Type (Id) then
6976 return Direct_Primitive_Operations (Id);
6978 else
6979 return No_Elist;
6980 end if;
6981 else
6982 return Direct_Primitive_Operations (Id);
6983 end if;
6984 end Primitive_Operations;
6986 ---------------------
6987 -- Record_Rep_Item --
6988 ---------------------
6990 procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is
6991 begin
6992 Set_Next_Rep_Item (N, First_Rep_Item (E));
6993 Set_First_Rep_Item (E, N);
6994 end Record_Rep_Item;
6996 ---------------
6997 -- Root_Type --
6998 ---------------
7000 function Root_Type (Id : E) return E is
7001 T, Etyp : E;
7003 begin
7004 pragma Assert (Nkind (Id) in N_Entity);
7006 T := Base_Type (Id);
7008 if Ekind (T) = E_Class_Wide_Type then
7009 return Etype (T);
7011 -- Other cases
7013 else
7014 loop
7015 Etyp := Etype (T);
7017 if T = Etyp then
7018 return T;
7020 -- Following test catches some error cases resulting from
7021 -- previous errors.
7023 elsif No (Etyp) then
7024 return T;
7026 elsif Is_Private_Type (T) and then Etyp = Full_View (T) then
7027 return T;
7029 elsif Is_Private_Type (Etyp) and then Full_View (Etyp) = T then
7030 return T;
7031 end if;
7033 T := Etyp;
7035 -- Return if there is a circularity in the inheritance chain. This
7036 -- happens in some error situations and we do not want to get
7037 -- stuck in this loop.
7039 if T = Base_Type (Id) then
7040 return T;
7041 end if;
7042 end loop;
7043 end if;
7044 end Root_Type;
7046 ---------------------
7047 -- Safe_Emax_Value --
7048 ---------------------
7050 function Safe_Emax_Value (Id : E) return Uint is
7051 begin
7052 return Machine_Emax_Value (Id);
7053 end Safe_Emax_Value;
7055 ----------------------
7056 -- Safe_First_Value --
7057 ----------------------
7059 function Safe_First_Value (Id : E) return Ureal is
7060 begin
7061 return -Safe_Last_Value (Id);
7062 end Safe_First_Value;
7064 ---------------------
7065 -- Safe_Last_Value --
7066 ---------------------
7068 function Safe_Last_Value (Id : E) return Ureal is
7069 Radix : constant Uint := Machine_Radix_Value (Id);
7070 Mantissa : constant Uint := Machine_Mantissa_Value (Id);
7071 Emax : constant Uint := Safe_Emax_Value (Id);
7072 Significand : constant Uint := Radix ** Mantissa - 1;
7073 Exponent : constant Uint := Emax - Mantissa;
7075 begin
7076 if Radix = 2 then
7077 return
7078 UR_From_Components
7079 (Num => Significand * 2 ** (Exponent mod 4),
7080 Den => -Exponent / 4,
7081 Rbase => 16);
7083 else
7084 return
7085 UR_From_Components
7086 (Num => Significand,
7087 Den => -Exponent,
7088 Rbase => 16);
7089 end if;
7090 end Safe_Last_Value;
7092 -----------------
7093 -- Scope_Depth --
7094 -----------------
7096 function Scope_Depth (Id : E) return Uint is
7097 Scop : Entity_Id;
7099 begin
7100 Scop := Id;
7101 while Is_Record_Type (Scop) loop
7102 Scop := Scope (Scop);
7103 end loop;
7105 return Scope_Depth_Value (Scop);
7106 end Scope_Depth;
7108 ---------------------
7109 -- Scope_Depth_Set --
7110 ---------------------
7112 function Scope_Depth_Set (Id : E) return B is
7113 begin
7114 return not Is_Record_Type (Id)
7115 and then Field22 (Id) /= Union_Id (Empty);
7116 end Scope_Depth_Set;
7118 -----------------------------
7119 -- Set_Component_Alignment --
7120 -----------------------------
7122 -- Component Alignment is encoded using two flags, Flag128/129 as
7123 -- follows. Note that both flags False = Align_Default, so that the
7124 -- default initialization of flags to False initializes component
7125 -- alignment to the default value as required.
7127 -- Flag128 Flag129 Value
7128 -- ------- ------- -----
7129 -- False False Calign_Default
7130 -- False True Calign_Component_Size
7131 -- True False Calign_Component_Size_4
7132 -- True True Calign_Storage_Unit
7134 procedure Set_Component_Alignment (Id : E; V : C) is
7135 begin
7136 pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
7137 and then Is_Base_Type (Id));
7139 case V is
7140 when Calign_Default =>
7141 Set_Flag128 (Id, False);
7142 Set_Flag129 (Id, False);
7144 when Calign_Component_Size =>
7145 Set_Flag128 (Id, False);
7146 Set_Flag129 (Id, True);
7148 when Calign_Component_Size_4 =>
7149 Set_Flag128 (Id, True);
7150 Set_Flag129 (Id, False);
7152 when Calign_Storage_Unit =>
7153 Set_Flag128 (Id, True);
7154 Set_Flag129 (Id, True);
7155 end case;
7156 end Set_Component_Alignment;
7158 -----------------------------
7159 -- Set_Invariant_Procedure --
7160 -----------------------------
7162 procedure Set_Invariant_Procedure (Id : E; V : E) is
7163 S : Entity_Id;
7165 begin
7166 pragma Assert (Is_Type (Id) and then Has_Invariants (Id));
7168 S := Subprograms_For_Type (Id);
7169 Set_Subprograms_For_Type (Id, V);
7171 while Present (S) loop
7172 if Has_Invariants (S) then
7173 raise Program_Error;
7174 else
7175 S := Subprograms_For_Type (S);
7176 end if;
7177 end loop;
7179 Set_Subprograms_For_Type (Id, V);
7180 end Set_Invariant_Procedure;
7182 ----------------------------
7183 -- Set_Predicate_Function --
7184 ----------------------------
7186 procedure Set_Predicate_Function (Id : E; V : E) is
7187 S : Entity_Id;
7189 begin
7190 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
7192 S := Subprograms_For_Type (Id);
7193 Set_Subprograms_For_Type (Id, V);
7195 while Present (S) loop
7196 if Has_Predicates (S) then
7197 raise Program_Error;
7198 else
7199 S := Subprograms_For_Type (S);
7200 end if;
7201 end loop;
7203 Set_Subprograms_For_Type (Id, V);
7204 end Set_Predicate_Function;
7206 -----------------
7207 -- Size_Clause --
7208 -----------------
7210 function Size_Clause (Id : E) return N is
7211 begin
7212 return Rep_Clause (Id, Name_Size);
7213 end Size_Clause;
7215 ------------------------
7216 -- Stream_Size_Clause --
7217 ------------------------
7219 function Stream_Size_Clause (Id : E) return N is
7220 begin
7221 return Rep_Clause (Id, Name_Stream_Size);
7222 end Stream_Size_Clause;
7224 ------------------
7225 -- Subtype_Kind --
7226 ------------------
7228 function Subtype_Kind (K : Entity_Kind) return Entity_Kind is
7229 Kind : Entity_Kind;
7231 begin
7232 case K is
7233 when Access_Kind =>
7234 Kind := E_Access_Subtype;
7236 when E_Array_Type |
7237 E_Array_Subtype =>
7238 Kind := E_Array_Subtype;
7240 when E_Class_Wide_Type |
7241 E_Class_Wide_Subtype =>
7242 Kind := E_Class_Wide_Subtype;
7244 when E_Decimal_Fixed_Point_Type |
7245 E_Decimal_Fixed_Point_Subtype =>
7246 Kind := E_Decimal_Fixed_Point_Subtype;
7248 when E_Ordinary_Fixed_Point_Type |
7249 E_Ordinary_Fixed_Point_Subtype =>
7250 Kind := E_Ordinary_Fixed_Point_Subtype;
7252 when E_Private_Type |
7253 E_Private_Subtype =>
7254 Kind := E_Private_Subtype;
7256 when E_Limited_Private_Type |
7257 E_Limited_Private_Subtype =>
7258 Kind := E_Limited_Private_Subtype;
7260 when E_Record_Type_With_Private |
7261 E_Record_Subtype_With_Private =>
7262 Kind := E_Record_Subtype_With_Private;
7264 when E_Record_Type |
7265 E_Record_Subtype =>
7266 Kind := E_Record_Subtype;
7268 when E_String_Type |
7269 E_String_Subtype =>
7270 Kind := E_String_Subtype;
7272 when Enumeration_Kind =>
7273 Kind := E_Enumeration_Subtype;
7275 when Float_Kind =>
7276 Kind := E_Floating_Point_Subtype;
7278 when Signed_Integer_Kind =>
7279 Kind := E_Signed_Integer_Subtype;
7281 when Modular_Integer_Kind =>
7282 Kind := E_Modular_Integer_Subtype;
7284 when Protected_Kind =>
7285 Kind := E_Protected_Subtype;
7287 when Task_Kind =>
7288 Kind := E_Task_Subtype;
7290 when others =>
7291 Kind := E_Void;
7292 raise Program_Error;
7293 end case;
7295 return Kind;
7296 end Subtype_Kind;
7298 ---------------------
7299 -- Type_High_Bound --
7300 ---------------------
7302 function Type_High_Bound (Id : E) return Node_Id is
7303 Rng : constant Node_Id := Scalar_Range (Id);
7304 begin
7305 if Nkind (Rng) = N_Subtype_Indication then
7306 return High_Bound (Range_Expression (Constraint (Rng)));
7307 else
7308 return High_Bound (Rng);
7309 end if;
7310 end Type_High_Bound;
7312 --------------------
7313 -- Type_Low_Bound --
7314 --------------------
7316 function Type_Low_Bound (Id : E) return Node_Id is
7317 Rng : constant Node_Id := Scalar_Range (Id);
7318 begin
7319 if Nkind (Rng) = N_Subtype_Indication then
7320 return Low_Bound (Range_Expression (Constraint (Rng)));
7321 else
7322 return Low_Bound (Rng);
7323 end if;
7324 end Type_Low_Bound;
7326 ---------------------
7327 -- Underlying_Type --
7328 ---------------------
7330 function Underlying_Type (Id : E) return E is
7331 begin
7332 -- For record_with_private the underlying type is always the direct
7333 -- full view. Never try to take the full view of the parent it
7334 -- doesn't make sense.
7336 if Ekind (Id) = E_Record_Type_With_Private then
7337 return Full_View (Id);
7339 elsif Ekind (Id) in Incomplete_Or_Private_Kind then
7341 -- If we have an incomplete or private type with a full view,
7342 -- then we return the Underlying_Type of this full view
7344 if Present (Full_View (Id)) then
7345 if Id = Full_View (Id) then
7347 -- Previous error in declaration
7349 return Empty;
7351 else
7352 return Underlying_Type (Full_View (Id));
7353 end if;
7355 -- If we have an incomplete entity that comes from the limited
7356 -- view then we return the Underlying_Type of its non-limited
7357 -- view.
7359 elsif From_With_Type (Id)
7360 and then Present (Non_Limited_View (Id))
7361 then
7362 return Underlying_Type (Non_Limited_View (Id));
7364 -- Otherwise check for the case where we have a derived type or
7365 -- subtype, and if so get the Underlying_Type of the parent type.
7367 elsif Etype (Id) /= Id then
7368 return Underlying_Type (Etype (Id));
7370 -- Otherwise we have an incomplete or private type that has
7371 -- no full view, which means that we have not encountered the
7372 -- completion, so return Empty to indicate the underlying type
7373 -- is not yet known.
7375 else
7376 return Empty;
7377 end if;
7379 -- For non-incomplete, non-private types, return the type itself
7380 -- Also for entities that are not types at all return the entity
7381 -- itself.
7383 else
7384 return Id;
7385 end if;
7386 end Underlying_Type;
7388 ---------------
7389 -- Vax_Float --
7390 ---------------
7392 function Vax_Float (Id : E) return B is
7393 begin
7394 return Is_Floating_Point_Type (Id) and then Float_Rep (Id) = VAX_Native;
7395 end Vax_Float;
7397 ------------------------
7398 -- Write_Entity_Flags --
7399 ------------------------
7401 procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String) is
7403 procedure W (Flag_Name : String; Flag : Boolean);
7404 -- Write out given flag if it is set
7406 -------
7407 -- W --
7408 -------
7410 procedure W (Flag_Name : String; Flag : Boolean) is
7411 begin
7412 if Flag then
7413 Write_Str (Prefix);
7414 Write_Str (Flag_Name);
7415 Write_Str (" = True");
7416 Write_Eol;
7417 end if;
7418 end W;
7420 -- Start of processing for Write_Entity_Flags
7422 begin
7423 if (Is_Array_Type (Id) or else Is_Record_Type (Id))
7424 and then Is_Base_Type (Id)
7425 then
7426 Write_Str (Prefix);
7427 Write_Str ("Component_Alignment = ");
7429 case Component_Alignment (Id) is
7430 when Calign_Default =>
7431 Write_Str ("Calign_Default");
7433 when Calign_Component_Size =>
7434 Write_Str ("Calign_Component_Size");
7436 when Calign_Component_Size_4 =>
7437 Write_Str ("Calign_Component_Size_4");
7439 when Calign_Storage_Unit =>
7440 Write_Str ("Calign_Storage_Unit");
7441 end case;
7443 Write_Eol;
7444 end if;
7446 W ("Address_Taken", Flag104 (Id));
7447 W ("Body_Needed_For_SAL", Flag40 (Id));
7448 W ("C_Pass_By_Copy", Flag125 (Id));
7449 W ("Can_Never_Be_Null", Flag38 (Id));
7450 W ("Checks_May_Be_Suppressed", Flag31 (Id));
7451 W ("Debug_Info_Off", Flag166 (Id));
7452 W ("Default_Expressions_Processed", Flag108 (Id));
7453 W ("Delay_Cleanups", Flag114 (Id));
7454 W ("Delay_Subprogram_Descriptors", Flag50 (Id));
7455 W ("Depends_On_Private", Flag14 (Id));
7456 W ("Discard_Names", Flag88 (Id));
7457 W ("Elaboration_Entity_Required", Flag174 (Id));
7458 W ("Elaborate_Body_Desirable", Flag210 (Id));
7459 W ("Entry_Accepted", Flag152 (Id));
7460 W ("Can_Use_Internal_Rep", Flag229 (Id));
7461 W ("Finalize_Storage_Only", Flag158 (Id));
7462 W ("From_With_Type", Flag159 (Id));
7463 W ("Has_Aliased_Components", Flag135 (Id));
7464 W ("Has_Alignment_Clause", Flag46 (Id));
7465 W ("Has_All_Calls_Remote", Flag79 (Id));
7466 W ("Has_Anonymous_Master", Flag253 (Id));
7467 W ("Has_Atomic_Components", Flag86 (Id));
7468 W ("Has_Biased_Representation", Flag139 (Id));
7469 W ("Has_Completion", Flag26 (Id));
7470 W ("Has_Completion_In_Body", Flag71 (Id));
7471 W ("Has_Complex_Representation", Flag140 (Id));
7472 W ("Has_Component_Size_Clause", Flag68 (Id));
7473 W ("Has_Contiguous_Rep", Flag181 (Id));
7474 W ("Has_Controlled_Component", Flag43 (Id));
7475 W ("Has_Controlling_Result", Flag98 (Id));
7476 W ("Has_Convention_Pragma", Flag119 (Id));
7477 W ("Has_Default_Aspect", Flag39 (Id));
7478 W ("Has_Delayed_Aspects", Flag200 (Id));
7479 W ("Has_Delayed_Freeze", Flag18 (Id));
7480 W ("Has_Discriminants", Flag5 (Id));
7481 W ("Has_Enumeration_Rep_Clause", Flag66 (Id));
7482 W ("Has_Exit", Flag47 (Id));
7483 W ("Has_External_Tag_Rep_Clause", Flag110 (Id));
7484 W ("Has_Forward_Instantiation", Flag175 (Id));
7485 W ("Has_Fully_Qualified_Name", Flag173 (Id));
7486 W ("Has_Gigi_Rep_Item", Flag82 (Id));
7487 W ("Has_Homonym", Flag56 (Id));
7488 W ("Has_Implicit_Dereference", Flag251 (Id));
7489 W ("Has_Inheritable_Invariants", Flag248 (Id));
7490 W ("Has_Initial_Value", Flag219 (Id));
7491 W ("Has_Invariants", Flag232 (Id));
7492 W ("Has_Machine_Radix_Clause", Flag83 (Id));
7493 W ("Has_Master_Entity", Flag21 (Id));
7494 W ("Has_Missing_Return", Flag142 (Id));
7495 W ("Has_Nested_Block_With_Handler", Flag101 (Id));
7496 W ("Has_Non_Standard_Rep", Flag75 (Id));
7497 W ("Has_Object_Size_Clause", Flag172 (Id));
7498 W ("Has_Per_Object_Constraint", Flag154 (Id));
7499 W ("Has_Postconditions", Flag240 (Id));
7500 W ("Has_Pragma_Controlled", Flag27 (Id));
7501 W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
7502 W ("Has_Pragma_Inline", Flag157 (Id));
7503 W ("Has_Pragma_Inline_Always", Flag230 (Id));
7504 W ("Has_Pragma_Ordered", Flag198 (Id));
7505 W ("Has_Pragma_Pack", Flag121 (Id));
7506 W ("Has_Pragma_Preelab_Init", Flag221 (Id));
7507 W ("Has_Pragma_Pure", Flag203 (Id));
7508 W ("Has_Pragma_Pure_Function", Flag179 (Id));
7509 W ("Has_Pragma_Thread_Local_Storage", Flag169 (Id));
7510 W ("Has_Pragma_Unmodified", Flag233 (Id));
7511 W ("Has_Pragma_Unreferenced", Flag180 (Id));
7512 W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id));
7513 W ("Has_Predicates", Flag250 (Id));
7514 W ("Has_Primitive_Operations", Flag120 (Id));
7515 W ("Has_Private_Ancestor", Flag151 (Id));
7516 W ("Has_Private_Declaration", Flag155 (Id));
7517 W ("Has_Qualified_Name", Flag161 (Id));
7518 W ("Has_RACW", Flag214 (Id));
7519 W ("Has_Record_Rep_Clause", Flag65 (Id));
7520 W ("Has_Recursive_Call", Flag143 (Id));
7521 W ("Has_Size_Clause", Flag29 (Id));
7522 W ("Has_Small_Clause", Flag67 (Id));
7523 W ("Has_Specified_Layout", Flag100 (Id));
7524 W ("Has_Specified_Stream_Input", Flag190 (Id));
7525 W ("Has_Specified_Stream_Output", Flag191 (Id));
7526 W ("Has_Specified_Stream_Read", Flag192 (Id));
7527 W ("Has_Specified_Stream_Write", Flag193 (Id));
7528 W ("Has_Static_Discriminants", Flag211 (Id));
7529 W ("Has_Storage_Size_Clause", Flag23 (Id));
7530 W ("Has_Stream_Size_Clause", Flag184 (Id));
7531 W ("Has_Task", Flag30 (Id));
7532 W ("Has_Thunks", Flag228 (Id));
7533 W ("Has_Unchecked_Union", Flag123 (Id));
7534 W ("Has_Unknown_Discriminants", Flag72 (Id));
7535 W ("Has_Up_Level_Access", Flag215 (Id));
7536 W ("Has_Volatile_Components", Flag87 (Id));
7537 W ("Has_Xref_Entry", Flag182 (Id));
7538 W ("In_Package_Body", Flag48 (Id));
7539 W ("In_Private_Part", Flag45 (Id));
7540 W ("In_Use", Flag8 (Id));
7541 W ("Is_AST_Entry", Flag132 (Id));
7542 W ("Is_Abstract_Subprogram", Flag19 (Id));
7543 W ("Is_Abstract_Type", Flag146 (Id));
7544 W ("Is_Local_Anonymous_Access", Flag194 (Id));
7545 W ("Is_Access_Constant", Flag69 (Id));
7546 W ("Is_Ada_2005_Only", Flag185 (Id));
7547 W ("Is_Ada_2012_Only", Flag199 (Id));
7548 W ("Is_Aliased", Flag15 (Id));
7549 W ("Is_Asynchronous", Flag81 (Id));
7550 W ("Is_Atomic", Flag85 (Id));
7551 W ("Is_Bit_Packed_Array", Flag122 (Id));
7552 W ("Is_CPP_Class", Flag74 (Id));
7553 W ("Is_Called", Flag102 (Id));
7554 W ("Is_Character_Type", Flag63 (Id));
7555 W ("Is_Child_Unit", Flag73 (Id));
7556 W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
7557 W ("Is_Compilation_Unit", Flag149 (Id));
7558 W ("Is_Completely_Hidden", Flag103 (Id));
7559 W ("Is_Concurrent_Record_Type", Flag20 (Id));
7560 W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id));
7561 W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
7562 W ("Is_Constrained", Flag12 (Id));
7563 W ("Is_Constructor", Flag76 (Id));
7564 W ("Is_Controlled", Flag42 (Id));
7565 W ("Is_Controlling_Formal", Flag97 (Id));
7566 W ("Is_Descendent_Of_Address", Flag223 (Id));
7567 W ("Is_Discrim_SO_Function", Flag176 (Id));
7568 W ("Is_Dispatch_Table_Entity", Flag234 (Id));
7569 W ("Is_Dispatching_Operation", Flag6 (Id));
7570 W ("Is_Eliminated", Flag124 (Id));
7571 W ("Is_Entry_Formal", Flag52 (Id));
7572 W ("Is_Exported", Flag99 (Id));
7573 W ("Is_First_Subtype", Flag70 (Id));
7574 W ("Is_For_Access_Subtype", Flag118 (Id));
7575 W ("Is_Formal_Subprogram", Flag111 (Id));
7576 W ("Is_Frozen", Flag4 (Id));
7577 W ("Is_Generic_Actual_Type", Flag94 (Id));
7578 W ("Is_Generic_Instance", Flag130 (Id));
7579 W ("Is_Generic_Type", Flag13 (Id));
7580 W ("Is_Hidden", Flag57 (Id));
7581 W ("Is_Hidden_Open_Scope", Flag171 (Id));
7582 W ("Is_Immediately_Visible", Flag7 (Id));
7583 W ("Is_Implementation_Defined", Flag254 (Id));
7584 W ("Is_Imported", Flag24 (Id));
7585 W ("Is_Inlined", Flag11 (Id));
7586 W ("Is_Instantiated", Flag126 (Id));
7587 W ("Is_Interface", Flag186 (Id));
7588 W ("Is_Internal", Flag17 (Id));
7589 W ("Is_Interrupt_Handler", Flag89 (Id));
7590 W ("Is_Intrinsic_Subprogram", Flag64 (Id));
7591 W ("Is_Itype", Flag91 (Id));
7592 W ("Is_Known_Non_Null", Flag37 (Id));
7593 W ("Is_Known_Null", Flag204 (Id));
7594 W ("Is_Known_Valid", Flag170 (Id));
7595 W ("Is_Limited_Composite", Flag106 (Id));
7596 W ("Is_Limited_Interface", Flag197 (Id));
7597 W ("Is_Limited_Record", Flag25 (Id));
7598 W ("Is_Machine_Code_Subprogram", Flag137 (Id));
7599 W ("Is_Non_Static_Subtype", Flag109 (Id));
7600 W ("Is_Null_Init_Proc", Flag178 (Id));
7601 W ("Is_Obsolescent", Flag153 (Id));
7602 W ("Is_Only_Out_Parameter", Flag226 (Id));
7603 W ("Is_Optional_Parameter", Flag134 (Id));
7604 W ("Is_Package_Body_Entity", Flag160 (Id));
7605 W ("Is_Packed", Flag51 (Id));
7606 W ("Is_Packed_Array_Type", Flag138 (Id));
7607 W ("Is_Potentially_Use_Visible", Flag9 (Id));
7608 W ("Is_Preelaborated", Flag59 (Id));
7609 W ("Is_Primitive", Flag218 (Id));
7610 W ("Is_Primitive_Wrapper", Flag195 (Id));
7611 W ("Is_Private_Composite", Flag107 (Id));
7612 W ("Is_Private_Descendant", Flag53 (Id));
7613 W ("Is_Private_Primitive", Flag245 (Id));
7614 W ("Is_Processed_Transient", Flag252 (Id));
7615 W ("Is_Public", Flag10 (Id));
7616 W ("Is_Pure", Flag44 (Id));
7617 W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
7618 W ("Is_RACW_Stub_Type", Flag244 (Id));
7619 W ("Is_Raised", Flag224 (Id));
7620 W ("Is_Remote_Call_Interface", Flag62 (Id));
7621 W ("Is_Remote_Types", Flag61 (Id));
7622 W ("Is_Renaming_Of_Object", Flag112 (Id));
7623 W ("Is_Return_Object", Flag209 (Id));
7624 W ("Is_Safe_To_Reevaluate", Flag249 (Id));
7625 W ("Is_Shared_Passive", Flag60 (Id));
7626 W ("Is_Statically_Allocated", Flag28 (Id));
7627 W ("Is_Tag", Flag78 (Id));
7628 W ("Is_Tagged_Type", Flag55 (Id));
7629 W ("Is_Thunk", Flag225 (Id));
7630 W ("Is_Trivial_Subprogram", Flag235 (Id));
7631 W ("Is_True_Constant", Flag163 (Id));
7632 W ("Is_Unchecked_Union", Flag117 (Id));
7633 W ("Is_Underlying_Record_View", Flag246 (Id));
7634 W ("Is_Unsigned_Type", Flag144 (Id));
7635 W ("Is_VMS_Exception", Flag133 (Id));
7636 W ("Is_Valued_Procedure", Flag127 (Id));
7637 W ("Is_Visible_Child_Unit", Flag116 (Id));
7638 W ("Is_Visible_Formal", Flag206 (Id));
7639 W ("Is_Volatile", Flag16 (Id));
7640 W ("Itype_Printed", Flag202 (Id));
7641 W ("Kill_Elaboration_Checks", Flag32 (Id));
7642 W ("Kill_Range_Checks", Flag33 (Id));
7643 W ("Kill_Tag_Checks", Flag34 (Id));
7644 W ("Known_To_Have_Preelab_Init", Flag207 (Id));
7645 W ("Low_Bound_Tested", Flag205 (Id));
7646 W ("Machine_Radix_10", Flag84 (Id));
7647 W ("Materialize_Entity", Flag168 (Id));
7648 W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
7649 W ("Must_Have_Preelab_Init", Flag208 (Id));
7650 W ("Needs_Debug_Info", Flag147 (Id));
7651 W ("Needs_No_Actuals", Flag22 (Id));
7652 W ("Never_Set_In_Source", Flag115 (Id));
7653 W ("No_Pool_Assigned", Flag131 (Id));
7654 W ("No_Return", Flag113 (Id));
7655 W ("No_Strict_Aliasing", Flag136 (Id));
7656 W ("Non_Binary_Modulus", Flag58 (Id));
7657 W ("Nonzero_Is_True", Flag162 (Id));
7658 W ("OK_To_Rename", Flag247 (Id));
7659 W ("OK_To_Reorder_Components", Flag239 (Id));
7660 W ("Optimize_Alignment_Space", Flag241 (Id));
7661 W ("Optimize_Alignment_Time", Flag242 (Id));
7662 W ("Overlays_Constant", Flag243 (Id));
7663 W ("Reachable", Flag49 (Id));
7664 W ("Referenced", Flag156 (Id));
7665 W ("Referenced_As_LHS", Flag36 (Id));
7666 W ("Referenced_As_Out_Parameter", Flag227 (Id));
7667 W ("Renamed_In_Spec", Flag231 (Id));
7668 W ("Requires_Overriding", Flag213 (Id));
7669 W ("Return_Present", Flag54 (Id));
7670 W ("Returns_By_Ref", Flag90 (Id));
7671 W ("Reverse_Bit_Order", Flag164 (Id));
7672 W ("Reverse_Storage_Order", Flag93 (Id));
7673 W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
7674 W ("Size_Depends_On_Discriminant", Flag177 (Id));
7675 W ("Size_Known_At_Compile_Time", Flag92 (Id));
7676 W ("Static_Elaboration_Desired", Flag77 (Id));
7677 W ("Strict_Alignment", Flag145 (Id));
7678 W ("Suppress_Elaboration_Warnings", Flag148 (Id));
7679 W ("Suppress_Initialization", Flag105 (Id));
7680 W ("Suppress_Style_Checks", Flag165 (Id));
7681 W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
7682 W ("Treat_As_Volatile", Flag41 (Id));
7683 W ("Universal_Aliasing", Flag216 (Id));
7684 W ("Used_As_Generic_Actual", Flag222 (Id));
7685 W ("Uses_Sec_Stack", Flag95 (Id));
7686 W ("Warnings_Off", Flag96 (Id));
7687 W ("Warnings_Off_Used", Flag236 (Id));
7688 W ("Warnings_Off_Used_Unmodified", Flag237 (Id));
7689 W ("Warnings_Off_Used_Unreferenced", Flag238 (Id));
7690 W ("Was_Hidden", Flag196 (Id));
7691 end Write_Entity_Flags;
7693 -----------------------
7694 -- Write_Entity_Info --
7695 -----------------------
7697 procedure Write_Entity_Info (Id : Entity_Id; Prefix : String) is
7699 procedure Write_Attribute (Which : String; Nam : E);
7700 -- Write attribute value with given string name
7702 procedure Write_Kind (Id : Entity_Id);
7703 -- Write Ekind field of entity
7705 ---------------------
7706 -- Write_Attribute --
7707 ---------------------
7709 procedure Write_Attribute (Which : String; Nam : E) is
7710 begin
7711 Write_Str (Prefix);
7712 Write_Str (Which);
7713 Write_Int (Int (Nam));
7714 Write_Str (" ");
7715 Write_Name (Chars (Nam));
7716 Write_Str (" ");
7717 end Write_Attribute;
7719 ----------------
7720 -- Write_Kind --
7721 ----------------
7723 procedure Write_Kind (Id : Entity_Id) is
7724 K : constant String := Entity_Kind'Image (Ekind (Id));
7726 begin
7727 Write_Str (Prefix);
7728 Write_Str (" Kind ");
7730 if Is_Type (Id) and then Is_Tagged_Type (Id) then
7731 Write_Str ("TAGGED ");
7732 end if;
7734 Write_Str (K (3 .. K'Length));
7735 Write_Str (" ");
7737 if Is_Type (Id) and then Depends_On_Private (Id) then
7738 Write_Str ("Depends_On_Private ");
7739 end if;
7740 end Write_Kind;
7742 -- Start of processing for Write_Entity_Info
7744 begin
7745 Write_Eol;
7746 Write_Attribute ("Name ", Id);
7747 Write_Int (Int (Id));
7748 Write_Eol;
7749 Write_Kind (Id);
7750 Write_Eol;
7751 Write_Attribute (" Type ", Etype (Id));
7752 Write_Eol;
7753 Write_Attribute (" Scope ", Scope (Id));
7754 Write_Eol;
7756 case Ekind (Id) is
7758 when Discrete_Kind =>
7759 Write_Str ("Bounds: Id = ");
7761 if Present (Scalar_Range (Id)) then
7762 Write_Int (Int (Type_Low_Bound (Id)));
7763 Write_Str (" .. Id = ");
7764 Write_Int (Int (Type_High_Bound (Id)));
7765 else
7766 Write_Str ("Empty");
7767 end if;
7769 Write_Eol;
7771 when Array_Kind =>
7772 declare
7773 Index : E;
7775 begin
7776 Write_Attribute
7777 (" Component Type ", Component_Type (Id));
7778 Write_Eol;
7779 Write_Str (Prefix);
7780 Write_Str (" Indexes ");
7782 Index := First_Index (Id);
7783 while Present (Index) loop
7784 Write_Attribute (" ", Etype (Index));
7785 Index := Next_Index (Index);
7786 end loop;
7788 Write_Eol;
7789 end;
7791 when Access_Kind =>
7792 Write_Attribute
7793 (" Directly Designated Type ",
7794 Directly_Designated_Type (Id));
7795 Write_Eol;
7797 when Overloadable_Kind =>
7798 if Present (Homonym (Id)) then
7799 Write_Str (" Homonym ");
7800 Write_Name (Chars (Homonym (Id)));
7801 Write_Str (" ");
7802 Write_Int (Int (Homonym (Id)));
7803 Write_Eol;
7804 end if;
7806 Write_Eol;
7808 when E_Component =>
7809 if Ekind (Scope (Id)) in Record_Kind then
7810 Write_Attribute (
7811 " Original_Record_Component ",
7812 Original_Record_Component (Id));
7813 Write_Int (Int (Original_Record_Component (Id)));
7814 Write_Eol;
7815 end if;
7817 when others => null;
7818 end case;
7819 end Write_Entity_Info;
7821 -----------------------
7822 -- Write_Field6_Name --
7823 -----------------------
7825 procedure Write_Field6_Name (Id : Entity_Id) is
7826 pragma Warnings (Off, Id);
7827 begin
7828 Write_Str ("First_Rep_Item");
7829 end Write_Field6_Name;
7831 -----------------------
7832 -- Write_Field7_Name --
7833 -----------------------
7835 procedure Write_Field7_Name (Id : Entity_Id) is
7836 pragma Warnings (Off, Id);
7837 begin
7838 Write_Str ("Freeze_Node");
7839 end Write_Field7_Name;
7841 -----------------------
7842 -- Write_Field8_Name --
7843 -----------------------
7845 procedure Write_Field8_Name (Id : Entity_Id) is
7846 begin
7847 case Ekind (Id) is
7848 when Type_Kind =>
7849 Write_Str ("Associated_Node_For_Itype");
7851 when E_Package =>
7852 Write_Str ("Dependent_Instances");
7854 when E_Loop =>
7855 Write_Str ("First_Exit_Statement");
7857 when E_Variable =>
7858 Write_Str ("Hiding_Loop_Variable");
7860 when Formal_Kind |
7861 E_Function |
7862 E_Subprogram_Body =>
7863 Write_Str ("Mechanism");
7865 when E_Component |
7866 E_Discriminant =>
7867 Write_Str ("Normalized_First_Bit");
7869 when E_Procedure =>
7870 Write_Str ("Postcondition_Proc");
7872 when E_Return_Statement =>
7873 Write_Str ("Return_Applies_To");
7875 when others =>
7876 Write_Str ("Field8??");
7877 end case;
7878 end Write_Field8_Name;
7880 -----------------------
7881 -- Write_Field9_Name --
7882 -----------------------
7884 procedure Write_Field9_Name (Id : Entity_Id) is
7885 begin
7886 case Ekind (Id) is
7887 when Type_Kind =>
7888 Write_Str ("Class_Wide_Type");
7890 when Object_Kind =>
7891 Write_Str ("Current_Value");
7893 when E_Function |
7894 E_Generic_Function |
7895 E_Generic_Package |
7896 E_Generic_Procedure |
7897 E_Package |
7898 E_Procedure =>
7899 Write_Str ("Renaming_Map");
7901 when others =>
7902 Write_Str ("Field9??");
7903 end case;
7904 end Write_Field9_Name;
7906 ------------------------
7907 -- Write_Field10_Name --
7908 ------------------------
7910 procedure Write_Field10_Name (Id : Entity_Id) is
7911 begin
7912 case Ekind (Id) is
7913 when Class_Wide_Kind |
7914 Incomplete_Kind |
7915 E_Record_Type |
7916 E_Record_Subtype |
7917 Private_Kind |
7918 Concurrent_Kind =>
7919 Write_Str ("Direct_Primitive_Operations");
7921 when Float_Kind =>
7922 Write_Str ("Float_Rep");
7924 when E_In_Parameter |
7925 E_Constant =>
7926 Write_Str ("Discriminal_Link");
7928 when E_Function |
7929 E_Package |
7930 E_Package_Body |
7931 E_Procedure =>
7932 Write_Str ("Handler_Records");
7934 when E_Component |
7935 E_Discriminant =>
7936 Write_Str ("Normalized_Position_Max");
7938 when others =>
7939 Write_Str ("Field10??");
7940 end case;
7941 end Write_Field10_Name;
7943 ------------------------
7944 -- Write_Field11_Name --
7945 ------------------------
7947 procedure Write_Field11_Name (Id : Entity_Id) is
7948 begin
7949 case Ekind (Id) is
7950 when E_Block =>
7951 Write_Str ("Block_Node");
7953 when E_Component |
7954 E_Discriminant =>
7955 Write_Str ("Component_Bit_Offset");
7957 when Formal_Kind =>
7958 Write_Str ("Entry_Component");
7960 when E_Enumeration_Literal =>
7961 Write_Str ("Enumeration_Pos");
7963 when Type_Kind |
7964 E_Constant =>
7965 Write_Str ("Full_View");
7967 when E_Generic_Package =>
7968 Write_Str ("Generic_Homonym");
7970 when E_Function |
7971 E_Procedure |
7972 E_Entry |
7973 E_Entry_Family =>
7974 Write_Str ("Protected_Body_Subprogram");
7976 when others =>
7977 Write_Str ("Field11??");
7978 end case;
7979 end Write_Field11_Name;
7981 ------------------------
7982 -- Write_Field12_Name --
7983 ------------------------
7985 procedure Write_Field12_Name (Id : Entity_Id) is
7986 begin
7987 case Ekind (Id) is
7988 when E_Package =>
7989 Write_Str ("Associated_Formal_Package");
7991 when Entry_Kind =>
7992 Write_Str ("Barrier_Function");
7994 when E_Enumeration_Literal =>
7995 Write_Str ("Enumeration_Rep");
7997 when Type_Kind |
7998 E_Component |
7999 E_Constant |
8000 E_Discriminant |
8001 E_Exception |
8002 E_In_Parameter |
8003 E_In_Out_Parameter |
8004 E_Out_Parameter |
8005 E_Loop_Parameter |
8006 E_Variable =>
8007 Write_Str ("Esize");
8009 when E_Function |
8010 E_Procedure =>
8011 Write_Str ("Next_Inlined_Subprogram");
8013 when others =>
8014 Write_Str ("Field12??");
8015 end case;
8016 end Write_Field12_Name;
8018 ------------------------
8019 -- Write_Field13_Name --
8020 ------------------------
8022 procedure Write_Field13_Name (Id : Entity_Id) is
8023 begin
8024 case Ekind (Id) is
8025 when E_Component |
8026 E_Discriminant =>
8027 Write_Str ("Component_Clause");
8029 when E_Function =>
8030 if not Comes_From_Source (Id)
8031 and then
8032 Chars (Id) = Name_Op_Ne
8033 then
8034 Write_Str ("Corresponding_Equality");
8036 elsif Comes_From_Source (Id) then
8037 Write_Str ("Elaboration_Entity");
8039 else
8040 Write_Str ("Field13??");
8041 end if;
8043 when E_Procedure |
8044 E_Package |
8045 Generic_Unit_Kind =>
8046 Write_Str ("Elaboration_Entity");
8048 when Formal_Kind |
8049 E_Variable =>
8050 Write_Str ("Extra_Accessibility");
8052 when Type_Kind =>
8053 Write_Str ("RM_Size");
8055 when others =>
8056 Write_Str ("Field13??");
8057 end case;
8058 end Write_Field13_Name;
8060 -----------------------
8061 -- Write_Field14_Name --
8062 -----------------------
8064 procedure Write_Field14_Name (Id : Entity_Id) is
8065 begin
8066 case Ekind (Id) is
8067 when Type_Kind |
8068 Formal_Kind |
8069 E_Constant |
8070 E_Exception |
8071 E_Variable |
8072 E_Loop_Parameter =>
8073 Write_Str ("Alignment");
8075 when E_Function |
8076 E_Procedure =>
8077 Write_Str ("First_Optional_Parameter");
8079 when E_Component |
8080 E_Discriminant =>
8081 Write_Str ("Normalized_Position");
8083 when E_Package |
8084 E_Generic_Package =>
8085 Write_Str ("Shadow_Entities");
8087 when others =>
8088 Write_Str ("Field14??");
8089 end case;
8090 end Write_Field14_Name;
8092 ------------------------
8093 -- Write_Field15_Name --
8094 ------------------------
8096 procedure Write_Field15_Name (Id : Entity_Id) is
8097 begin
8098 case Ekind (Id) is
8099 when E_Discriminant =>
8100 Write_Str ("Discriminant_Number");
8102 when E_Component =>
8103 Write_Str ("DT_Entry_Count");
8105 when E_Function |
8106 E_Procedure =>
8107 Write_Str ("DT_Position");
8109 when E_Protected_Type =>
8110 Write_Str ("Entry_Bodies_Array");
8112 when Entry_Kind =>
8113 Write_Str ("Entry_Parameters_Type");
8115 when Formal_Kind =>
8116 Write_Str ("Extra_Formal");
8118 when Enumeration_Kind =>
8119 Write_Str ("Lit_Indexes");
8121 when E_Package |
8122 E_Package_Body =>
8123 Write_Str ("Related_Instance");
8125 when E_Constant |
8126 E_Variable =>
8127 Write_Str ("Return_Flag_Or_Transient_Decl");
8129 when Decimal_Fixed_Point_Kind =>
8130 Write_Str ("Scale_Value");
8132 when Access_Kind |
8133 Task_Kind =>
8134 Write_Str ("Storage_Size_Variable");
8136 when E_String_Literal_Subtype =>
8137 Write_Str ("String_Literal_Low_Bound");
8139 when others =>
8140 Write_Str ("Field15??");
8141 end case;
8142 end Write_Field15_Name;
8144 ------------------------
8145 -- Write_Field16_Name --
8146 ------------------------
8148 procedure Write_Field16_Name (Id : Entity_Id) is
8149 begin
8150 case Ekind (Id) is
8151 when E_Record_Type |
8152 E_Record_Type_With_Private =>
8153 Write_Str ("Access_Disp_Table");
8155 when E_Record_Subtype |
8156 E_Class_Wide_Subtype =>
8157 Write_Str ("Cloned_Subtype");
8159 when E_Function |
8160 E_Procedure =>
8161 Write_Str ("DTC_Entity");
8163 when E_Component =>
8164 Write_Str ("Entry_Formal");
8166 when E_Package |
8167 E_Generic_Package |
8168 Concurrent_Kind =>
8169 Write_Str ("First_Private_Entity");
8171 when Enumeration_Kind =>
8172 Write_Str ("Lit_Strings");
8174 when E_String_Literal_Subtype =>
8175 Write_Str ("String_Literal_Length");
8177 when E_Variable |
8178 E_Out_Parameter =>
8179 Write_Str ("Unset_Reference");
8181 when others =>
8182 Write_Str ("Field16??");
8183 end case;
8184 end Write_Field16_Name;
8186 ------------------------
8187 -- Write_Field17_Name --
8188 ------------------------
8190 procedure Write_Field17_Name (Id : Entity_Id) is
8191 begin
8192 case Ekind (Id) is
8193 when Formal_Kind |
8194 E_Constant |
8195 E_Generic_In_Out_Parameter |
8196 E_Variable =>
8197 Write_Str ("Actual_Subtype");
8199 when Digits_Kind =>
8200 Write_Str ("Digits_Value");
8202 when E_Discriminant =>
8203 Write_Str ("Discriminal");
8205 when E_Block |
8206 Class_Wide_Kind |
8207 Concurrent_Kind |
8208 Private_Kind |
8209 E_Entry |
8210 E_Entry_Family |
8211 E_Function |
8212 E_Generic_Function |
8213 E_Generic_Package |
8214 E_Generic_Procedure |
8215 E_Loop |
8216 E_Operator |
8217 E_Package |
8218 E_Package_Body |
8219 E_Procedure |
8220 E_Record_Type |
8221 E_Record_Subtype |
8222 E_Return_Statement |
8223 E_Subprogram_Body |
8224 E_Subprogram_Type =>
8225 Write_Str ("First_Entity");
8227 when Array_Kind =>
8228 Write_Str ("First_Index");
8230 when Enumeration_Kind =>
8231 Write_Str ("First_Literal");
8233 when Access_Kind =>
8234 Write_Str ("Master_Id");
8236 when Modular_Integer_Kind =>
8237 Write_Str ("Modulus");
8239 when E_Incomplete_Type =>
8240 Write_Str ("Non_Limited_View");
8242 when E_Incomplete_Subtype =>
8243 if From_With_Type (Id) then
8244 Write_Str ("Non_Limited_View");
8245 end if;
8247 when E_Component =>
8248 Write_Str ("Prival");
8250 when others =>
8251 Write_Str ("Field17??");
8252 end case;
8253 end Write_Field17_Name;
8255 ------------------------
8256 -- Write_Field18_Name --
8257 ------------------------
8259 procedure Write_Field18_Name (Id : Entity_Id) is
8260 begin
8261 case Ekind (Id) is
8262 when E_Enumeration_Literal |
8263 E_Function |
8264 E_Operator |
8265 E_Procedure =>
8266 Write_Str ("Alias");
8268 when E_Record_Type =>
8269 Write_Str ("Corresponding_Concurrent_Type");
8271 when E_Subprogram_Body =>
8272 Write_Str ("Corresponding_Protected_Entry");
8274 when Concurrent_Kind =>
8275 Write_Str ("Corresponding_Record_Type");
8277 when E_Label |
8278 E_Loop |
8279 E_Block =>
8280 Write_Str ("Enclosing_Scope");
8282 when E_Entry_Index_Parameter =>
8283 Write_Str ("Entry_Index_Constant");
8285 when E_Class_Wide_Subtype |
8286 E_Access_Protected_Subprogram_Type |
8287 E_Anonymous_Access_Protected_Subprogram_Type |
8288 E_Access_Subprogram_Type |
8289 E_Exception_Type =>
8290 Write_Str ("Equivalent_Type");
8292 when Fixed_Point_Kind =>
8293 Write_Str ("Delta_Value");
8295 when Incomplete_Or_Private_Kind |
8296 E_Record_Subtype =>
8297 Write_Str ("Private_Dependents");
8299 when Object_Kind =>
8300 Write_Str ("Renamed_Object");
8302 when E_Exception |
8303 E_Package |
8304 E_Generic_Function |
8305 E_Generic_Procedure |
8306 E_Generic_Package =>
8307 Write_Str ("Renamed_Entity");
8309 when others =>
8310 Write_Str ("Field18??");
8311 end case;
8312 end Write_Field18_Name;
8314 -----------------------
8315 -- Write_Field19_Name --
8316 -----------------------
8318 procedure Write_Field19_Name (Id : Entity_Id) is
8319 begin
8320 case Ekind (Id) is
8321 when E_Package |
8322 E_Generic_Package =>
8323 Write_Str ("Body_Entity");
8325 when E_Discriminant =>
8326 Write_Str ("Corresponding_Discriminant");
8328 when Scalar_Kind =>
8329 Write_Str ("Default_Value");
8331 when E_Array_Type =>
8332 Write_Str ("Default_Component_Value");
8334 when E_Record_Type =>
8335 Write_Str ("Parent_Subtype");
8337 when E_Constant |
8338 E_Variable =>
8339 Write_Str ("Size_Check_Code");
8341 when E_Package_Body |
8342 Formal_Kind =>
8343 Write_Str ("Spec_Entity");
8345 when Private_Kind =>
8346 Write_Str ("Underlying_Full_View");
8348 when E_Function | E_Operator | E_Subprogram_Type =>
8349 Write_Str ("Extra_Accessibility_Of_Result");
8351 when others =>
8352 Write_Str ("Field19??");
8353 end case;
8354 end Write_Field19_Name;
8356 -----------------------
8357 -- Write_Field20_Name --
8358 -----------------------
8360 procedure Write_Field20_Name (Id : Entity_Id) is
8361 begin
8362 case Ekind (Id) is
8363 when Array_Kind =>
8364 Write_Str ("Component_Type");
8366 when E_In_Parameter |
8367 E_Generic_In_Parameter =>
8368 Write_Str ("Default_Value");
8370 when Access_Kind =>
8371 Write_Str ("Directly_Designated_Type");
8373 when E_Component =>
8374 Write_Str ("Discriminant_Checking_Func");
8376 when E_Discriminant =>
8377 Write_Str ("Discriminant_Default_Value");
8379 when E_Block |
8380 Class_Wide_Kind |
8381 Concurrent_Kind |
8382 Private_Kind |
8383 E_Entry |
8384 E_Entry_Family |
8385 E_Function |
8386 E_Generic_Function |
8387 E_Generic_Package |
8388 E_Generic_Procedure |
8389 E_Loop |
8390 E_Operator |
8391 E_Package |
8392 E_Package_Body |
8393 E_Procedure |
8394 E_Record_Type |
8395 E_Record_Subtype |
8396 E_Return_Statement |
8397 E_Subprogram_Body |
8398 E_Subprogram_Type =>
8399 Write_Str ("Last_Entity");
8401 when E_Constant |
8402 E_Variable =>
8403 Write_Str ("Prival_Link");
8405 when Scalar_Kind =>
8406 Write_Str ("Scalar_Range");
8408 when E_Exception =>
8409 Write_Str ("Register_Exception_Call");
8411 when others =>
8412 Write_Str ("Field20??");
8413 end case;
8414 end Write_Field20_Name;
8416 -----------------------
8417 -- Write_Field21_Name --
8418 -----------------------
8420 procedure Write_Field21_Name (Id : Entity_Id) is
8421 begin
8422 case Ekind (Id) is
8423 when Entry_Kind =>
8424 Write_Str ("Accept_Address");
8426 when E_In_Parameter =>
8427 Write_Str ("Default_Expr_Function");
8429 when Concurrent_Kind |
8430 Incomplete_Or_Private_Kind |
8431 Class_Wide_Kind |
8432 E_Record_Type |
8433 E_Record_Subtype =>
8434 Write_Str ("Discriminant_Constraint");
8436 when E_Constant |
8437 E_Exception |
8438 E_Function |
8439 E_Generic_Function |
8440 E_Procedure |
8441 E_Generic_Procedure |
8442 E_Variable =>
8443 Write_Str ("Interface_Name");
8445 when Array_Kind |
8446 Modular_Integer_Kind =>
8447 Write_Str ("Original_Array_Type");
8449 when Fixed_Point_Kind =>
8450 Write_Str ("Small_Value");
8452 when others =>
8453 Write_Str ("Field21??");
8454 end case;
8455 end Write_Field21_Name;
8457 -----------------------
8458 -- Write_Field22_Name --
8459 -----------------------
8461 procedure Write_Field22_Name (Id : Entity_Id) is
8462 begin
8463 case Ekind (Id) is
8464 when Access_Kind =>
8465 Write_Str ("Associated_Storage_Pool");
8467 when Array_Kind =>
8468 Write_Str ("Component_Size");
8470 when E_Record_Type =>
8471 Write_Str ("Corresponding_Remote_Type");
8473 when E_Component |
8474 E_Discriminant =>
8475 Write_Str ("Original_Record_Component");
8477 when E_Enumeration_Literal =>
8478 Write_Str ("Enumeration_Rep_Expr");
8480 when E_Exception =>
8481 Write_Str ("Exception_Code");
8483 when E_Record_Type_With_Private |
8484 E_Record_Subtype_With_Private |
8485 E_Private_Type |
8486 E_Private_Subtype |
8487 E_Limited_Private_Type |
8488 E_Limited_Private_Subtype =>
8489 Write_Str ("Private_View");
8491 when Formal_Kind =>
8492 Write_Str ("Protected_Formal");
8494 when E_Block |
8495 E_Entry |
8496 E_Entry_Family |
8497 E_Function |
8498 E_Loop |
8499 E_Package |
8500 E_Package_Body |
8501 E_Generic_Package |
8502 E_Generic_Function |
8503 E_Generic_Procedure |
8504 E_Procedure |
8505 E_Protected_Type |
8506 E_Return_Statement |
8507 E_Subprogram_Body |
8508 E_Task_Type =>
8509 Write_Str ("Scope_Depth_Value");
8511 when E_Variable =>
8512 Write_Str ("Shared_Var_Procs_Instance");
8514 when others =>
8515 Write_Str ("Field22??");
8516 end case;
8517 end Write_Field22_Name;
8519 ------------------------
8520 -- Write_Field23_Name --
8521 ------------------------
8523 procedure Write_Field23_Name (Id : Entity_Id) is
8524 begin
8525 case Ekind (Id) is
8526 when E_Discriminant =>
8527 Write_Str ("CR_Discriminant");
8529 when E_Block =>
8530 Write_Str ("Entry_Cancel_Parameter");
8532 when E_Enumeration_Type =>
8533 Write_Str ("Enum_Pos_To_Rep");
8535 when Formal_Kind |
8536 E_Variable =>
8537 Write_Str ("Extra_Constrained");
8539 when Access_Kind =>
8540 Write_Str ("Finalization_Master");
8542 when E_Generic_Function |
8543 E_Generic_Package |
8544 E_Generic_Procedure =>
8545 Write_Str ("Inner_Instances");
8547 when Array_Kind =>
8548 Write_Str ("Packed_Array_Type");
8550 when Entry_Kind =>
8551 Write_Str ("Protection_Object");
8553 when Concurrent_Kind |
8554 Incomplete_Or_Private_Kind |
8555 Class_Wide_Kind |
8556 E_Record_Type |
8557 E_Record_Subtype =>
8558 Write_Str ("Stored_Constraint");
8560 when E_Function |
8561 E_Procedure =>
8562 if Present (Scope (Id))
8563 and then Is_Protected_Type (Scope (Id))
8564 then
8565 Write_Str ("Protection_Object");
8566 else
8567 Write_Str ("Generic_Renamings");
8568 end if;
8570 when E_Package =>
8571 if Is_Generic_Instance (Id) then
8572 Write_Str ("Generic_Renamings");
8573 else
8574 Write_Str ("Limited_View");
8575 end if;
8577 when others =>
8578 Write_Str ("Field23??");
8579 end case;
8580 end Write_Field23_Name;
8582 ------------------------
8583 -- Write_Field24_Name --
8584 ------------------------
8586 procedure Write_Field24_Name (Id : Entity_Id) is
8587 begin
8588 case Ekind (Id) is
8589 when E_Package |
8590 E_Package_Body =>
8591 Write_Str ("Finalizer");
8593 when E_Constant |
8594 E_Variable |
8595 Type_Kind =>
8596 Write_Str ("Related_Expression");
8598 when E_Entry |
8599 E_Entry_Family |
8600 Subprogram_Kind |
8601 Generic_Subprogram_Kind =>
8602 Write_Str ("Contract");
8604 when others =>
8605 Write_Str ("Field24???");
8606 end case;
8607 end Write_Field24_Name;
8609 ------------------------
8610 -- Write_Field25_Name --
8611 ------------------------
8613 procedure Write_Field25_Name (Id : Entity_Id) is
8614 begin
8615 case Ekind (Id) is
8616 when E_Variable =>
8617 Write_Str ("Debug_Renaming_Link");
8619 when E_Component =>
8620 Write_Str ("DT_Offset_To_Top_Func");
8622 when E_Procedure |
8623 E_Function =>
8624 Write_Str ("Interface_Alias");
8626 when E_Record_Type |
8627 E_Record_Subtype |
8628 E_Record_Type_With_Private |
8629 E_Record_Subtype_With_Private =>
8630 Write_Str ("Interfaces");
8632 when E_Array_Type |
8633 E_Array_Subtype =>
8634 Write_Str ("Related_Array_Object");
8636 when Task_Kind =>
8637 Write_Str ("Task_Body_Procedure");
8639 when E_Entry |
8640 E_Entry_Family =>
8641 Write_Str ("PPC_Wrapper");
8643 when E_Enumeration_Subtype |
8644 E_Modular_Integer_Subtype |
8645 E_Signed_Integer_Subtype =>
8646 Write_Str ("Static_Predicate");
8648 when others =>
8649 Write_Str ("Field25??");
8650 end case;
8651 end Write_Field25_Name;
8653 ------------------------
8654 -- Write_Field26_Name --
8655 ------------------------
8657 procedure Write_Field26_Name (Id : Entity_Id) is
8658 begin
8659 case Ekind (Id) is
8660 when E_Record_Type |
8661 E_Record_Type_With_Private =>
8662 Write_Str ("Dispatch_Table_Wrappers");
8664 when E_In_Out_Parameter |
8665 E_Out_Parameter |
8666 E_Variable =>
8667 Write_Str ("Last_Assignment");
8669 when E_Access_Subprogram_Type =>
8670 Write_Str ("Original_Access_Type");
8672 when E_Generic_Package |
8673 E_Package =>
8674 Write_Str ("Package_Instantiation");
8676 when E_Component |
8677 E_Constant =>
8678 Write_Str ("Related_Type");
8680 when Task_Kind =>
8681 Write_Str ("Relative_Deadline_Variable");
8683 when E_Procedure |
8684 E_Function =>
8685 if Ekind (Id) = E_Procedure
8686 and then not Is_Dispatching_Operation (Id)
8687 then
8688 Write_Str ("Static_Initialization");
8689 else
8690 Write_Str ("Overridden_Operation");
8691 end if;
8693 when others =>
8694 Write_Str ("Field26??");
8695 end case;
8696 end Write_Field26_Name;
8698 ------------------------
8699 -- Write_Field27_Name --
8700 ------------------------
8702 procedure Write_Field27_Name (Id : Entity_Id) is
8703 begin
8704 case Ekind (Id) is
8705 when E_Package |
8706 Type_Kind =>
8707 Write_Str ("Current_Use_Clause");
8709 when E_Component |
8710 E_Constant |
8711 E_Variable =>
8712 Write_Str ("Related_Type");
8714 when E_Procedure =>
8715 Write_Str ("Wrapped_Entity");
8717 when others =>
8718 Write_Str ("Field27??");
8719 end case;
8720 end Write_Field27_Name;
8722 ------------------------
8723 -- Write_Field28_Name --
8724 ------------------------
8726 procedure Write_Field28_Name (Id : Entity_Id) is
8727 begin
8728 case Ekind (Id) is
8729 when E_Entry |
8730 E_Entry_Family |
8731 E_Function |
8732 E_Procedure |
8733 E_Subprogram_Body |
8734 E_Subprogram_Type =>
8735 Write_Str ("Extra_Formals");
8737 when E_Record_Type =>
8738 Write_Str ("Underlying_Record_View");
8740 when others =>
8741 Write_Str ("Field28??");
8742 end case;
8743 end Write_Field28_Name;
8745 procedure Write_Field29_Name (Id : Entity_Id) is
8746 begin
8747 case Ekind (Id) is
8748 when Type_Kind =>
8749 Write_Str ("Subprograms_For_Type");
8751 when others =>
8752 Write_Str ("Field29??");
8753 end case;
8754 end Write_Field29_Name;
8756 -------------------------
8757 -- Iterator Procedures --
8758 -------------------------
8760 procedure Proc_Next_Component (N : in out Node_Id) is
8761 begin
8762 N := Next_Component (N);
8763 end Proc_Next_Component;
8765 procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id) is
8766 begin
8767 N := Next_Entity (N);
8768 while Present (N) loop
8769 exit when Ekind_In (N, E_Component, E_Discriminant);
8770 N := Next_Entity (N);
8771 end loop;
8772 end Proc_Next_Component_Or_Discriminant;
8774 procedure Proc_Next_Discriminant (N : in out Node_Id) is
8775 begin
8776 N := Next_Discriminant (N);
8777 end Proc_Next_Discriminant;
8779 procedure Proc_Next_Formal (N : in out Node_Id) is
8780 begin
8781 N := Next_Formal (N);
8782 end Proc_Next_Formal;
8784 procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is
8785 begin
8786 N := Next_Formal_With_Extras (N);
8787 end Proc_Next_Formal_With_Extras;
8789 procedure Proc_Next_Index (N : in out Node_Id) is
8790 begin
8791 N := Next_Index (N);
8792 end Proc_Next_Index;
8794 procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is
8795 begin
8796 N := Next_Inlined_Subprogram (N);
8797 end Proc_Next_Inlined_Subprogram;
8799 procedure Proc_Next_Literal (N : in out Node_Id) is
8800 begin
8801 N := Next_Literal (N);
8802 end Proc_Next_Literal;
8804 procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is
8805 begin
8806 N := Next_Stored_Discriminant (N);
8807 end Proc_Next_Stored_Discriminant;
8809 end Einfo;