Merge form mainline (hopefully)
[official-gcc.git] / gcc / ada / einfo.adb
blobdb446143abb7880c7096537d6fabb748e2e388bb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E I N F O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2005, 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 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
21 -- --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
28 -- --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31 -- --
32 ------------------------------------------------------------------------------
34 pragma Style_Checks (All_Checks);
35 -- Turn off subprogram ordering, not used for this unit
37 with Atree; use Atree;
38 with Namet; use Namet;
39 with Nlists; use Nlists;
40 with Sinfo; use Sinfo;
41 with Stand; use Stand;
42 with Output; use Output;
44 package body Einfo is
46 use Atree.Unchecked_Access;
47 -- This is one of the packages that is allowed direct untyped access to
48 -- the fields in a node, since it provides the next level abstraction
49 -- which incorporates appropriate checks.
51 ----------------------------------------------
52 -- Usage of Fields in Defining Entity Nodes --
53 ----------------------------------------------
55 -- Four of these fields are defined in Sinfo, since they in are the
56 -- base part of the node. The access routines for these fields and
57 -- the corresponding set procedures are defined in Sinfo. These fields
58 -- are present in all entities. Note that Homonym is also in the base
59 -- part of the node, but has access routines that are more properly
60 -- part of Einfo, which is why they are defined here.
62 -- Chars Name1
63 -- Next_Entity Node2
64 -- Scope Node3
65 -- Etype Node5
67 -- Remaining fields are present only in extended nodes (i.e. entities)
69 -- The following fields are present in all entities
71 -- Homonym Node4
72 -- First_Rep_Item Node6
73 -- Freeze_Node Node7
75 -- The usage of each field (and the entity kinds to which it applies)
76 -- depends on the particular field (see Einfo spec for details).
78 -- Associated_Node_For_Itype Node8
79 -- Dependent_Instances Elist8
80 -- Hiding_Loop_Variable Node8
81 -- Mechanism Uint8 (but returns Mechanism_Type)
82 -- Normalized_First_Bit Uint8
84 -- Class_Wide_Type Node9
85 -- Current_Value Node9
86 -- Renaming_Map Uint9
88 -- Discriminal_Link Node10
89 -- Handler_Records List10
90 -- Normalized_Position_Max Uint10
91 -- Referenced_Object Node10
93 -- Component_Bit_Offset Uint11
94 -- Full_View Node11
95 -- Entry_Component Node11
96 -- Enumeration_Pos Uint11
97 -- Generic_Homonym Node11
98 -- Protected_Body_Subprogram Node11
99 -- Block_Node Node11
101 -- Barrier_Function Node12
102 -- Enumeration_Rep Uint12
103 -- Esize Uint12
104 -- Next_Inlined_Subprogram Node12
106 -- Corresponding_Equality Node13
107 -- Component_Clause Node13
108 -- Debug_Renaming_Link Node13
109 -- Elaboration_Entity Node13
110 -- Extra_Accessibility Node13
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 -- Primitive_Operations Elist15
126 -- Related_Instance Node15
127 -- Scale_Value Uint15
128 -- Storage_Size_Variable Node15
129 -- String_Literal_Low_Bound Node15
130 -- Shared_Var_Read_Proc Node15
132 -- Access_Disp_Table Elist16
133 -- Cloned_Subtype Node16
134 -- DTC_Entity Node16
135 -- Entry_Formal Node16
136 -- First_Private_Entity Node16
137 -- Lit_Strings Node16
138 -- String_Literal_Length Uint16
139 -- Unset_Reference Node16
141 -- Actual_Subtype Node17
142 -- Digits_Value Uint17
143 -- Discriminal Node17
144 -- First_Entity Node17
145 -- First_Index Node17
146 -- First_Literal Node17
147 -- Master_Id Node17
148 -- Modulus Uint17
149 -- Non_Limited_View Node17
150 -- Object_Ref Node17
151 -- Prival Node17
153 -- Alias Node18
154 -- Corresponding_Concurrent_Type Node18
155 -- Corresponding_Record_Type Node18
156 -- Delta_Value Ureal18
157 -- Enclosing_Scope Node18
158 -- Equivalent_Type Node18
159 -- Private_Dependents Elist18
160 -- Renamed_Entity Node18
161 -- Renamed_Object Node18
163 -- Body_Entity Node19
164 -- Corresponding_Discriminant Node19
165 -- Finalization_Chain_Entity Node19
166 -- Parent_Subtype Node19
167 -- Related_Array_Object Node19
168 -- Size_Check_Code Node19
169 -- Spec_Entity Node19
170 -- Underlying_Full_View Node19
172 -- Component_Type Node20
173 -- Default_Value Node20
174 -- Directly_Designated_Type Node20
175 -- Discriminant_Checking_Func Node20
176 -- Discriminant_Default_Value Node20
177 -- Last_Entity Node20
178 -- Register_Exception_Call Node20
179 -- Scalar_Range Node20
181 -- Accept_Address Elist21
182 -- Default_Expr_Function Node21
183 -- Discriminant_Constraint Elist21
184 -- Interface_Name Node21
185 -- Original_Array_Type Node21
186 -- Small_Value Ureal21
188 -- Associated_Storage_Pool Node22
189 -- Component_Size Uint22
190 -- Corresponding_Remote_Type Node22
191 -- Enumeration_Rep_Expr Node22
192 -- Exception_Code Uint22
193 -- Original_Record_Component Node22
194 -- Private_View Node22
195 -- Protected_Formal Node22
196 -- Scope_Depth_Value Uint22
197 -- Shared_Var_Assign_Proc Node22
199 -- Associated_Final_Chain Node23
200 -- CR_Discriminant Node23
201 -- Stored_Constraint Elist23
202 -- Entry_Cancel_Parameter Node23
203 -- Extra_Constrained Node23
204 -- Generic_Renamings Elist23
205 -- Inner_Instances Elist23
206 -- Enum_Pos_To_Rep Node23
207 -- Packed_Array_Type Node23
208 -- Limited_View Node23
209 -- Privals_Chain Elist23
210 -- Protected_Operation Node23
212 -- Obsolescent_Warning Node24
213 -- Task_Body_Procedure Node24
214 -- Abstract_Interfaces Elist24
216 -- Abstract_Interface_Alias Node25
218 -- Overridden_Operation Node26
220 -- Wrapped_Entity Node27
222 ---------------------------------------------
223 -- Usage of Flags in Defining Entity Nodes --
224 ---------------------------------------------
226 -- All flags are unique, there is no overlaying, so each flag is physically
227 -- present in every entity. However, for many of the flags, it only makes
228 -- sense for them to be set true for certain subsets of entity kinds. See
229 -- the spec of Einfo for further details.
231 -- Note: Flag1-Flag3 are absent from this list, since these flag positions
232 -- are used for the flags Analyzed, Comes_From_Source, and Error_Posted,
233 -- which are common to all nodes, including entity nodes.
235 -- Is_Frozen Flag4
236 -- Has_Discriminants Flag5
237 -- Is_Dispatching_Operation Flag6
238 -- Is_Immediately_Visible Flag7
239 -- In_Use Flag8
240 -- Is_Potentially_Use_Visible Flag9
241 -- Is_Public Flag10
243 -- Is_Inlined Flag11
244 -- Is_Constrained Flag12
245 -- Is_Generic_Type Flag13
246 -- Depends_On_Private Flag14
247 -- Is_Aliased Flag15
248 -- Is_Volatile Flag16
249 -- Is_Internal Flag17
250 -- Has_Delayed_Freeze Flag18
251 -- Is_Abstract Flag19
252 -- Is_Concurrent_Record_Type Flag20
254 -- Has_Master_Entity Flag21
255 -- Needs_No_Actuals Flag22
256 -- Has_Storage_Size_Clause Flag23
257 -- Is_Imported Flag24
258 -- Is_Limited_Record Flag25
259 -- Has_Completion Flag26
260 -- Has_Pragma_Controlled Flag27
261 -- Is_Statically_Allocated Flag28
262 -- Has_Size_Clause Flag29
263 -- Has_Task Flag30
265 -- Checks_May_Be_Suppressed Flag31
266 -- Kill_Elaboration_Checks Flag32
267 -- Kill_Range_Checks Flag33
268 -- Kill_Tag_Checks Flag34
269 -- Is_Class_Wide_Equivalent_Type Flag35
270 -- Referenced_As_LHS Flag36
271 -- Is_Known_Non_Null Flag37
272 -- Can_Never_Be_Null Flag38
273 -- Is_Overriding_Operation Flag39
274 -- Body_Needed_For_SAL Flag40
276 -- Treat_As_Volatile Flag41
277 -- Is_Controlled Flag42
278 -- Has_Controlled_Component Flag43
279 -- Is_Pure Flag44
280 -- In_Private_Part Flag45
281 -- Has_Alignment_Clause Flag46
282 -- Has_Exit Flag47
283 -- In_Package_Body Flag48
284 -- Reachable Flag49
285 -- Delay_Subprogram_Descriptors Flag50
287 -- Is_Packed Flag51
288 -- Is_Entry_Formal Flag52
289 -- Is_Private_Descendant Flag53
290 -- Return_Present Flag54
291 -- Is_Tagged_Type Flag55
292 -- Has_Homonym Flag56
293 -- Is_Hidden Flag57
294 -- Non_Binary_Modulus Flag58
295 -- Is_Preelaborated Flag59
296 -- Is_Shared_Passive Flag60
298 -- Is_Remote_Types Flag61
299 -- Is_Remote_Call_Interface Flag62
300 -- Is_Character_Type Flag63
301 -- Is_Intrinsic_Subprogram Flag64
302 -- Has_Record_Rep_Clause Flag65
303 -- Has_Enumeration_Rep_Clause Flag66
304 -- Has_Small_Clause Flag67
305 -- Has_Component_Size_Clause Flag68
306 -- Is_Access_Constant Flag69
307 -- Is_First_Subtype Flag70
309 -- Has_Completion_In_Body Flag71
310 -- Has_Unknown_Discriminants Flag72
311 -- Is_Child_Unit Flag73
312 -- Is_CPP_Class Flag74
313 -- Has_Non_Standard_Rep Flag75
314 -- Is_Constructor Flag76
315 -- Is_Thread_Body Flag77
316 -- Is_Tag Flag78
317 -- Has_All_Calls_Remote Flag79
318 -- Is_Constr_Subt_For_U_Nominal Flag80
320 -- Is_Asynchronous Flag81
321 -- Has_Gigi_Rep_Item Flag82
322 -- Has_Machine_Radix_Clause Flag83
323 -- Machine_Radix_10 Flag84
324 -- Is_Atomic Flag85
325 -- Has_Atomic_Components Flag86
326 -- Has_Volatile_Components Flag87
327 -- Discard_Names Flag88
328 -- Is_Interrupt_Handler Flag89
329 -- Returns_By_Ref Flag90
331 -- Is_Itype Flag91
332 -- Size_Known_At_Compile_Time Flag92
333 -- Has_Subprogram_Descriptor Flag93
334 -- Is_Generic_Actual_Type Flag94
335 -- Uses_Sec_Stack Flag95
336 -- Warnings_Off Flag96
337 -- Is_Controlling_Formal Flag97
338 -- Has_Controlling_Result Flag98
339 -- Is_Exported Flag99
340 -- Has_Specified_Layout Flag100
342 -- Has_Nested_Block_With_Handler Flag101
343 -- Is_Called Flag102
344 -- Is_Completely_Hidden Flag103
345 -- Address_Taken Flag104
346 -- Suppress_Init_Proc Flag105
347 -- Is_Limited_Composite Flag106
348 -- Is_Private_Composite Flag107
349 -- Default_Expressions_Processed Flag108
350 -- Is_Non_Static_Subtype Flag109
351 -- Has_External_Tag_Rep_Clause Flag110
353 -- Is_Formal_Subprogram Flag111
354 -- Is_Renaming_Of_Object Flag112
355 -- No_Return Flag113
356 -- Delay_Cleanups Flag114
357 -- Never_Set_In_Source Flag115
358 -- Is_Visible_Child_Unit Flag116
359 -- Is_Unchecked_Union Flag117
360 -- Is_For_Access_Subtype Flag118
361 -- Has_Convention_Pragma Flag119
362 -- Has_Primitive_Operations Flag120
364 -- Has_Pragma_Pack Flag121
365 -- Is_Bit_Packed_Array Flag122
366 -- Has_Unchecked_Union Flag123
367 -- Is_Eliminated Flag124
368 -- C_Pass_By_Copy Flag125
369 -- Is_Instantiated Flag126
370 -- Is_Valued_Procedure Flag127
371 -- (used for Component_Alignment) Flag128
372 -- (used for Component_Alignment) Flag129
373 -- Is_Generic_Instance Flag130
375 -- No_Pool_Assigned Flag131
376 -- Is_AST_Entry Flag132
377 -- Is_VMS_Exception Flag133
378 -- Is_Optional_Parameter Flag134
379 -- Has_Aliased_Components Flag135
380 -- No_Strict_Aliasing Flag136
381 -- Is_Machine_Code_Subprogram Flag137
382 -- Is_Packed_Array_Type Flag138
383 -- Has_Biased_Representation Flag139
384 -- Has_Complex_Representation Flag140
386 -- Is_Constr_Subt_For_UN_Aliased Flag141
387 -- Has_Missing_Return Flag142
388 -- Has_Recursive_Call Flag143
389 -- Is_Unsigned_Type Flag144
390 -- Strict_Alignment Flag145
391 -- Elaborate_All_Desirable Flag146
392 -- Needs_Debug_Info Flag147
393 -- Suppress_Elaboration_Warnings Flag148
394 -- Is_Compilation_Unit Flag149
395 -- Has_Pragma_Elaborate_Body Flag150
397 -- Vax_Float Flag151
398 -- Entry_Accepted Flag152
399 -- Is_Obsolescent Flag153
400 -- Has_Per_Object_Constraint Flag154
401 -- Has_Private_Declaration Flag155
402 -- Referenced Flag156
403 -- Has_Pragma_Inline Flag157
404 -- Finalize_Storage_Only Flag158
405 -- From_With_Type Flag159
406 -- Is_Package_Body_Entity Flag160
408 -- Has_Qualified_Name Flag161
409 -- Nonzero_Is_True Flag162
410 -- Is_True_Constant Flag163
411 -- Reverse_Bit_Order Flag164
412 -- Suppress_Style_Checks Flag165
413 -- Debug_Info_Off Flag166
414 -- Sec_Stack_Needed_For_Return Flag167
415 -- Materialize_Entity Flag168
416 -- Function_Returns_With_DSP Flag169
417 -- Is_Known_Valid Flag170
419 -- Is_Hidden_Open_Scope Flag171
420 -- Has_Object_Size_Clause Flag172
421 -- Has_Fully_Qualified_Name Flag173
422 -- Elaboration_Entity_Required Flag174
423 -- Has_Forward_Instantiation Flag175
424 -- Is_Discrim_SO_Function Flag176
425 -- Size_Depends_On_Discriminant Flag177
426 -- Is_Null_Init_Proc Flag178
427 -- Has_Pragma_Pure_Function Flag179
428 -- Has_Pragma_Unreferenced Flag180
430 -- Has_Contiguous_Rep Flag181
431 -- Has_Xref_Entry Flag182
432 -- Must_Be_On_Byte_Boundary Flag183
433 -- Has_Stream_Size_Clause Flag184
434 -- Is_Ada_2005 Flag185
435 -- Is_Interface Flag186
436 -- Has_Constrained_Partial_View Flag187
437 -- Has_Persistent_BSS Flag188
438 -- Is_Pure_Unit_Access_Type Flag189
439 -- Has_Specified_Stream_Input Flag190
441 -- Has_Specified_Stream_Output Flag191
442 -- Has_Specified_Stream_Read Flag192
443 -- Has_Specified_Stream_Write Flag193
444 -- Is_Local_Anonymous_Access Flag194
445 -- Is_Primitive_Wrapper Flag195
446 -- Was_Hidden Flag196
448 -- (unused) Flag197
449 -- (unused) Flag198
450 -- (unused) Flag199
451 -- (unused) Flag200
452 -- (unused) Flag201
453 -- (unused) Flag202
454 -- (unused) Flag203
455 -- (unused) Flag204
456 -- (unused) Flag205
457 -- (unused) Flag206
458 -- (unused) Flag207
459 -- (unused) Flag208
460 -- (unused) Flag209
461 -- (unused) Flag210
462 -- (unused) Flag211
463 -- (unused) Flag212
464 -- (unused) Flag213
465 -- (unused) Flag214
466 -- (unused) Flag215
468 -----------------------
469 -- Local subprograms --
470 -----------------------
472 function Rep_Clause (Id : E; Rep_Name : Name_Id) return N;
473 -- Returns the attribute definition clause whose name is Rep_Name. Returns
474 -- Empty if not found.
476 ----------------
477 -- Rep_Clause --
478 ----------------
480 function Rep_Clause (Id : E; Rep_Name : Name_Id) return N is
481 Ritem : Node_Id;
483 begin
484 Ritem := First_Rep_Item (Id);
485 while Present (Ritem) loop
486 if Nkind (Ritem) = N_Attribute_Definition_Clause
487 and then Chars (Ritem) = Rep_Name
488 then
489 return Ritem;
490 else
491 Ritem := Next_Rep_Item (Ritem);
492 end if;
493 end loop;
495 return Empty;
496 end Rep_Clause;
498 --------------------------------
499 -- Attribute Access Functions --
500 --------------------------------
502 function Abstract_Interfaces (Id : E) return L is
503 begin
504 pragma Assert
505 (Ekind (Id) = E_Record_Type
506 or else Ekind (Id) = E_Record_Subtype
507 or else Ekind (Id) = E_Record_Type_With_Private
508 or else Ekind (Id) = E_Record_Subtype_With_Private
509 or else Ekind (Id) = E_Class_Wide_Type);
510 return Elist24 (Id);
511 end Abstract_Interfaces;
513 function Abstract_Interface_Alias (Id : E) return E is
514 begin
515 pragma Assert (Is_Subprogram (Id));
516 return Node25 (Id);
517 end Abstract_Interface_Alias;
519 function Accept_Address (Id : E) return L is
520 begin
521 return Elist21 (Id);
522 end Accept_Address;
524 function Access_Disp_Table (Id : E) return L is
525 begin
526 pragma Assert (Is_Tagged_Type (Id));
527 return Elist16 (Implementation_Base_Type (Id));
528 end Access_Disp_Table;
530 function Actual_Subtype (Id : E) return E is
531 begin
532 pragma Assert
533 (Ekind (Id) = E_Constant
534 or else Ekind (Id) = E_Variable
535 or else Ekind (Id) = E_Generic_In_Out_Parameter
536 or else Ekind (Id) in E_In_Parameter .. E_In_Out_Parameter);
537 return Node17 (Id);
538 end Actual_Subtype;
540 function Address_Taken (Id : E) return B is
541 begin
542 return Flag104 (Id);
543 end Address_Taken;
545 function Alias (Id : E) return E is
546 begin
547 pragma Assert
548 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
549 return Node18 (Id);
550 end Alias;
552 function Alignment (Id : E) return U is
553 begin
554 pragma Assert (Is_Type (Id)
555 or else Is_Formal (Id)
556 or else Ekind (Id) = E_Loop_Parameter
557 or else Ekind (Id) = E_Constant
558 or else Ekind (Id) = E_Exception
559 or else Ekind (Id) = E_Variable);
560 return Uint14 (Id);
561 end Alignment;
563 function Associated_Final_Chain (Id : E) return E is
564 begin
565 pragma Assert (Is_Access_Type (Id));
566 return Node23 (Id);
567 end Associated_Final_Chain;
569 function Associated_Formal_Package (Id : E) return E is
570 begin
571 pragma Assert (Ekind (Id) = E_Package);
572 return Node12 (Id);
573 end Associated_Formal_Package;
575 function Associated_Node_For_Itype (Id : E) return N is
576 begin
577 return Node8 (Id);
578 end Associated_Node_For_Itype;
580 function Associated_Storage_Pool (Id : E) return E is
581 begin
582 pragma Assert (Is_Access_Type (Id));
583 return Node22 (Root_Type (Id));
584 end Associated_Storage_Pool;
586 function Barrier_Function (Id : E) return N is
587 begin
588 pragma Assert (Is_Entry (Id));
589 return Node12 (Id);
590 end Barrier_Function;
592 function Block_Node (Id : E) return N is
593 begin
594 pragma Assert (Ekind (Id) = E_Block);
595 return Node11 (Id);
596 end Block_Node;
598 function Body_Entity (Id : E) return E is
599 begin
600 pragma Assert
601 (Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package);
602 return Node19 (Id);
603 end Body_Entity;
605 function Body_Needed_For_SAL (Id : E) return B is
606 begin
607 pragma Assert
608 (Ekind (Id) = E_Package
609 or else Is_Subprogram (Id)
610 or else Is_Generic_Unit (Id));
611 return Flag40 (Id);
612 end Body_Needed_For_SAL;
614 function C_Pass_By_Copy (Id : E) return B is
615 begin
616 pragma Assert (Is_Record_Type (Id));
617 return Flag125 (Implementation_Base_Type (Id));
618 end C_Pass_By_Copy;
620 function Can_Never_Be_Null (Id : E) return B is
621 begin
622 return Flag38 (Id);
623 end Can_Never_Be_Null;
625 function Checks_May_Be_Suppressed (Id : E) return B is
626 begin
627 return Flag31 (Id);
628 end Checks_May_Be_Suppressed;
630 function Class_Wide_Type (Id : E) return E is
631 begin
632 pragma Assert (Is_Type (Id));
633 return Node9 (Id);
634 end Class_Wide_Type;
636 function Cloned_Subtype (Id : E) return E is
637 begin
638 pragma Assert
639 (Ekind (Id) = E_Record_Subtype
640 or else Ekind (Id) = E_Class_Wide_Subtype);
641 return Node16 (Id);
642 end Cloned_Subtype;
644 function Component_Bit_Offset (Id : E) return U is
645 begin
646 pragma Assert
647 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
648 return Uint11 (Id);
649 end Component_Bit_Offset;
651 function Component_Clause (Id : E) return N is
652 begin
653 pragma Assert
654 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
655 return Node13 (Id);
656 end Component_Clause;
658 function Component_Size (Id : E) return U is
659 begin
660 pragma Assert (Is_Array_Type (Id));
661 return Uint22 (Implementation_Base_Type (Id));
662 end Component_Size;
664 function Component_Type (Id : E) return E is
665 begin
666 return Node20 (Implementation_Base_Type (Id));
667 end Component_Type;
669 function Corresponding_Concurrent_Type (Id : E) return E is
670 begin
671 pragma Assert (Ekind (Id) = E_Record_Type);
672 return Node18 (Id);
673 end Corresponding_Concurrent_Type;
675 function Corresponding_Discriminant (Id : E) return E is
676 begin
677 pragma Assert (Ekind (Id) = E_Discriminant);
678 return Node19 (Id);
679 end Corresponding_Discriminant;
681 function Corresponding_Equality (Id : E) return E is
682 begin
683 pragma Assert
684 (Ekind (Id) = E_Function
685 and then not Comes_From_Source (Id)
686 and then Chars (Id) = Name_Op_Ne);
687 return Node13 (Id);
688 end Corresponding_Equality;
690 function Corresponding_Record_Type (Id : E) return E is
691 begin
692 pragma Assert (Is_Concurrent_Type (Id));
693 return Node18 (Id);
694 end Corresponding_Record_Type;
696 function Corresponding_Remote_Type (Id : E) return E is
697 begin
698 return Node22 (Id);
699 end Corresponding_Remote_Type;
701 function Current_Value (Id : E) return N is
702 begin
703 pragma Assert (Ekind (Id) in Object_Kind);
704 return Node9 (Id);
705 end Current_Value;
707 function CR_Discriminant (Id : E) return E is
708 begin
709 return Node23 (Id);
710 end CR_Discriminant;
712 function Debug_Info_Off (Id : E) return B is
713 begin
714 return Flag166 (Id);
715 end Debug_Info_Off;
717 function Debug_Renaming_Link (Id : E) return E is
718 begin
719 return Node13 (Id);
720 end Debug_Renaming_Link;
722 function Default_Expr_Function (Id : E) return E is
723 begin
724 pragma Assert (Is_Formal (Id));
725 return Node21 (Id);
726 end Default_Expr_Function;
728 function Default_Expressions_Processed (Id : E) return B is
729 begin
730 return Flag108 (Id);
731 end Default_Expressions_Processed;
733 function Default_Value (Id : E) return N is
734 begin
735 pragma Assert (Is_Formal (Id));
736 return Node20 (Id);
737 end Default_Value;
739 function Delay_Cleanups (Id : E) return B is
740 begin
741 return Flag114 (Id);
742 end Delay_Cleanups;
744 function Delay_Subprogram_Descriptors (Id : E) return B is
745 begin
746 return Flag50 (Id);
747 end Delay_Subprogram_Descriptors;
749 function Delta_Value (Id : E) return R is
750 begin
751 pragma Assert (Is_Fixed_Point_Type (Id));
752 return Ureal18 (Id);
753 end Delta_Value;
755 function Dependent_Instances (Id : E) return L is
756 begin
757 pragma Assert (Is_Generic_Instance (Id));
758 return Elist8 (Id);
759 end Dependent_Instances;
761 function Depends_On_Private (Id : E) return B is
762 begin
763 pragma Assert (Nkind (Id) in N_Entity);
764 return Flag14 (Id);
765 end Depends_On_Private;
767 function Digits_Value (Id : E) return U is
768 begin
769 pragma Assert
770 (Is_Floating_Point_Type (Id)
771 or else Is_Decimal_Fixed_Point_Type (Id));
772 return Uint17 (Id);
773 end Digits_Value;
775 function Directly_Designated_Type (Id : E) return E is
776 begin
777 return Node20 (Id);
778 end Directly_Designated_Type;
780 function Discard_Names (Id : E) return B is
781 begin
782 return Flag88 (Id);
783 end Discard_Names;
785 function Discriminal (Id : E) return E is
786 begin
787 pragma Assert (Ekind (Id) = E_Discriminant);
788 return Node17 (Id);
789 end Discriminal;
791 function Discriminal_Link (Id : E) return N is
792 begin
793 return Node10 (Id);
794 end Discriminal_Link;
796 function Discriminant_Checking_Func (Id : E) return E is
797 begin
798 pragma Assert (Ekind (Id) = E_Component);
799 return Node20 (Id);
800 end Discriminant_Checking_Func;
802 function Discriminant_Constraint (Id : E) return L is
803 begin
804 pragma Assert (Is_Composite_Type (Id) and then Has_Discriminants (Id));
805 return Elist21 (Id);
806 end Discriminant_Constraint;
808 function Discriminant_Default_Value (Id : E) return N is
809 begin
810 pragma Assert (Ekind (Id) = E_Discriminant);
811 return Node20 (Id);
812 end Discriminant_Default_Value;
814 function Discriminant_Number (Id : E) return U is
815 begin
816 pragma Assert (Ekind (Id) = E_Discriminant);
817 return Uint15 (Id);
818 end Discriminant_Number;
820 function DT_Entry_Count (Id : E) return U is
821 begin
822 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
823 return Uint15 (Id);
824 end DT_Entry_Count;
826 function DT_Position (Id : E) return U is
827 begin
828 pragma Assert
829 ((Ekind (Id) = E_Function
830 or else Ekind (Id) = E_Procedure)
831 and then Present (DTC_Entity (Id)));
832 return Uint15 (Id);
833 end DT_Position;
835 function DTC_Entity (Id : E) return E is
836 begin
837 pragma Assert
838 (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
839 return Node16 (Id);
840 end DTC_Entity;
842 function Elaborate_All_Desirable (Id : E) return B is
843 begin
844 return Flag146 (Id);
845 end Elaborate_All_Desirable;
847 function Elaboration_Entity (Id : E) return E is
848 begin
849 pragma Assert
850 (Is_Subprogram (Id)
851 or else
852 Ekind (Id) = E_Package
853 or else
854 Is_Generic_Unit (Id));
855 return Node13 (Id);
856 end Elaboration_Entity;
858 function Elaboration_Entity_Required (Id : E) return B is
859 begin
860 pragma Assert
861 (Is_Subprogram (Id)
862 or else
863 Ekind (Id) = E_Package
864 or else
865 Is_Generic_Unit (Id));
866 return Flag174 (Id);
867 end Elaboration_Entity_Required;
869 function Enclosing_Scope (Id : E) return E is
870 begin
871 return Node18 (Id);
872 end Enclosing_Scope;
874 function Entry_Accepted (Id : E) return B is
875 begin
876 pragma Assert (Is_Entry (Id));
877 return Flag152 (Id);
878 end Entry_Accepted;
880 function Entry_Bodies_Array (Id : E) return E is
881 begin
882 return Node15 (Id);
883 end Entry_Bodies_Array;
885 function Entry_Cancel_Parameter (Id : E) return E is
886 begin
887 return Node23 (Id);
888 end Entry_Cancel_Parameter;
890 function Entry_Component (Id : E) return E is
891 begin
892 return Node11 (Id);
893 end Entry_Component;
895 function Entry_Formal (Id : E) return E is
896 begin
897 return Node16 (Id);
898 end Entry_Formal;
900 function Entry_Index_Constant (Id : E) return N is
901 begin
902 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
903 return Node18 (Id);
904 end Entry_Index_Constant;
906 function Entry_Parameters_Type (Id : E) return E is
907 begin
908 return Node15 (Id);
909 end Entry_Parameters_Type;
911 function Enum_Pos_To_Rep (Id : E) return E is
912 begin
913 pragma Assert (Ekind (Id) = E_Enumeration_Type);
914 return Node23 (Id);
915 end Enum_Pos_To_Rep;
917 function Enumeration_Pos (Id : E) return Uint is
918 begin
919 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
920 return Uint11 (Id);
921 end Enumeration_Pos;
923 function Enumeration_Rep (Id : E) return U is
924 begin
925 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
926 return Uint12 (Id);
927 end Enumeration_Rep;
929 function Enumeration_Rep_Expr (Id : E) return N is
930 begin
931 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
932 return Node22 (Id);
933 end Enumeration_Rep_Expr;
935 function Equivalent_Type (Id : E) return E is
936 begin
937 pragma Assert
938 (Ekind (Id) = E_Class_Wide_Subtype or else
939 Ekind (Id) = E_Access_Protected_Subprogram_Type or else
940 Ekind (Id) = E_Access_Subprogram_Type or else
941 Ekind (Id) = E_Exception_Type);
942 return Node18 (Id);
943 end Equivalent_Type;
945 function Esize (Id : E) return Uint is
946 begin
947 return Uint12 (Id);
948 end Esize;
950 function Exception_Code (Id : E) return Uint is
951 begin
952 pragma Assert (Ekind (Id) = E_Exception);
953 return Uint22 (Id);
954 end Exception_Code;
956 function Extra_Accessibility (Id : E) return E is
957 begin
958 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
959 return Node13 (Id);
960 end Extra_Accessibility;
962 function Extra_Constrained (Id : E) return E is
963 begin
964 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
965 return Node23 (Id);
966 end Extra_Constrained;
968 function Extra_Formal (Id : E) return E is
969 begin
970 return Node15 (Id);
971 end Extra_Formal;
973 function Finalization_Chain_Entity (Id : E) return E is
974 begin
975 return Node19 (Id);
976 end Finalization_Chain_Entity;
978 function Finalize_Storage_Only (Id : E) return B is
979 begin
980 pragma Assert (Is_Type (Id));
981 return Flag158 (Base_Type (Id));
982 end Finalize_Storage_Only;
984 function First_Entity (Id : E) return E is
985 begin
986 return Node17 (Id);
987 end First_Entity;
989 function First_Index (Id : E) return N is
990 begin
991 return Node17 (Id);
992 end First_Index;
994 function First_Literal (Id : E) return E is
995 begin
996 return Node17 (Id);
997 end First_Literal;
999 function First_Optional_Parameter (Id : E) return E is
1000 begin
1001 pragma Assert
1002 (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
1003 return Node14 (Id);
1004 end First_Optional_Parameter;
1006 function First_Private_Entity (Id : E) return E is
1007 begin
1008 pragma Assert (Ekind (Id) = E_Package
1009 or else Ekind (Id) = E_Generic_Package
1010 or else Ekind (Id) = E_Protected_Type
1011 or else Ekind (Id) = E_Protected_Subtype
1012 or else Ekind (Id) = E_Task_Type
1013 or else Ekind (Id) = E_Task_Subtype);
1014 return Node16 (Id);
1015 end First_Private_Entity;
1017 function First_Rep_Item (Id : E) return E is
1018 begin
1019 return Node6 (Id);
1020 end First_Rep_Item;
1022 function Freeze_Node (Id : E) return N is
1023 begin
1024 return Node7 (Id);
1025 end Freeze_Node;
1027 function From_With_Type (Id : E) return B is
1028 begin
1029 return Flag159 (Id);
1030 end From_With_Type;
1032 function Full_View (Id : E) return E is
1033 begin
1034 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
1035 return Node11 (Id);
1036 end Full_View;
1038 function Function_Returns_With_DSP (Id : E) return B is
1039 begin
1040 pragma Assert
1041 (Is_Subprogram (Id) or else Ekind (Id) = E_Subprogram_Type);
1042 return Flag169 (Id);
1043 end Function_Returns_With_DSP;
1045 function Generic_Homonym (Id : E) return E is
1046 begin
1047 pragma Assert (Ekind (Id) = E_Generic_Package);
1048 return Node11 (Id);
1049 end Generic_Homonym;
1051 function Generic_Renamings (Id : E) return L is
1052 begin
1053 return Elist23 (Id);
1054 end Generic_Renamings;
1056 function Handler_Records (Id : E) return S is
1057 begin
1058 return List10 (Id);
1059 end Handler_Records;
1061 function Has_Aliased_Components (Id : E) return B is
1062 begin
1063 return Flag135 (Implementation_Base_Type (Id));
1064 end Has_Aliased_Components;
1066 function Has_Alignment_Clause (Id : E) return B is
1067 begin
1068 return Flag46 (Id);
1069 end Has_Alignment_Clause;
1071 function Has_All_Calls_Remote (Id : E) return B is
1072 begin
1073 return Flag79 (Id);
1074 end Has_All_Calls_Remote;
1076 function Has_Atomic_Components (Id : E) return B is
1077 begin
1078 return Flag86 (Implementation_Base_Type (Id));
1079 end Has_Atomic_Components;
1081 function Has_Biased_Representation (Id : E) return B is
1082 begin
1083 return Flag139 (Id);
1084 end Has_Biased_Representation;
1086 function Has_Completion (Id : E) return B is
1087 begin
1088 return Flag26 (Id);
1089 end Has_Completion;
1091 function Has_Completion_In_Body (Id : E) return B is
1092 begin
1093 pragma Assert (Is_Type (Id));
1094 return Flag71 (Id);
1095 end Has_Completion_In_Body;
1097 function Has_Complex_Representation (Id : E) return B is
1098 begin
1099 pragma Assert (Is_Type (Id));
1100 return Flag140 (Implementation_Base_Type (Id));
1101 end Has_Complex_Representation;
1103 function Has_Component_Size_Clause (Id : E) return B is
1104 begin
1105 pragma Assert (Is_Array_Type (Id));
1106 return Flag68 (Implementation_Base_Type (Id));
1107 end Has_Component_Size_Clause;
1109 function Has_Constrained_Partial_View (Id : E) return B is
1110 begin
1111 pragma Assert (Is_Type (Id));
1112 return Flag187 (Id);
1113 end Has_Constrained_Partial_View;
1115 function Has_Controlled_Component (Id : E) return B is
1116 begin
1117 return Flag43 (Base_Type (Id));
1118 end Has_Controlled_Component;
1120 function Has_Contiguous_Rep (Id : E) return B is
1121 begin
1122 return Flag181 (Id);
1123 end Has_Contiguous_Rep;
1125 function Has_Controlling_Result (Id : E) return B is
1126 begin
1127 return Flag98 (Id);
1128 end Has_Controlling_Result;
1130 function Has_Convention_Pragma (Id : E) return B is
1131 begin
1132 return Flag119 (Id);
1133 end Has_Convention_Pragma;
1135 function Has_Delayed_Freeze (Id : E) return B is
1136 begin
1137 pragma Assert (Nkind (Id) in N_Entity);
1138 return Flag18 (Id);
1139 end Has_Delayed_Freeze;
1141 function Has_Discriminants (Id : E) return B is
1142 begin
1143 pragma Assert (Nkind (Id) in N_Entity);
1144 return Flag5 (Id);
1145 end Has_Discriminants;
1147 function Has_Enumeration_Rep_Clause (Id : E) return B is
1148 begin
1149 pragma Assert (Is_Enumeration_Type (Id));
1150 return Flag66 (Id);
1151 end Has_Enumeration_Rep_Clause;
1153 function Has_Exit (Id : E) return B is
1154 begin
1155 return Flag47 (Id);
1156 end Has_Exit;
1158 function Has_External_Tag_Rep_Clause (Id : E) return B is
1159 begin
1160 pragma Assert (Is_Tagged_Type (Id));
1161 return Flag110 (Id);
1162 end Has_External_Tag_Rep_Clause;
1164 function Has_Forward_Instantiation (Id : E) return B is
1165 begin
1166 return Flag175 (Id);
1167 end Has_Forward_Instantiation;
1169 function Has_Fully_Qualified_Name (Id : E) return B is
1170 begin
1171 return Flag173 (Id);
1172 end Has_Fully_Qualified_Name;
1174 function Has_Gigi_Rep_Item (Id : E) return B is
1175 begin
1176 return Flag82 (Id);
1177 end Has_Gigi_Rep_Item;
1179 function Has_Homonym (Id : E) return B is
1180 begin
1181 return Flag56 (Id);
1182 end Has_Homonym;
1184 function Has_Machine_Radix_Clause (Id : E) return B is
1185 begin
1186 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
1187 return Flag83 (Id);
1188 end Has_Machine_Radix_Clause;
1190 function Has_Master_Entity (Id : E) return B is
1191 begin
1192 return Flag21 (Id);
1193 end Has_Master_Entity;
1195 function Has_Missing_Return (Id : E) return B is
1196 begin
1197 pragma Assert
1198 (Ekind (Id) = E_Function or else Ekind (Id) = E_Generic_Function);
1199 return Flag142 (Id);
1200 end Has_Missing_Return;
1202 function Has_Nested_Block_With_Handler (Id : E) return B is
1203 begin
1204 return Flag101 (Id);
1205 end Has_Nested_Block_With_Handler;
1207 function Has_Non_Standard_Rep (Id : E) return B is
1208 begin
1209 return Flag75 (Implementation_Base_Type (Id));
1210 end Has_Non_Standard_Rep;
1212 function Has_Object_Size_Clause (Id : E) return B is
1213 begin
1214 pragma Assert (Is_Type (Id));
1215 return Flag172 (Id);
1216 end Has_Object_Size_Clause;
1218 function Has_Per_Object_Constraint (Id : E) return B is
1219 begin
1220 return Flag154 (Id);
1221 end Has_Per_Object_Constraint;
1223 function Has_Persistent_BSS (Id : E) return B is
1224 begin
1225 return Flag188 (Id);
1226 end Has_Persistent_BSS;
1228 function Has_Pragma_Controlled (Id : E) return B is
1229 begin
1230 pragma Assert (Is_Access_Type (Id));
1231 return Flag27 (Implementation_Base_Type (Id));
1232 end Has_Pragma_Controlled;
1234 function Has_Pragma_Elaborate_Body (Id : E) return B is
1235 begin
1236 return Flag150 (Id);
1237 end Has_Pragma_Elaborate_Body;
1239 function Has_Pragma_Inline (Id : E) return B is
1240 begin
1241 return Flag157 (Id);
1242 end Has_Pragma_Inline;
1244 function Has_Pragma_Pack (Id : E) return B is
1245 begin
1246 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
1247 return Flag121 (Implementation_Base_Type (Id));
1248 end Has_Pragma_Pack;
1250 function Has_Pragma_Pure_Function (Id : E) return B is
1251 begin
1252 pragma Assert (Is_Subprogram (Id));
1253 return Flag179 (Id);
1254 end Has_Pragma_Pure_Function;
1256 function Has_Pragma_Unreferenced (Id : E) return B is
1257 begin
1258 return Flag180 (Id);
1259 end Has_Pragma_Unreferenced;
1261 function Has_Primitive_Operations (Id : E) return B is
1262 begin
1263 pragma Assert (Is_Type (Id));
1264 return Flag120 (Base_Type (Id));
1265 end Has_Primitive_Operations;
1267 function Has_Private_Declaration (Id : E) return B is
1268 begin
1269 return Flag155 (Id);
1270 end Has_Private_Declaration;
1272 function Has_Qualified_Name (Id : E) return B is
1273 begin
1274 return Flag161 (Id);
1275 end Has_Qualified_Name;
1277 function Has_Record_Rep_Clause (Id : E) return B is
1278 begin
1279 pragma Assert (Is_Record_Type (Id));
1280 return Flag65 (Implementation_Base_Type (Id));
1281 end Has_Record_Rep_Clause;
1283 function Has_Recursive_Call (Id : E) return B is
1284 begin
1285 pragma Assert (Is_Subprogram (Id));
1286 return Flag143 (Id);
1287 end Has_Recursive_Call;
1289 function Has_Size_Clause (Id : E) return B is
1290 begin
1291 return Flag29 (Id);
1292 end Has_Size_Clause;
1294 function Has_Small_Clause (Id : E) return B is
1295 begin
1296 return Flag67 (Id);
1297 end Has_Small_Clause;
1299 function Has_Specified_Layout (Id : E) return B is
1300 begin
1301 pragma Assert (Is_Type (Id));
1302 return Flag100 (Implementation_Base_Type (Id));
1303 end Has_Specified_Layout;
1305 function Has_Specified_Stream_Input (Id : E) return B is
1306 begin
1307 pragma Assert (Is_Type (Id));
1308 return Flag190 (Id);
1309 end Has_Specified_Stream_Input;
1311 function Has_Specified_Stream_Output (Id : E) return B is
1312 begin
1313 pragma Assert (Is_Type (Id));
1314 return Flag191 (Id);
1315 end Has_Specified_Stream_Output;
1317 function Has_Specified_Stream_Read (Id : E) return B is
1318 begin
1319 pragma Assert (Is_Type (Id));
1320 return Flag192 (Id);
1321 end Has_Specified_Stream_Read;
1323 function Has_Specified_Stream_Write (Id : E) return B is
1324 begin
1325 pragma Assert (Is_Type (Id));
1326 return Flag193 (Id);
1327 end Has_Specified_Stream_Write;
1329 function Has_Storage_Size_Clause (Id : E) return B is
1330 begin
1331 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
1332 return Flag23 (Implementation_Base_Type (Id));
1333 end Has_Storage_Size_Clause;
1335 function Has_Stream_Size_Clause (Id : E) return B is
1336 begin
1337 pragma Assert (Is_Elementary_Type (Id));
1338 return Flag184 (Id);
1339 end Has_Stream_Size_Clause;
1341 function Has_Subprogram_Descriptor (Id : E) return B is
1342 begin
1343 return Flag93 (Id);
1344 end Has_Subprogram_Descriptor;
1346 function Has_Task (Id : E) return B is
1347 begin
1348 return Flag30 (Base_Type (Id));
1349 end Has_Task;
1351 function Has_Unchecked_Union (Id : E) return B is
1352 begin
1353 return Flag123 (Base_Type (Id));
1354 end Has_Unchecked_Union;
1356 function Has_Unknown_Discriminants (Id : E) return B is
1357 begin
1358 pragma Assert (Is_Type (Id));
1359 return Flag72 (Id);
1360 end Has_Unknown_Discriminants;
1362 function Has_Volatile_Components (Id : E) return B is
1363 begin
1364 return Flag87 (Implementation_Base_Type (Id));
1365 end Has_Volatile_Components;
1367 function Has_Xref_Entry (Id : E) return B is
1368 begin
1369 return Flag182 (Implementation_Base_Type (Id));
1370 end Has_Xref_Entry;
1372 function Hiding_Loop_Variable (Id : E) return E is
1373 begin
1374 pragma Assert (Ekind (Id) = E_Variable);
1375 return Node8 (Id);
1376 end Hiding_Loop_Variable;
1378 function Homonym (Id : E) return E is
1379 begin
1380 return Node4 (Id);
1381 end Homonym;
1383 function In_Package_Body (Id : E) return B is
1384 begin
1385 return Flag48 (Id);
1386 end In_Package_Body;
1388 function In_Private_Part (Id : E) return B is
1389 begin
1390 return Flag45 (Id);
1391 end In_Private_Part;
1393 function In_Use (Id : E) return B is
1394 begin
1395 pragma Assert (Nkind (Id) in N_Entity);
1396 return Flag8 (Id);
1397 end In_Use;
1399 function Inner_Instances (Id : E) return L is
1400 begin
1401 return Elist23 (Id);
1402 end Inner_Instances;
1404 function Interface_Name (Id : E) return N is
1405 begin
1406 return Node21 (Id);
1407 end Interface_Name;
1409 function Is_Abstract (Id : E) return B is
1410 begin
1411 return Flag19 (Id);
1412 end Is_Abstract;
1414 function Is_Local_Anonymous_Access (Id : E) return B is
1415 begin
1416 pragma Assert (Is_Access_Type (Id));
1417 return Flag194 (Id);
1418 end Is_Local_Anonymous_Access;
1420 function Is_Access_Constant (Id : E) return B is
1421 begin
1422 pragma Assert (Is_Access_Type (Id));
1423 return Flag69 (Id);
1424 end Is_Access_Constant;
1426 function Is_Ada_2005 (Id : E) return B is
1427 begin
1428 return Flag185 (Id);
1429 end Is_Ada_2005;
1431 function Is_Aliased (Id : E) return B is
1432 begin
1433 pragma Assert (Nkind (Id) in N_Entity);
1434 return Flag15 (Id);
1435 end Is_Aliased;
1437 function Is_AST_Entry (Id : E) return B is
1438 begin
1439 pragma Assert (Is_Entry (Id));
1440 return Flag132 (Id);
1441 end Is_AST_Entry;
1443 function Is_Asynchronous (Id : E) return B is
1444 begin
1445 pragma Assert
1446 (Ekind (Id) = E_Procedure or else Is_Type (Id));
1447 return Flag81 (Id);
1448 end Is_Asynchronous;
1450 function Is_Atomic (Id : E) return B is
1451 begin
1452 return Flag85 (Id);
1453 end Is_Atomic;
1455 function Is_Bit_Packed_Array (Id : E) return B is
1456 begin
1457 return Flag122 (Implementation_Base_Type (Id));
1458 end Is_Bit_Packed_Array;
1460 function Is_Called (Id : E) return B is
1461 begin
1462 pragma Assert
1463 (Ekind (Id) = E_Procedure or else Ekind (Id) = E_Function);
1464 return Flag102 (Id);
1465 end Is_Called;
1467 function Is_Character_Type (Id : E) return B is
1468 begin
1469 return Flag63 (Id);
1470 end Is_Character_Type;
1472 function Is_Child_Unit (Id : E) return B is
1473 begin
1474 return Flag73 (Id);
1475 end Is_Child_Unit;
1477 function Is_Class_Wide_Equivalent_Type (Id : E) return B is
1478 begin
1479 return Flag35 (Id);
1480 end Is_Class_Wide_Equivalent_Type;
1482 function Is_Compilation_Unit (Id : E) return B is
1483 begin
1484 return Flag149 (Id);
1485 end Is_Compilation_Unit;
1487 function Is_Completely_Hidden (Id : E) return B is
1488 begin
1489 pragma Assert (Ekind (Id) = E_Discriminant);
1490 return Flag103 (Id);
1491 end Is_Completely_Hidden;
1493 function Is_Constr_Subt_For_U_Nominal (Id : E) return B is
1494 begin
1495 return Flag80 (Id);
1496 end Is_Constr_Subt_For_U_Nominal;
1498 function Is_Constr_Subt_For_UN_Aliased (Id : E) return B is
1499 begin
1500 return Flag141 (Id);
1501 end Is_Constr_Subt_For_UN_Aliased;
1503 function Is_Constrained (Id : E) return B is
1504 begin
1505 pragma Assert (Nkind (Id) in N_Entity);
1506 return Flag12 (Id);
1507 end Is_Constrained;
1509 function Is_Constructor (Id : E) return B is
1510 begin
1511 return Flag76 (Id);
1512 end Is_Constructor;
1514 function Is_Controlled (Id : E) return B is
1515 begin
1516 return Flag42 (Base_Type (Id));
1517 end Is_Controlled;
1519 function Is_Controlling_Formal (Id : E) return B is
1520 begin
1521 pragma Assert (Is_Formal (Id));
1522 return Flag97 (Id);
1523 end Is_Controlling_Formal;
1525 function Is_CPP_Class (Id : E) return B is
1526 begin
1527 return Flag74 (Id);
1528 end Is_CPP_Class;
1530 function Is_Discrim_SO_Function (Id : E) return B is
1531 begin
1532 return Flag176 (Id);
1533 end Is_Discrim_SO_Function;
1535 function Is_Dispatching_Operation (Id : E) return B is
1536 begin
1537 pragma Assert (Nkind (Id) in N_Entity);
1538 return Flag6 (Id);
1539 end Is_Dispatching_Operation;
1541 function Is_Eliminated (Id : E) return B is
1542 begin
1543 return Flag124 (Id);
1544 end Is_Eliminated;
1546 function Is_Entry_Formal (Id : E) return B is
1547 begin
1548 return Flag52 (Id);
1549 end Is_Entry_Formal;
1551 function Is_Exported (Id : E) return B is
1552 begin
1553 return Flag99 (Id);
1554 end Is_Exported;
1556 function Is_First_Subtype (Id : E) return B is
1557 begin
1558 return Flag70 (Id);
1559 end Is_First_Subtype;
1561 function Is_For_Access_Subtype (Id : E) return B is
1562 begin
1563 pragma Assert
1564 (Ekind (Id) = E_Record_Subtype
1565 or else
1566 Ekind (Id) = E_Private_Subtype);
1567 return Flag118 (Id);
1568 end Is_For_Access_Subtype;
1570 function Is_Formal_Subprogram (Id : E) return B is
1571 begin
1572 return Flag111 (Id);
1573 end Is_Formal_Subprogram;
1575 function Is_Frozen (Id : E) return B is
1576 begin
1577 return Flag4 (Id);
1578 end Is_Frozen;
1580 function Is_Generic_Actual_Type (Id : E) return B is
1581 begin
1582 pragma Assert (Is_Type (Id));
1583 return Flag94 (Id);
1584 end Is_Generic_Actual_Type;
1586 function Is_Generic_Instance (Id : E) return B is
1587 begin
1588 return Flag130 (Id);
1589 end Is_Generic_Instance;
1591 function Is_Generic_Type (Id : E) return B is
1592 begin
1593 pragma Assert (Nkind (Id) in N_Entity);
1594 return Flag13 (Id);
1595 end Is_Generic_Type;
1597 function Is_Hidden (Id : E) return B is
1598 begin
1599 return Flag57 (Id);
1600 end Is_Hidden;
1602 function Is_Hidden_Open_Scope (Id : E) return B is
1603 begin
1604 return Flag171 (Id);
1605 end Is_Hidden_Open_Scope;
1607 function Is_Immediately_Visible (Id : E) return B is
1608 begin
1609 pragma Assert (Nkind (Id) in N_Entity);
1610 return Flag7 (Id);
1611 end Is_Immediately_Visible;
1613 function Is_Imported (Id : E) return B is
1614 begin
1615 return Flag24 (Id);
1616 end Is_Imported;
1618 function Is_Inlined (Id : E) return B is
1619 begin
1620 return Flag11 (Id);
1621 end Is_Inlined;
1623 function Is_Interface (Id : E) return B is
1624 begin
1625 return Flag186 (Id);
1626 end Is_Interface;
1628 function Is_Instantiated (Id : E) return B is
1629 begin
1630 return Flag126 (Id);
1631 end Is_Instantiated;
1633 function Is_Internal (Id : E) return B is
1634 begin
1635 pragma Assert (Nkind (Id) in N_Entity);
1636 return Flag17 (Id);
1637 end Is_Internal;
1639 function Is_Interrupt_Handler (Id : E) return B is
1640 begin
1641 pragma Assert (Nkind (Id) in N_Entity);
1642 return Flag89 (Id);
1643 end Is_Interrupt_Handler;
1645 function Is_Intrinsic_Subprogram (Id : E) return B is
1646 begin
1647 return Flag64 (Id);
1648 end Is_Intrinsic_Subprogram;
1650 function Is_Itype (Id : E) return B is
1651 begin
1652 return Flag91 (Id);
1653 end Is_Itype;
1655 function Is_Known_Non_Null (Id : E) return B is
1656 begin
1657 return Flag37 (Id);
1658 end Is_Known_Non_Null;
1660 function Is_Known_Valid (Id : E) return B is
1661 begin
1662 return Flag170 (Id);
1663 end Is_Known_Valid;
1665 function Is_Limited_Composite (Id : E) return B is
1666 begin
1667 return Flag106 (Id);
1668 end Is_Limited_Composite;
1670 function Is_Limited_Record (Id : E) return B is
1671 begin
1672 return Flag25 (Id);
1673 end Is_Limited_Record;
1675 function Is_Machine_Code_Subprogram (Id : E) return B is
1676 begin
1677 pragma Assert (Is_Subprogram (Id));
1678 return Flag137 (Id);
1679 end Is_Machine_Code_Subprogram;
1681 function Is_Non_Static_Subtype (Id : E) return B is
1682 begin
1683 pragma Assert (Is_Type (Id));
1684 return Flag109 (Id);
1685 end Is_Non_Static_Subtype;
1687 function Is_Null_Init_Proc (Id : E) return B is
1688 begin
1689 pragma Assert (Ekind (Id) = E_Procedure);
1690 return Flag178 (Id);
1691 end Is_Null_Init_Proc;
1693 function Is_Obsolescent (Id : E) return B is
1694 begin
1695 return Flag153 (Id);
1696 end Is_Obsolescent;
1698 function Is_Optional_Parameter (Id : E) return B is
1699 begin
1700 pragma Assert (Is_Formal (Id));
1701 return Flag134 (Id);
1702 end Is_Optional_Parameter;
1704 function Is_Overriding_Operation (Id : E) return B is
1705 begin
1706 pragma Assert (Is_Subprogram (Id));
1707 return Flag39 (Id);
1708 end Is_Overriding_Operation;
1710 function Is_Package_Body_Entity (Id : E) return B is
1711 begin
1712 return Flag160 (Id);
1713 end Is_Package_Body_Entity;
1715 function Is_Packed (Id : E) return B is
1716 begin
1717 return Flag51 (Implementation_Base_Type (Id));
1718 end Is_Packed;
1720 function Is_Packed_Array_Type (Id : E) return B is
1721 begin
1722 return Flag138 (Id);
1723 end Is_Packed_Array_Type;
1725 function Is_Potentially_Use_Visible (Id : E) return B is
1726 begin
1727 pragma Assert (Nkind (Id) in N_Entity);
1728 return Flag9 (Id);
1729 end Is_Potentially_Use_Visible;
1731 function Is_Preelaborated (Id : E) return B is
1732 begin
1733 return Flag59 (Id);
1734 end Is_Preelaborated;
1736 function Is_Primitive_Wrapper (Id : E) return B is
1737 begin
1738 pragma Assert (Ekind (Id) = E_Procedure);
1739 return Flag195 (Id);
1740 end Is_Primitive_Wrapper;
1742 function Is_Private_Composite (Id : E) return B is
1743 begin
1744 pragma Assert (Is_Type (Id));
1745 return Flag107 (Id);
1746 end Is_Private_Composite;
1748 function Is_Private_Descendant (Id : E) return B is
1749 begin
1750 return Flag53 (Id);
1751 end Is_Private_Descendant;
1753 function Is_Public (Id : E) return B is
1754 begin
1755 pragma Assert (Nkind (Id) in N_Entity);
1756 return Flag10 (Id);
1757 end Is_Public;
1759 function Is_Pure (Id : E) return B is
1760 begin
1761 return Flag44 (Id);
1762 end Is_Pure;
1764 function Is_Pure_Unit_Access_Type (Id : E) return B is
1765 begin
1766 pragma Assert (Is_Access_Type (Id));
1767 return Flag189 (Id);
1768 end Is_Pure_Unit_Access_Type;
1770 function Is_Remote_Call_Interface (Id : E) return B is
1771 begin
1772 return Flag62 (Id);
1773 end Is_Remote_Call_Interface;
1775 function Is_Remote_Types (Id : E) return B is
1776 begin
1777 return Flag61 (Id);
1778 end Is_Remote_Types;
1780 function Is_Renaming_Of_Object (Id : E) return B is
1781 begin
1782 return Flag112 (Id);
1783 end Is_Renaming_Of_Object;
1785 function Is_Shared_Passive (Id : E) return B is
1786 begin
1787 return Flag60 (Id);
1788 end Is_Shared_Passive;
1790 function Is_Statically_Allocated (Id : E) return B is
1791 begin
1792 return Flag28 (Id);
1793 end Is_Statically_Allocated;
1795 function Is_Tag (Id : E) return B is
1796 begin
1797 pragma Assert (Nkind (Id) in N_Entity);
1798 return Flag78 (Id);
1799 end Is_Tag;
1801 function Is_Tagged_Type (Id : E) return B is
1802 begin
1803 return Flag55 (Id);
1804 end Is_Tagged_Type;
1806 function Is_Thread_Body (Id : E) return B is
1807 begin
1808 return Flag77 (Id);
1809 end Is_Thread_Body;
1811 function Is_True_Constant (Id : E) return B is
1812 begin
1813 return Flag163 (Id);
1814 end Is_True_Constant;
1816 function Is_Unchecked_Union (Id : E) return B is
1817 begin
1818 return Flag117 (Id);
1819 end Is_Unchecked_Union;
1821 function Is_Unsigned_Type (Id : E) return B is
1822 begin
1823 pragma Assert (Is_Type (Id));
1824 return Flag144 (Id);
1825 end Is_Unsigned_Type;
1827 function Is_Valued_Procedure (Id : E) return B is
1828 begin
1829 pragma Assert (Ekind (Id) = E_Procedure);
1830 return Flag127 (Id);
1831 end Is_Valued_Procedure;
1833 function Is_Visible_Child_Unit (Id : E) return B is
1834 begin
1835 pragma Assert (Is_Child_Unit (Id));
1836 return Flag116 (Id);
1837 end Is_Visible_Child_Unit;
1839 function Is_VMS_Exception (Id : E) return B is
1840 begin
1841 return Flag133 (Id);
1842 end Is_VMS_Exception;
1844 function Is_Volatile (Id : E) return B is
1845 begin
1846 pragma Assert (Nkind (Id) in N_Entity);
1847 if Is_Type (Id) then
1848 return Flag16 (Base_Type (Id));
1849 else
1850 return Flag16 (Id);
1851 end if;
1852 end Is_Volatile;
1854 function Kill_Elaboration_Checks (Id : E) return B is
1855 begin
1856 return Flag32 (Id);
1857 end Kill_Elaboration_Checks;
1859 function Kill_Range_Checks (Id : E) return B is
1860 begin
1861 return Flag33 (Id);
1862 end Kill_Range_Checks;
1864 function Kill_Tag_Checks (Id : E) return B is
1865 begin
1866 return Flag34 (Id);
1867 end Kill_Tag_Checks;
1869 function Last_Entity (Id : E) return E is
1870 begin
1871 return Node20 (Id);
1872 end Last_Entity;
1874 function Limited_View (Id : E) return E is
1875 begin
1876 pragma Assert (Ekind (Id) = E_Package);
1877 return Node23 (Id);
1878 end Limited_View;
1880 function Lit_Indexes (Id : E) return E is
1881 begin
1882 pragma Assert (Is_Enumeration_Type (Id));
1883 return Node15 (Id);
1884 end Lit_Indexes;
1886 function Lit_Strings (Id : E) return E is
1887 begin
1888 pragma Assert (Is_Enumeration_Type (Id));
1889 return Node16 (Id);
1890 end Lit_Strings;
1892 function Machine_Radix_10 (Id : E) return B is
1893 begin
1894 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
1895 return Flag84 (Id);
1896 end Machine_Radix_10;
1898 function Master_Id (Id : E) return E is
1899 begin
1900 return Node17 (Id);
1901 end Master_Id;
1903 function Materialize_Entity (Id : E) return B is
1904 begin
1905 return Flag168 (Id);
1906 end Materialize_Entity;
1908 function Mechanism (Id : E) return M is
1909 begin
1910 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
1911 return UI_To_Int (Uint8 (Id));
1912 end Mechanism;
1914 function Modulus (Id : E) return Uint is
1915 begin
1916 pragma Assert (Is_Modular_Integer_Type (Id));
1917 return Uint17 (Base_Type (Id));
1918 end Modulus;
1920 function Must_Be_On_Byte_Boundary (Id : E) return B is
1921 begin
1922 pragma Assert (Is_Type (Id));
1923 return Flag183 (Id);
1924 end Must_Be_On_Byte_Boundary;
1926 function Needs_Debug_Info (Id : E) return B is
1927 begin
1928 return Flag147 (Id);
1929 end Needs_Debug_Info;
1931 function Needs_No_Actuals (Id : E) return B is
1932 begin
1933 pragma Assert
1934 (Is_Overloadable (Id)
1935 or else Ekind (Id) = E_Subprogram_Type
1936 or else Ekind (Id) = E_Entry_Family);
1937 return Flag22 (Id);
1938 end Needs_No_Actuals;
1940 function Never_Set_In_Source (Id : E) return B is
1941 begin
1942 return Flag115 (Id);
1943 end Never_Set_In_Source;
1945 function Next_Inlined_Subprogram (Id : E) return E is
1946 begin
1947 return Node12 (Id);
1948 end Next_Inlined_Subprogram;
1950 function No_Pool_Assigned (Id : E) return B is
1951 begin
1952 pragma Assert (Is_Access_Type (Id));
1953 return Flag131 (Root_Type (Id));
1954 end No_Pool_Assigned;
1956 function No_Return (Id : E) return B is
1957 begin
1958 pragma Assert
1959 (Id = Any_Id
1960 or else Ekind (Id) = E_Procedure
1961 or else Ekind (Id) = E_Generic_Procedure);
1962 return Flag113 (Id);
1963 end No_Return;
1965 function No_Strict_Aliasing (Id : E) return B is
1966 begin
1967 pragma Assert (Is_Access_Type (Id));
1968 return Flag136 (Base_Type (Id));
1969 end No_Strict_Aliasing;
1971 function Non_Binary_Modulus (Id : E) return B is
1972 begin
1973 pragma Assert (Is_Modular_Integer_Type (Id));
1974 return Flag58 (Base_Type (Id));
1975 end Non_Binary_Modulus;
1977 function Non_Limited_View (Id : E) return E is
1978 begin
1979 pragma Assert (False
1980 or else Ekind (Id) = E_Incomplete_Type);
1981 return Node17 (Id);
1982 end Non_Limited_View;
1984 function Nonzero_Is_True (Id : E) return B is
1985 begin
1986 pragma Assert (Root_Type (Id) = Standard_Boolean);
1987 return Flag162 (Base_Type (Id));
1988 end Nonzero_Is_True;
1990 function Normalized_First_Bit (Id : E) return U is
1991 begin
1992 pragma Assert
1993 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
1994 return Uint8 (Id);
1995 end Normalized_First_Bit;
1997 function Normalized_Position (Id : E) return U is
1998 begin
1999 pragma Assert
2000 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
2001 return Uint14 (Id);
2002 end Normalized_Position;
2004 function Normalized_Position_Max (Id : E) return U is
2005 begin
2006 pragma Assert
2007 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
2008 return Uint10 (Id);
2009 end Normalized_Position_Max;
2011 function Object_Ref (Id : E) return E is
2012 begin
2013 pragma Assert (Ekind (Id) = E_Protected_Body);
2014 return Node17 (Id);
2015 end Object_Ref;
2017 function Obsolescent_Warning (Id : E) return N is
2018 begin
2019 pragma Assert (Is_Subprogram (Id));
2020 return Node24 (Id);
2021 end Obsolescent_Warning;
2023 function Original_Access_Type (Id : E) return E is
2024 begin
2025 pragma Assert
2026 (Ekind (Id) = E_Access_Subprogram_Type
2027 or else Ekind (Id) = E_Access_Protected_Subprogram_Type);
2028 return Node21 (Id);
2029 end Original_Access_Type;
2031 function Original_Array_Type (Id : E) return E is
2032 begin
2033 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
2034 return Node21 (Id);
2035 end Original_Array_Type;
2037 function Original_Record_Component (Id : E) return E is
2038 begin
2039 pragma Assert
2040 (Ekind (Id) = E_Void
2041 or else Ekind (Id) = E_Component
2042 or else Ekind (Id) = E_Discriminant);
2043 return Node22 (Id);
2044 end Original_Record_Component;
2046 function Overridden_Operation (Id : E) return E is
2047 begin
2048 return Node26 (Id);
2049 end Overridden_Operation;
2051 function Packed_Array_Type (Id : E) return E is
2052 begin
2053 pragma Assert (Is_Array_Type (Id));
2054 return Node23 (Id);
2055 end Packed_Array_Type;
2057 function Parent_Subtype (Id : E) return E is
2058 begin
2059 pragma Assert (Ekind (Id) = E_Record_Type);
2060 return Node19 (Id);
2061 end Parent_Subtype;
2063 function Primitive_Operations (Id : E) return L is
2064 begin
2065 pragma Assert (Is_Tagged_Type (Id));
2066 return Elist15 (Id);
2067 end Primitive_Operations;
2069 function Prival (Id : E) return E is
2070 begin
2071 pragma Assert (Is_Protected_Private (Id));
2072 return Node17 (Id);
2073 end Prival;
2075 function Privals_Chain (Id : E) return L is
2076 begin
2077 pragma Assert (Is_Overloadable (Id)
2078 or else Ekind (Id) = E_Entry_Family);
2079 return Elist23 (Id);
2080 end Privals_Chain;
2082 function Private_Dependents (Id : E) return L is
2083 begin
2084 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
2085 return Elist18 (Id);
2086 end Private_Dependents;
2088 function Private_View (Id : E) return N is
2089 begin
2090 pragma Assert (Is_Private_Type (Id));
2091 return Node22 (Id);
2092 end Private_View;
2094 function Protected_Body_Subprogram (Id : E) return E is
2095 begin
2096 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
2097 return Node11 (Id);
2098 end Protected_Body_Subprogram;
2100 function Protected_Formal (Id : E) return E is
2101 begin
2102 pragma Assert (Is_Formal (Id));
2103 return Node22 (Id);
2104 end Protected_Formal;
2106 function Protected_Operation (Id : E) return N is
2107 begin
2108 pragma Assert (Is_Protected_Private (Id));
2109 return Node23 (Id);
2110 end Protected_Operation;
2112 function Reachable (Id : E) return B is
2113 begin
2114 return Flag49 (Id);
2115 end Reachable;
2117 function Referenced (Id : E) return B is
2118 begin
2119 return Flag156 (Id);
2120 end Referenced;
2122 function Referenced_As_LHS (Id : E) return B is
2123 begin
2124 return Flag36 (Id);
2125 end Referenced_As_LHS;
2127 function Referenced_Object (Id : E) return N is
2128 begin
2129 pragma Assert (Is_Type (Id));
2130 return Node10 (Id);
2131 end Referenced_Object;
2133 function Register_Exception_Call (Id : E) return N is
2134 begin
2135 pragma Assert (Ekind (Id) = E_Exception);
2136 return Node20 (Id);
2137 end Register_Exception_Call;
2139 function Related_Array_Object (Id : E) return E is
2140 begin
2141 pragma Assert (Is_Array_Type (Id));
2142 return Node19 (Id);
2143 end Related_Array_Object;
2145 function Related_Instance (Id : E) return E is
2146 begin
2147 pragma Assert
2148 (Ekind (Id) = E_Package or else Ekind (Id) = E_Package_Body);
2149 return Node15 (Id);
2150 end Related_Instance;
2152 function Renamed_Entity (Id : E) return N is
2153 begin
2154 return Node18 (Id);
2155 end Renamed_Entity;
2157 function Renamed_Object (Id : E) return N is
2158 begin
2159 return Node18 (Id);
2160 end Renamed_Object;
2162 function Renaming_Map (Id : E) return U is
2163 begin
2164 return Uint9 (Id);
2165 end Renaming_Map;
2167 function Return_Present (Id : E) return B is
2168 begin
2169 return Flag54 (Id);
2170 end Return_Present;
2172 function Returns_By_Ref (Id : E) return B is
2173 begin
2174 return Flag90 (Id);
2175 end Returns_By_Ref;
2177 function Reverse_Bit_Order (Id : E) return B is
2178 begin
2179 pragma Assert (Is_Record_Type (Id));
2180 return Flag164 (Base_Type (Id));
2181 end Reverse_Bit_Order;
2183 function RM_Size (Id : E) return U is
2184 begin
2185 pragma Assert (Is_Type (Id));
2186 return Uint13 (Id);
2187 end RM_Size;
2189 function Scalar_Range (Id : E) return N is
2190 begin
2191 return Node20 (Id);
2192 end Scalar_Range;
2194 function Scale_Value (Id : E) return U is
2195 begin
2196 return Uint15 (Id);
2197 end Scale_Value;
2199 function Scope_Depth_Value (Id : E) return U is
2200 begin
2201 return Uint22 (Id);
2202 end Scope_Depth_Value;
2204 function Sec_Stack_Needed_For_Return (Id : E) return B is
2205 begin
2206 return Flag167 (Id);
2207 end Sec_Stack_Needed_For_Return;
2209 function Shadow_Entities (Id : E) return S is
2210 begin
2211 pragma Assert
2212 (Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package);
2213 return List14 (Id);
2214 end Shadow_Entities;
2216 function Shared_Var_Assign_Proc (Id : E) return E is
2217 begin
2218 pragma Assert (Ekind (Id) = E_Variable);
2219 return Node22 (Id);
2220 end Shared_Var_Assign_Proc;
2222 function Shared_Var_Read_Proc (Id : E) return E is
2223 begin
2224 pragma Assert (Ekind (Id) = E_Variable);
2225 return Node15 (Id);
2226 end Shared_Var_Read_Proc;
2228 function Size_Check_Code (Id : E) return N is
2229 begin
2230 pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable);
2231 return Node19 (Id);
2232 end Size_Check_Code;
2234 function Size_Depends_On_Discriminant (Id : E) return B is
2235 begin
2236 return Flag177 (Id);
2237 end Size_Depends_On_Discriminant;
2239 function Size_Known_At_Compile_Time (Id : E) return B is
2240 begin
2241 return Flag92 (Id);
2242 end Size_Known_At_Compile_Time;
2244 function Small_Value (Id : E) return R is
2245 begin
2246 pragma Assert (Is_Fixed_Point_Type (Id));
2247 return Ureal21 (Id);
2248 end Small_Value;
2250 function Spec_Entity (Id : E) return E is
2251 begin
2252 pragma Assert
2253 (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
2254 return Node19 (Id);
2255 end Spec_Entity;
2257 function Storage_Size_Variable (Id : E) return E is
2258 begin
2259 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
2260 return Node15 (Implementation_Base_Type (Id));
2261 end Storage_Size_Variable;
2263 function Stored_Constraint (Id : E) return L is
2264 begin
2265 pragma Assert
2266 (Is_Composite_Type (Id) and then not Is_Array_Type (Id));
2267 return Elist23 (Id);
2268 end Stored_Constraint;
2270 function Strict_Alignment (Id : E) return B is
2271 begin
2272 return Flag145 (Implementation_Base_Type (Id));
2273 end Strict_Alignment;
2275 function String_Literal_Length (Id : E) return U is
2276 begin
2277 return Uint16 (Id);
2278 end String_Literal_Length;
2280 function String_Literal_Low_Bound (Id : E) return N is
2281 begin
2282 return Node15 (Id);
2283 end String_Literal_Low_Bound;
2285 function Suppress_Elaboration_Warnings (Id : E) return B is
2286 begin
2287 return Flag148 (Id);
2288 end Suppress_Elaboration_Warnings;
2290 function Suppress_Init_Proc (Id : E) return B is
2291 begin
2292 return Flag105 (Base_Type (Id));
2293 end Suppress_Init_Proc;
2295 function Suppress_Style_Checks (Id : E) return B is
2296 begin
2297 return Flag165 (Id);
2298 end Suppress_Style_Checks;
2300 function Task_Body_Procedure (Id : E) return N is
2301 begin
2302 pragma Assert (Ekind (Id) = E_Task_Type
2303 or else Ekind (Id) = E_Task_Subtype);
2304 return Node24 (Id);
2305 end Task_Body_Procedure;
2307 function Treat_As_Volatile (Id : E) return B is
2308 begin
2309 return Flag41 (Id);
2310 end Treat_As_Volatile;
2312 function Underlying_Full_View (Id : E) return E is
2313 begin
2314 pragma Assert (Ekind (Id) in Private_Kind);
2315 return Node19 (Id);
2316 end Underlying_Full_View;
2318 function Unset_Reference (Id : E) return N is
2319 begin
2320 return Node16 (Id);
2321 end Unset_Reference;
2323 function Uses_Sec_Stack (Id : E) return B is
2324 begin
2325 return Flag95 (Id);
2326 end Uses_Sec_Stack;
2328 function Vax_Float (Id : E) return B is
2329 begin
2330 return Flag151 (Base_Type (Id));
2331 end Vax_Float;
2333 function Warnings_Off (Id : E) return B is
2334 begin
2335 return Flag96 (Id);
2336 end Warnings_Off;
2338 function Wrapped_Entity (Id : E) return E is
2339 begin
2340 pragma Assert (Ekind (Id) = E_Procedure
2341 and then Is_Primitive_Wrapper (Id));
2342 return Node27 (Id);
2343 end Wrapped_Entity;
2345 function Was_Hidden (Id : E) return B is
2346 begin
2347 return Flag196 (Id);
2348 end Was_Hidden;
2350 ------------------------------
2351 -- Classification Functions --
2352 ------------------------------
2354 function Is_Access_Type (Id : E) return B is
2355 begin
2356 return Ekind (Id) in Access_Kind;
2357 end Is_Access_Type;
2359 function Is_Array_Type (Id : E) return B is
2360 begin
2361 return Ekind (Id) in Array_Kind;
2362 end Is_Array_Type;
2364 function Is_Class_Wide_Type (Id : E) return B is
2365 begin
2366 return Ekind (Id) in Class_Wide_Kind;
2367 end Is_Class_Wide_Type;
2369 function Is_Composite_Type (Id : E) return B is
2370 begin
2371 return Ekind (Id) in Composite_Kind;
2372 end Is_Composite_Type;
2374 function Is_Concurrent_Body (Id : E) return B is
2375 begin
2376 return Ekind (Id) in
2377 Concurrent_Body_Kind;
2378 end Is_Concurrent_Body;
2380 function Is_Concurrent_Record_Type (Id : E) return B is
2381 begin
2382 return Flag20 (Id);
2383 end Is_Concurrent_Record_Type;
2385 function Is_Concurrent_Type (Id : E) return B is
2386 begin
2387 return Ekind (Id) in Concurrent_Kind;
2388 end Is_Concurrent_Type;
2390 function Is_Decimal_Fixed_Point_Type (Id : E) return B is
2391 begin
2392 return Ekind (Id) in
2393 Decimal_Fixed_Point_Kind;
2394 end Is_Decimal_Fixed_Point_Type;
2396 function Is_Digits_Type (Id : E) return B is
2397 begin
2398 return Ekind (Id) in Digits_Kind;
2399 end Is_Digits_Type;
2401 function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B is
2402 begin
2403 return Ekind (Id) in Discrete_Or_Fixed_Point_Kind;
2404 end Is_Discrete_Or_Fixed_Point_Type;
2406 function Is_Discrete_Type (Id : E) return B is
2407 begin
2408 return Ekind (Id) in Discrete_Kind;
2409 end Is_Discrete_Type;
2411 function Is_Elementary_Type (Id : E) return B is
2412 begin
2413 return Ekind (Id) in Elementary_Kind;
2414 end Is_Elementary_Type;
2416 function Is_Entry (Id : E) return B is
2417 begin
2418 return Ekind (Id) in Entry_Kind;
2419 end Is_Entry;
2421 function Is_Enumeration_Type (Id : E) return B is
2422 begin
2423 return Ekind (Id) in
2424 Enumeration_Kind;
2425 end Is_Enumeration_Type;
2427 function Is_Fixed_Point_Type (Id : E) return B is
2428 begin
2429 return Ekind (Id) in
2430 Fixed_Point_Kind;
2431 end Is_Fixed_Point_Type;
2433 function Is_Floating_Point_Type (Id : E) return B is
2434 begin
2435 return Ekind (Id) in Float_Kind;
2436 end Is_Floating_Point_Type;
2438 function Is_Formal (Id : E) return B is
2439 begin
2440 return Ekind (Id) in Formal_Kind;
2441 end Is_Formal;
2443 function Is_Generic_Subprogram (Id : E) return B is
2444 begin
2445 return Ekind (Id) in Generic_Subprogram_Kind;
2446 end Is_Generic_Subprogram;
2448 function Is_Generic_Unit (Id : E) return B is
2449 begin
2450 return Ekind (Id) in Generic_Unit_Kind;
2451 end Is_Generic_Unit;
2453 function Is_Incomplete_Or_Private_Type (Id : E) return B is
2454 begin
2455 return Ekind (Id) in
2456 Incomplete_Or_Private_Kind;
2457 end Is_Incomplete_Or_Private_Type;
2459 function Is_Integer_Type (Id : E) return B is
2460 begin
2461 return Ekind (Id) in Integer_Kind;
2462 end Is_Integer_Type;
2464 function Is_Modular_Integer_Type (Id : E) return B is
2465 begin
2466 return Ekind (Id) in
2467 Modular_Integer_Kind;
2468 end Is_Modular_Integer_Type;
2470 function Is_Named_Number (Id : E) return B is
2471 begin
2472 return Ekind (Id) in Named_Kind;
2473 end Is_Named_Number;
2475 function Is_Numeric_Type (Id : E) return B is
2476 begin
2477 return Ekind (Id) in Numeric_Kind;
2478 end Is_Numeric_Type;
2480 function Is_Object (Id : E) return B is
2481 begin
2482 return Ekind (Id) in Object_Kind;
2483 end Is_Object;
2485 function Is_Ordinary_Fixed_Point_Type (Id : E) return B is
2486 begin
2487 return Ekind (Id) in
2488 Ordinary_Fixed_Point_Kind;
2489 end Is_Ordinary_Fixed_Point_Type;
2491 function Is_Overloadable (Id : E) return B is
2492 begin
2493 return Ekind (Id) in Overloadable_Kind;
2494 end Is_Overloadable;
2496 function Is_Private_Type (Id : E) return B is
2497 begin
2498 return Ekind (Id) in Private_Kind;
2499 end Is_Private_Type;
2501 function Is_Protected_Type (Id : E) return B is
2502 begin
2503 return Ekind (Id) in Protected_Kind;
2504 end Is_Protected_Type;
2506 function Is_Real_Type (Id : E) return B is
2507 begin
2508 return Ekind (Id) in Real_Kind;
2509 end Is_Real_Type;
2511 function Is_Record_Type (Id : E) return B is
2512 begin
2513 return Ekind (Id) in Record_Kind;
2514 end Is_Record_Type;
2516 function Is_Scalar_Type (Id : E) return B is
2517 begin
2518 return Ekind (Id) in Scalar_Kind;
2519 end Is_Scalar_Type;
2521 function Is_Signed_Integer_Type (Id : E) return B is
2522 begin
2523 return Ekind (Id) in
2524 Signed_Integer_Kind;
2525 end Is_Signed_Integer_Type;
2527 function Is_Subprogram (Id : E) return B is
2528 begin
2529 return Ekind (Id) in Subprogram_Kind;
2530 end Is_Subprogram;
2532 function Is_Task_Type (Id : E) return B is
2533 begin
2534 return Ekind (Id) in Task_Kind;
2535 end Is_Task_Type;
2537 function Is_Type (Id : E) return B is
2538 begin
2539 return Ekind (Id) in Type_Kind;
2540 end Is_Type;
2542 ------------------------------
2543 -- Attribute Set Procedures --
2544 ------------------------------
2546 procedure Set_Abstract_Interfaces (Id : E; V : L) is
2547 begin
2548 pragma Assert
2549 (Ekind (Id) = E_Record_Type
2550 or else Ekind (Id) = E_Record_Subtype
2551 or else Ekind (Id) = E_Record_Type_With_Private
2552 or else Ekind (Id) = E_Record_Subtype_With_Private
2553 or else Ekind (Id) = E_Class_Wide_Type);
2554 Set_Elist24 (Id, V);
2555 end Set_Abstract_Interfaces;
2557 procedure Set_Abstract_Interface_Alias (Id : E; V : E) is
2558 begin
2559 pragma Assert
2560 (Ekind (Id) = E_Procedure or Ekind (Id) = E_Function);
2561 Set_Node25 (Id, V);
2562 end Set_Abstract_Interface_Alias;
2564 procedure Set_Accept_Address (Id : E; V : L) is
2565 begin
2566 Set_Elist21 (Id, V);
2567 end Set_Accept_Address;
2569 procedure Set_Access_Disp_Table (Id : E; V : L) is
2570 begin
2571 pragma Assert (Is_Tagged_Type (Id) and then Id = Base_Type (Id));
2572 Set_Elist16 (Id, V);
2573 end Set_Access_Disp_Table;
2575 procedure Set_Associated_Final_Chain (Id : E; V : E) is
2576 begin
2577 pragma Assert (Is_Access_Type (Id));
2578 Set_Node23 (Id, V);
2579 end Set_Associated_Final_Chain;
2581 procedure Set_Associated_Formal_Package (Id : E; V : E) is
2582 begin
2583 Set_Node12 (Id, V);
2584 end Set_Associated_Formal_Package;
2586 procedure Set_Associated_Node_For_Itype (Id : E; V : E) is
2587 begin
2588 Set_Node8 (Id, V);
2589 end Set_Associated_Node_For_Itype;
2591 procedure Set_Associated_Storage_Pool (Id : E; V : E) is
2592 begin
2593 pragma Assert (Is_Access_Type (Id) and then Id = Base_Type (Id));
2594 Set_Node22 (Id, V);
2595 end Set_Associated_Storage_Pool;
2597 procedure Set_Actual_Subtype (Id : E; V : E) is
2598 begin
2599 pragma Assert
2600 (Ekind (Id) = E_Constant
2601 or else Ekind (Id) = E_Variable
2602 or else Ekind (Id) = E_Generic_In_Out_Parameter
2603 or else Ekind (Id) in E_In_Parameter .. E_In_Out_Parameter);
2604 Set_Node17 (Id, V);
2605 end Set_Actual_Subtype;
2607 procedure Set_Address_Taken (Id : E; V : B := True) is
2608 begin
2609 Set_Flag104 (Id, V);
2610 end Set_Address_Taken;
2612 procedure Set_Alias (Id : E; V : E) is
2613 begin
2614 pragma Assert
2615 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
2616 Set_Node18 (Id, V);
2617 end Set_Alias;
2619 procedure Set_Alignment (Id : E; V : U) is
2620 begin
2621 pragma Assert (Is_Type (Id)
2622 or else Is_Formal (Id)
2623 or else Ekind (Id) = E_Loop_Parameter
2624 or else Ekind (Id) = E_Constant
2625 or else Ekind (Id) = E_Exception
2626 or else Ekind (Id) = E_Variable);
2627 Set_Uint14 (Id, V);
2628 end Set_Alignment;
2630 procedure Set_Barrier_Function (Id : E; V : N) is
2631 begin
2632 pragma Assert (Is_Entry (Id));
2633 Set_Node12 (Id, V);
2634 end Set_Barrier_Function;
2636 procedure Set_Block_Node (Id : E; V : N) is
2637 begin
2638 pragma Assert (Ekind (Id) = E_Block);
2639 Set_Node11 (Id, V);
2640 end Set_Block_Node;
2642 procedure Set_Body_Entity (Id : E; V : E) is
2643 begin
2644 pragma Assert
2645 (Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package);
2646 Set_Node19 (Id, V);
2647 end Set_Body_Entity;
2649 procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is
2650 begin
2651 pragma Assert
2652 (Ekind (Id) = E_Package
2653 or else Is_Subprogram (Id)
2654 or else Is_Generic_Unit (Id));
2655 Set_Flag40 (Id, V);
2656 end Set_Body_Needed_For_SAL;
2658 procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is
2659 begin
2660 pragma Assert (Is_Record_Type (Id) and then Id = Base_Type (Id));
2661 Set_Flag125 (Id, V);
2662 end Set_C_Pass_By_Copy;
2664 procedure Set_Can_Never_Be_Null (Id : E; V : B := True) is
2665 begin
2666 Set_Flag38 (Id, V);
2667 end Set_Can_Never_Be_Null;
2669 procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is
2670 begin
2671 Set_Flag31 (Id, V);
2672 end Set_Checks_May_Be_Suppressed;
2674 procedure Set_Class_Wide_Type (Id : E; V : E) is
2675 begin
2676 pragma Assert (Is_Type (Id));
2677 Set_Node9 (Id, V);
2678 end Set_Class_Wide_Type;
2680 procedure Set_Cloned_Subtype (Id : E; V : E) is
2681 begin
2682 pragma Assert
2683 (Ekind (Id) = E_Record_Subtype
2684 or else Ekind (Id) = E_Class_Wide_Subtype);
2685 Set_Node16 (Id, V);
2686 end Set_Cloned_Subtype;
2688 procedure Set_Component_Bit_Offset (Id : E; V : U) is
2689 begin
2690 pragma Assert
2691 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
2692 Set_Uint11 (Id, V);
2693 end Set_Component_Bit_Offset;
2695 procedure Set_Component_Clause (Id : E; V : N) is
2696 begin
2697 pragma Assert
2698 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
2699 Set_Node13 (Id, V);
2700 end Set_Component_Clause;
2702 procedure Set_Component_Size (Id : E; V : U) is
2703 begin
2704 pragma Assert (Is_Array_Type (Id) and then Id = Base_Type (Id));
2705 Set_Uint22 (Id, V);
2706 end Set_Component_Size;
2708 procedure Set_Component_Type (Id : E; V : E) is
2709 begin
2710 pragma Assert (Is_Array_Type (Id) and then Id = Base_Type (Id));
2711 Set_Node20 (Id, V);
2712 end Set_Component_Type;
2714 procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is
2715 begin
2716 pragma Assert
2717 (Ekind (Id) = E_Record_Type and then Is_Concurrent_Type (V));
2718 Set_Node18 (Id, V);
2719 end Set_Corresponding_Concurrent_Type;
2721 procedure Set_Corresponding_Discriminant (Id : E; V : E) is
2722 begin
2723 pragma Assert (Ekind (Id) = E_Discriminant);
2724 Set_Node19 (Id, V);
2725 end Set_Corresponding_Discriminant;
2727 procedure Set_Corresponding_Equality (Id : E; V : E) is
2728 begin
2729 pragma Assert
2730 (Ekind (Id) = E_Function
2731 and then not Comes_From_Source (Id)
2732 and then Chars (Id) = Name_Op_Ne);
2733 Set_Node13 (Id, V);
2734 end Set_Corresponding_Equality;
2736 procedure Set_Corresponding_Record_Type (Id : E; V : E) is
2737 begin
2738 pragma Assert (Is_Concurrent_Type (Id));
2739 Set_Node18 (Id, V);
2740 end Set_Corresponding_Record_Type;
2742 procedure Set_Corresponding_Remote_Type (Id : E; V : E) is
2743 begin
2744 Set_Node22 (Id, V);
2745 end Set_Corresponding_Remote_Type;
2747 procedure Set_Current_Value (Id : E; V : E) is
2748 begin
2749 pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
2750 Set_Node9 (Id, V);
2751 end Set_Current_Value;
2753 procedure Set_CR_Discriminant (Id : E; V : E) is
2754 begin
2755 Set_Node23 (Id, V);
2756 end Set_CR_Discriminant;
2758 procedure Set_Debug_Info_Off (Id : E; V : B := True) is
2759 begin
2760 Set_Flag166 (Id, V);
2761 end Set_Debug_Info_Off;
2763 procedure Set_Debug_Renaming_Link (Id : E; V : E) is
2764 begin
2765 Set_Node13 (Id, V);
2766 end Set_Debug_Renaming_Link;
2768 procedure Set_Default_Expr_Function (Id : E; V : E) is
2769 begin
2770 pragma Assert (Is_Formal (Id));
2771 Set_Node21 (Id, V);
2772 end Set_Default_Expr_Function;
2774 procedure Set_Default_Expressions_Processed (Id : E; V : B := True) is
2775 begin
2776 Set_Flag108 (Id, V);
2777 end Set_Default_Expressions_Processed;
2779 procedure Set_Default_Value (Id : E; V : N) is
2780 begin
2781 pragma Assert (Is_Formal (Id));
2782 Set_Node20 (Id, V);
2783 end Set_Default_Value;
2785 procedure Set_Delay_Cleanups (Id : E; V : B := True) is
2786 begin
2787 pragma Assert
2788 (Is_Subprogram (Id)
2789 or else Is_Task_Type (Id)
2790 or else Ekind (Id) = E_Block);
2791 Set_Flag114 (Id, V);
2792 end Set_Delay_Cleanups;
2794 procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is
2795 begin
2796 pragma Assert
2797 (Is_Subprogram (Id)
2798 or else Ekind (Id) = E_Package
2799 or else Ekind (Id) = E_Package_Body);
2800 Set_Flag50 (Id, V);
2801 end Set_Delay_Subprogram_Descriptors;
2803 procedure Set_Delta_Value (Id : E; V : R) is
2804 begin
2805 pragma Assert (Is_Fixed_Point_Type (Id));
2806 Set_Ureal18 (Id, V);
2807 end Set_Delta_Value;
2809 procedure Set_Dependent_Instances (Id : E; V : L) is
2810 begin
2811 pragma Assert (Is_Generic_Instance (Id));
2812 Set_Elist8 (Id, V);
2813 end Set_Dependent_Instances;
2815 procedure Set_Depends_On_Private (Id : E; V : B := True) is
2816 begin
2817 pragma Assert (Nkind (Id) in N_Entity);
2818 Set_Flag14 (Id, V);
2819 end Set_Depends_On_Private;
2821 procedure Set_Digits_Value (Id : E; V : U) is
2822 begin
2823 pragma Assert
2824 (Is_Floating_Point_Type (Id)
2825 or else Is_Decimal_Fixed_Point_Type (Id));
2826 Set_Uint17 (Id, V);
2827 end Set_Digits_Value;
2829 procedure Set_Directly_Designated_Type (Id : E; V : E) is
2830 begin
2831 Set_Node20 (Id, V);
2832 end Set_Directly_Designated_Type;
2834 procedure Set_Discard_Names (Id : E; V : B := True) is
2835 begin
2836 Set_Flag88 (Id, V);
2837 end Set_Discard_Names;
2839 procedure Set_Discriminal (Id : E; V : E) is
2840 begin
2841 pragma Assert (Ekind (Id) = E_Discriminant);
2842 Set_Node17 (Id, V);
2843 end Set_Discriminal;
2845 procedure Set_Discriminal_Link (Id : E; V : E) is
2846 begin
2847 Set_Node10 (Id, V);
2848 end Set_Discriminal_Link;
2850 procedure Set_Discriminant_Checking_Func (Id : E; V : E) is
2851 begin
2852 pragma Assert (Ekind (Id) = E_Component);
2853 Set_Node20 (Id, V);
2854 end Set_Discriminant_Checking_Func;
2856 procedure Set_Discriminant_Constraint (Id : E; V : L) is
2857 begin
2858 pragma Assert (Nkind (Id) in N_Entity);
2859 Set_Elist21 (Id, V);
2860 end Set_Discriminant_Constraint;
2862 procedure Set_Discriminant_Default_Value (Id : E; V : N) is
2863 begin
2864 Set_Node20 (Id, V);
2865 end Set_Discriminant_Default_Value;
2867 procedure Set_Discriminant_Number (Id : E; V : U) is
2868 begin
2869 Set_Uint15 (Id, V);
2870 end Set_Discriminant_Number;
2872 procedure Set_DT_Entry_Count (Id : E; V : U) is
2873 begin
2874 pragma Assert (Ekind (Id) = E_Component);
2875 Set_Uint15 (Id, V);
2876 end Set_DT_Entry_Count;
2878 procedure Set_DT_Position (Id : E; V : U) is
2879 begin
2880 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2881 Set_Uint15 (Id, V);
2882 end Set_DT_Position;
2884 procedure Set_DTC_Entity (Id : E; V : E) is
2885 begin
2886 pragma Assert
2887 (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2888 Set_Node16 (Id, V);
2889 end Set_DTC_Entity;
2891 procedure Set_Elaborate_All_Desirable (Id : E; V : B := True) is
2892 begin
2893 Set_Flag146 (Id, V);
2894 end Set_Elaborate_All_Desirable;
2896 procedure Set_Elaboration_Entity (Id : E; V : E) is
2897 begin
2898 pragma Assert
2899 (Is_Subprogram (Id)
2900 or else
2901 Ekind (Id) = E_Package
2902 or else
2903 Is_Generic_Unit (Id));
2904 Set_Node13 (Id, V);
2905 end Set_Elaboration_Entity;
2907 procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is
2908 begin
2909 pragma Assert
2910 (Is_Subprogram (Id)
2911 or else
2912 Ekind (Id) = E_Package
2913 or else
2914 Is_Generic_Unit (Id));
2915 Set_Flag174 (Id, V);
2916 end Set_Elaboration_Entity_Required;
2918 procedure Set_Enclosing_Scope (Id : E; V : E) is
2919 begin
2920 Set_Node18 (Id, V);
2921 end Set_Enclosing_Scope;
2923 procedure Set_Entry_Accepted (Id : E; V : B := True) is
2924 begin
2925 pragma Assert (Is_Entry (Id));
2926 Set_Flag152 (Id, V);
2927 end Set_Entry_Accepted;
2929 procedure Set_Entry_Bodies_Array (Id : E; V : E) is
2930 begin
2931 Set_Node15 (Id, V);
2932 end Set_Entry_Bodies_Array;
2934 procedure Set_Entry_Cancel_Parameter (Id : E; V : E) is
2935 begin
2936 Set_Node23 (Id, V);
2937 end Set_Entry_Cancel_Parameter;
2939 procedure Set_Entry_Component (Id : E; V : E) is
2940 begin
2941 Set_Node11 (Id, V);
2942 end Set_Entry_Component;
2944 procedure Set_Entry_Formal (Id : E; V : E) is
2945 begin
2946 Set_Node16 (Id, V);
2947 end Set_Entry_Formal;
2949 procedure Set_Entry_Index_Constant (Id : E; V : E) is
2950 begin
2951 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
2952 Set_Node18 (Id, V);
2953 end Set_Entry_Index_Constant;
2955 procedure Set_Entry_Parameters_Type (Id : E; V : E) is
2956 begin
2957 Set_Node15 (Id, V);
2958 end Set_Entry_Parameters_Type;
2960 procedure Set_Enum_Pos_To_Rep (Id : E; V : E) is
2961 begin
2962 pragma Assert (Ekind (Id) = E_Enumeration_Type);
2963 Set_Node23 (Id, V);
2964 end Set_Enum_Pos_To_Rep;
2966 procedure Set_Enumeration_Pos (Id : E; V : U) is
2967 begin
2968 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
2969 Set_Uint11 (Id, V);
2970 end Set_Enumeration_Pos;
2972 procedure Set_Enumeration_Rep (Id : E; V : U) is
2973 begin
2974 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
2975 Set_Uint12 (Id, V);
2976 end Set_Enumeration_Rep;
2978 procedure Set_Enumeration_Rep_Expr (Id : E; V : N) is
2979 begin
2980 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
2981 Set_Node22 (Id, V);
2982 end Set_Enumeration_Rep_Expr;
2984 procedure Set_Equivalent_Type (Id : E; V : E) is
2985 begin
2986 pragma Assert
2987 (Ekind (Id) = E_Class_Wide_Type or else
2988 Ekind (Id) = E_Class_Wide_Subtype or else
2989 Ekind (Id) = E_Access_Protected_Subprogram_Type or else
2990 Ekind (Id) = E_Access_Subprogram_Type or else
2991 Ekind (Id) = E_Exception_Type);
2992 Set_Node18 (Id, V);
2993 end Set_Equivalent_Type;
2995 procedure Set_Esize (Id : E; V : U) is
2996 begin
2997 Set_Uint12 (Id, V);
2998 end Set_Esize;
3000 procedure Set_Exception_Code (Id : E; V : U) is
3001 begin
3002 pragma Assert (Ekind (Id) = E_Exception);
3003 Set_Uint22 (Id, V);
3004 end Set_Exception_Code;
3006 procedure Set_Extra_Accessibility (Id : E; V : E) is
3007 begin
3008 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
3009 Set_Node13 (Id, V);
3010 end Set_Extra_Accessibility;
3012 procedure Set_Extra_Constrained (Id : E; V : E) is
3013 begin
3014 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
3015 Set_Node23 (Id, V);
3016 end Set_Extra_Constrained;
3018 procedure Set_Extra_Formal (Id : E; V : E) is
3019 begin
3020 Set_Node15 (Id, V);
3021 end Set_Extra_Formal;
3023 procedure Set_Finalization_Chain_Entity (Id : E; V : E) is
3024 begin
3025 Set_Node19 (Id, V);
3026 end Set_Finalization_Chain_Entity;
3028 procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is
3029 begin
3030 pragma Assert (Is_Type (Id) and then Id = Base_Type (Id));
3031 Set_Flag158 (Id, V);
3032 end Set_Finalize_Storage_Only;
3034 procedure Set_First_Entity (Id : E; V : E) is
3035 begin
3036 Set_Node17 (Id, V);
3037 end Set_First_Entity;
3039 procedure Set_First_Index (Id : E; V : N) is
3040 begin
3041 Set_Node17 (Id, V);
3042 end Set_First_Index;
3044 procedure Set_First_Literal (Id : E; V : E) is
3045 begin
3046 Set_Node17 (Id, V);
3047 end Set_First_Literal;
3049 procedure Set_First_Optional_Parameter (Id : E; V : E) is
3050 begin
3051 pragma Assert
3052 (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
3053 Set_Node14 (Id, V);
3054 end Set_First_Optional_Parameter;
3056 procedure Set_First_Private_Entity (Id : E; V : E) is
3057 begin
3058 pragma Assert (Ekind (Id) = E_Package
3059 or else Ekind (Id) = E_Generic_Package
3060 or else Ekind (Id) = E_Protected_Type
3061 or else Ekind (Id) = E_Protected_Subtype
3062 or else Ekind (Id) = E_Task_Type
3063 or else Ekind (Id) = E_Task_Subtype);
3064 Set_Node16 (Id, V);
3065 end Set_First_Private_Entity;
3067 procedure Set_First_Rep_Item (Id : E; V : N) is
3068 begin
3069 Set_Node6 (Id, V);
3070 end Set_First_Rep_Item;
3072 procedure Set_Freeze_Node (Id : E; V : N) is
3073 begin
3074 Set_Node7 (Id, V);
3075 end Set_Freeze_Node;
3077 procedure Set_From_With_Type (Id : E; V : B := True) is
3078 begin
3079 pragma Assert
3080 (Is_Type (Id)
3081 or else Ekind (Id) = E_Package);
3082 Set_Flag159 (Id, V);
3083 end Set_From_With_Type;
3085 procedure Set_Full_View (Id : E; V : E) is
3086 begin
3087 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
3088 Set_Node11 (Id, V);
3089 end Set_Full_View;
3091 procedure Set_Function_Returns_With_DSP (Id : E; V : B := True) is
3092 begin
3093 pragma Assert
3094 (Is_Subprogram (Id) or else Ekind (Id) = E_Subprogram_Type);
3095 Set_Flag169 (Id, V);
3096 end Set_Function_Returns_With_DSP;
3098 procedure Set_Generic_Homonym (Id : E; V : E) is
3099 begin
3100 Set_Node11 (Id, V);
3101 end Set_Generic_Homonym;
3103 procedure Set_Generic_Renamings (Id : E; V : L) is
3104 begin
3105 Set_Elist23 (Id, V);
3106 end Set_Generic_Renamings;
3108 procedure Set_Handler_Records (Id : E; V : S) is
3109 begin
3110 Set_List10 (Id, V);
3111 end Set_Handler_Records;
3113 procedure Set_Has_Aliased_Components (Id : E; V : B := True) is
3114 begin
3115 pragma Assert (Base_Type (Id) = Id);
3116 Set_Flag135 (Id, V);
3117 end Set_Has_Aliased_Components;
3119 procedure Set_Has_Alignment_Clause (Id : E; V : B := True) is
3120 begin
3121 Set_Flag46 (Id, V);
3122 end Set_Has_Alignment_Clause;
3124 procedure Set_Has_All_Calls_Remote (Id : E; V : B := True) is
3125 begin
3126 Set_Flag79 (Id, V);
3127 end Set_Has_All_Calls_Remote;
3129 procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
3130 begin
3131 pragma Assert (not Is_Type (Id) or else Base_Type (Id) = Id);
3132 Set_Flag86 (Id, V);
3133 end Set_Has_Atomic_Components;
3135 procedure Set_Has_Biased_Representation (Id : E; V : B := True) is
3136 begin
3137 pragma Assert
3138 ((V = False) or else (Is_Discrete_Type (Id) or Is_Object (Id)));
3139 Set_Flag139 (Id, V);
3140 end Set_Has_Biased_Representation;
3142 procedure Set_Has_Completion (Id : E; V : B := True) is
3143 begin
3144 Set_Flag26 (Id, V);
3145 end Set_Has_Completion;
3147 procedure Set_Has_Completion_In_Body (Id : E; V : B := True) is
3148 begin
3149 pragma Assert (Ekind (Id) = E_Incomplete_Type);
3150 Set_Flag71 (Id, V);
3151 end Set_Has_Completion_In_Body;
3153 procedure Set_Has_Complex_Representation (Id : E; V : B := True) is
3154 begin
3155 pragma Assert (Ekind (Id) = E_Record_Type);
3156 Set_Flag140 (Id, V);
3157 end Set_Has_Complex_Representation;
3159 procedure Set_Has_Component_Size_Clause (Id : E; V : B := True) is
3160 begin
3161 pragma Assert (Ekind (Id) = E_Array_Type);
3162 Set_Flag68 (Id, V);
3163 end Set_Has_Component_Size_Clause;
3165 procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True) is
3166 begin
3167 pragma Assert (Is_Type (Id));
3168 Set_Flag187 (Id, V);
3169 end Set_Has_Constrained_Partial_View;
3171 procedure Set_Has_Contiguous_Rep (Id : E; V : B := True) is
3172 begin
3173 Set_Flag181 (Id, V);
3174 end Set_Has_Contiguous_Rep;
3176 procedure Set_Has_Controlled_Component (Id : E; V : B := True) is
3177 begin
3178 pragma Assert (Base_Type (Id) = Id);
3179 Set_Flag43 (Id, V);
3180 end Set_Has_Controlled_Component;
3182 procedure Set_Has_Controlling_Result (Id : E; V : B := True) is
3183 begin
3184 Set_Flag98 (Id, V);
3185 end Set_Has_Controlling_Result;
3187 procedure Set_Has_Convention_Pragma (Id : E; V : B := True) is
3188 begin
3189 Set_Flag119 (Id, V);
3190 end Set_Has_Convention_Pragma;
3192 procedure Set_Has_Delayed_Freeze (Id : E; V : B := True) is
3193 begin
3194 pragma Assert (Nkind (Id) in N_Entity);
3195 Set_Flag18 (Id, V);
3196 end Set_Has_Delayed_Freeze;
3198 procedure Set_Has_Discriminants (Id : E; V : B := True) is
3199 begin
3200 pragma Assert (Nkind (Id) in N_Entity);
3201 Set_Flag5 (Id, V);
3202 end Set_Has_Discriminants;
3204 procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True) is
3205 begin
3206 pragma Assert (Is_Enumeration_Type (Id));
3207 Set_Flag66 (Id, V);
3208 end Set_Has_Enumeration_Rep_Clause;
3210 procedure Set_Has_Exit (Id : E; V : B := True) is
3211 begin
3212 Set_Flag47 (Id, V);
3213 end Set_Has_Exit;
3215 procedure Set_Has_External_Tag_Rep_Clause (Id : E; V : B := True) is
3216 begin
3217 pragma Assert (Is_Tagged_Type (Id));
3218 Set_Flag110 (Id, V);
3219 end Set_Has_External_Tag_Rep_Clause;
3221 procedure Set_Has_Forward_Instantiation (Id : E; V : B := True) is
3222 begin
3223 Set_Flag175 (Id, V);
3224 end Set_Has_Forward_Instantiation;
3226 procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True) is
3227 begin
3228 Set_Flag173 (Id, V);
3229 end Set_Has_Fully_Qualified_Name;
3231 procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True) is
3232 begin
3233 Set_Flag82 (Id, V);
3234 end Set_Has_Gigi_Rep_Item;
3236 procedure Set_Has_Homonym (Id : E; V : B := True) is
3237 begin
3238 Set_Flag56 (Id, V);
3239 end Set_Has_Homonym;
3241 procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True) is
3242 begin
3243 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
3244 Set_Flag83 (Id, V);
3245 end Set_Has_Machine_Radix_Clause;
3247 procedure Set_Has_Master_Entity (Id : E; V : B := True) is
3248 begin
3249 Set_Flag21 (Id, V);
3250 end Set_Has_Master_Entity;
3252 procedure Set_Has_Missing_Return (Id : E; V : B := True) is
3253 begin
3254 pragma Assert
3255 (Ekind (Id) = E_Function or else Ekind (Id) = E_Generic_Function);
3256 Set_Flag142 (Id, V);
3257 end Set_Has_Missing_Return;
3259 procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True) is
3260 begin
3261 Set_Flag101 (Id, V);
3262 end Set_Has_Nested_Block_With_Handler;
3264 procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
3265 begin
3266 pragma Assert (Base_Type (Id) = Id);
3267 Set_Flag75 (Id, V);
3268 end Set_Has_Non_Standard_Rep;
3270 procedure Set_Has_Object_Size_Clause (Id : E; V : B := True) is
3271 begin
3272 pragma Assert (Is_Type (Id));
3273 Set_Flag172 (Id, V);
3274 end Set_Has_Object_Size_Clause;
3276 procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True) is
3277 begin
3278 Set_Flag154 (Id, V);
3279 end Set_Has_Per_Object_Constraint;
3281 procedure Set_Has_Persistent_BSS (Id : E; V : B := True) is
3282 begin
3283 Set_Flag188 (Id, V);
3284 end Set_Has_Persistent_BSS;
3286 procedure Set_Has_Pragma_Controlled (Id : E; V : B := True) is
3287 begin
3288 pragma Assert (Is_Access_Type (Id));
3289 Set_Flag27 (Base_Type (Id), V);
3290 end Set_Has_Pragma_Controlled;
3292 procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True) is
3293 begin
3294 Set_Flag150 (Id, V);
3295 end Set_Has_Pragma_Elaborate_Body;
3297 procedure Set_Has_Pragma_Inline (Id : E; V : B := True) is
3298 begin
3299 Set_Flag157 (Id, V);
3300 end Set_Has_Pragma_Inline;
3302 procedure Set_Has_Pragma_Pack (Id : E; V : B := True) is
3303 begin
3304 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
3305 pragma Assert (Id = Base_Type (Id));
3306 Set_Flag121 (Id, V);
3307 end Set_Has_Pragma_Pack;
3309 procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True) is
3310 begin
3311 pragma Assert (Is_Subprogram (Id));
3312 Set_Flag179 (Id, V);
3313 end Set_Has_Pragma_Pure_Function;
3315 procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True) is
3316 begin
3317 Set_Flag180 (Id, V);
3318 end Set_Has_Pragma_Unreferenced;
3320 procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is
3321 begin
3322 pragma Assert (Id = Base_Type (Id));
3323 Set_Flag120 (Id, V);
3324 end Set_Has_Primitive_Operations;
3326 procedure Set_Has_Private_Declaration (Id : E; V : B := True) is
3327 begin
3328 Set_Flag155 (Id, V);
3329 end Set_Has_Private_Declaration;
3331 procedure Set_Has_Qualified_Name (Id : E; V : B := True) is
3332 begin
3333 Set_Flag161 (Id, V);
3334 end Set_Has_Qualified_Name;
3336 procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True) is
3337 begin
3338 pragma Assert (Id = Base_Type (Id));
3339 Set_Flag65 (Id, V);
3340 end Set_Has_Record_Rep_Clause;
3342 procedure Set_Has_Recursive_Call (Id : E; V : B := True) is
3343 begin
3344 pragma Assert (Is_Subprogram (Id));
3345 Set_Flag143 (Id, V);
3346 end Set_Has_Recursive_Call;
3348 procedure Set_Has_Size_Clause (Id : E; V : B := True) is
3349 begin
3350 Set_Flag29 (Id, V);
3351 end Set_Has_Size_Clause;
3353 procedure Set_Has_Small_Clause (Id : E; V : B := True) is
3354 begin
3355 Set_Flag67 (Id, V);
3356 end Set_Has_Small_Clause;
3358 procedure Set_Has_Specified_Layout (Id : E; V : B := True) is
3359 begin
3360 pragma Assert (Id = Base_Type (Id));
3361 Set_Flag100 (Id, V);
3362 end Set_Has_Specified_Layout;
3364 procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True) is
3365 begin
3366 pragma Assert (Is_Type (Id));
3367 Set_Flag190 (Id, V);
3368 end Set_Has_Specified_Stream_Input;
3370 procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True) is
3371 begin
3372 pragma Assert (Is_Type (Id));
3373 Set_Flag191 (Id, V);
3374 end Set_Has_Specified_Stream_Output;
3376 procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True) is
3377 begin
3378 pragma Assert (Is_Type (Id));
3379 Set_Flag192 (Id, V);
3380 end Set_Has_Specified_Stream_Read;
3382 procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True) is
3383 begin
3384 pragma Assert (Is_Type (Id));
3385 Set_Flag193 (Id, V);
3386 end Set_Has_Specified_Stream_Write;
3388 procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True) is
3389 begin
3390 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
3391 pragma Assert (Base_Type (Id) = Id);
3392 Set_Flag23 (Id, V);
3393 end Set_Has_Storage_Size_Clause;
3395 procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True) is
3396 begin
3397 pragma Assert (Is_Elementary_Type (Id));
3398 Set_Flag184 (Id, V);
3399 end Set_Has_Stream_Size_Clause;
3401 procedure Set_Has_Subprogram_Descriptor (Id : E; V : B := True) is
3402 begin
3403 Set_Flag93 (Id, V);
3404 end Set_Has_Subprogram_Descriptor;
3406 procedure Set_Has_Task (Id : E; V : B := True) is
3407 begin
3408 pragma Assert (Base_Type (Id) = Id);
3409 Set_Flag30 (Id, V);
3410 end Set_Has_Task;
3412 procedure Set_Has_Unchecked_Union (Id : E; V : B := True) is
3413 begin
3414 pragma Assert (Base_Type (Id) = Id);
3415 Set_Flag123 (Id, V);
3416 end Set_Has_Unchecked_Union;
3418 procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True) is
3419 begin
3420 pragma Assert (Is_Type (Id));
3421 Set_Flag72 (Id, V);
3422 end Set_Has_Unknown_Discriminants;
3424 procedure Set_Has_Volatile_Components (Id : E; V : B := True) is
3425 begin
3426 pragma Assert (not Is_Type (Id) or else Base_Type (Id) = Id);
3427 Set_Flag87 (Id, V);
3428 end Set_Has_Volatile_Components;
3430 procedure Set_Has_Xref_Entry (Id : E; V : B := True) is
3431 begin
3432 Set_Flag182 (Id, V);
3433 end Set_Has_Xref_Entry;
3435 procedure Set_Hiding_Loop_Variable (Id : E; V : E) is
3436 begin
3437 pragma Assert (Ekind (Id) = E_Variable);
3438 Set_Node8 (Id, V);
3439 end Set_Hiding_Loop_Variable;
3441 procedure Set_Homonym (Id : E; V : E) is
3442 begin
3443 pragma Assert (Id /= V);
3444 Set_Node4 (Id, V);
3445 end Set_Homonym;
3447 procedure Set_In_Package_Body (Id : E; V : B := True) is
3448 begin
3449 Set_Flag48 (Id, V);
3450 end Set_In_Package_Body;
3452 procedure Set_In_Private_Part (Id : E; V : B := True) is
3453 begin
3454 Set_Flag45 (Id, V);
3455 end Set_In_Private_Part;
3457 procedure Set_In_Use (Id : E; V : B := True) is
3458 begin
3459 pragma Assert (Nkind (Id) in N_Entity);
3460 Set_Flag8 (Id, V);
3461 end Set_In_Use;
3463 procedure Set_Inner_Instances (Id : E; V : L) is
3464 begin
3465 Set_Elist23 (Id, V);
3466 end Set_Inner_Instances;
3468 procedure Set_Interface_Name (Id : E; V : N) is
3469 begin
3470 Set_Node21 (Id, V);
3471 end Set_Interface_Name;
3473 procedure Set_Is_Abstract (Id : E; V : B := True) is
3474 begin
3475 Set_Flag19 (Id, V);
3476 end Set_Is_Abstract;
3478 procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
3479 begin
3480 pragma Assert (Is_Access_Type (Id));
3481 Set_Flag194 (Id, V);
3482 end Set_Is_Local_Anonymous_Access;
3484 procedure Set_Is_Access_Constant (Id : E; V : B := True) is
3485 begin
3486 pragma Assert (Is_Access_Type (Id));
3487 Set_Flag69 (Id, V);
3488 end Set_Is_Access_Constant;
3490 procedure Set_Is_Ada_2005 (Id : E; V : B := True) is
3491 begin
3492 Set_Flag185 (Id, V);
3493 end Set_Is_Ada_2005;
3495 procedure Set_Is_Aliased (Id : E; V : B := True) is
3496 begin
3497 pragma Assert (Nkind (Id) in N_Entity);
3498 Set_Flag15 (Id, V);
3499 end Set_Is_Aliased;
3501 procedure Set_Is_AST_Entry (Id : E; V : B := True) is
3502 begin
3503 pragma Assert (Is_Entry (Id));
3504 Set_Flag132 (Id, V);
3505 end Set_Is_AST_Entry;
3507 procedure Set_Is_Asynchronous (Id : E; V : B := True) is
3508 begin
3509 pragma Assert
3510 (Ekind (Id) = E_Procedure or else Is_Type (Id));
3511 Set_Flag81 (Id, V);
3512 end Set_Is_Asynchronous;
3514 procedure Set_Is_Atomic (Id : E; V : B := True) is
3515 begin
3516 Set_Flag85 (Id, V);
3517 end Set_Is_Atomic;
3519 procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True) is
3520 begin
3521 pragma Assert ((not V)
3522 or else (Is_Array_Type (Id) and then Id = Base_Type (Id)));
3524 Set_Flag122 (Id, V);
3525 end Set_Is_Bit_Packed_Array;
3527 procedure Set_Is_Called (Id : E; V : B := True) is
3528 begin
3529 pragma Assert
3530 (Ekind (Id) = E_Procedure or else Ekind (Id) = E_Function);
3531 Set_Flag102 (Id, V);
3532 end Set_Is_Called;
3534 procedure Set_Is_Character_Type (Id : E; V : B := True) is
3535 begin
3536 Set_Flag63 (Id, V);
3537 end Set_Is_Character_Type;
3539 procedure Set_Is_Child_Unit (Id : E; V : B := True) is
3540 begin
3541 Set_Flag73 (Id, V);
3542 end Set_Is_Child_Unit;
3544 procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is
3545 begin
3546 Set_Flag35 (Id, V);
3547 end Set_Is_Class_Wide_Equivalent_Type;
3549 procedure Set_Is_Compilation_Unit (Id : E; V : B := True) is
3550 begin
3551 Set_Flag149 (Id, V);
3552 end Set_Is_Compilation_Unit;
3554 procedure Set_Is_Completely_Hidden (Id : E; V : B := True) is
3555 begin
3556 pragma Assert (Ekind (Id) = E_Discriminant);
3557 Set_Flag103 (Id, V);
3558 end Set_Is_Completely_Hidden;
3560 procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True) is
3561 begin
3562 Set_Flag20 (Id, V);
3563 end Set_Is_Concurrent_Record_Type;
3565 procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True) is
3566 begin
3567 Set_Flag80 (Id, V);
3568 end Set_Is_Constr_Subt_For_U_Nominal;
3570 procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True) is
3571 begin
3572 Set_Flag141 (Id, V);
3573 end Set_Is_Constr_Subt_For_UN_Aliased;
3575 procedure Set_Is_Constrained (Id : E; V : B := True) is
3576 begin
3577 pragma Assert (Nkind (Id) in N_Entity);
3578 Set_Flag12 (Id, V);
3579 end Set_Is_Constrained;
3581 procedure Set_Is_Constructor (Id : E; V : B := True) is
3582 begin
3583 Set_Flag76 (Id, V);
3584 end Set_Is_Constructor;
3586 procedure Set_Is_Controlled (Id : E; V : B := True) is
3587 begin
3588 pragma Assert (Id = Base_Type (Id));
3589 Set_Flag42 (Id, V);
3590 end Set_Is_Controlled;
3592 procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is
3593 begin
3594 pragma Assert (Is_Formal (Id));
3595 Set_Flag97 (Id, V);
3596 end Set_Is_Controlling_Formal;
3598 procedure Set_Is_CPP_Class (Id : E; V : B := True) is
3599 begin
3600 Set_Flag74 (Id, V);
3601 end Set_Is_CPP_Class;
3603 procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is
3604 begin
3605 Set_Flag176 (Id, V);
3606 end Set_Is_Discrim_SO_Function;
3608 procedure Set_Is_Dispatching_Operation (Id : E; V : B := True) is
3609 begin
3610 pragma Assert
3611 (V = False
3612 or else
3613 Is_Overloadable (Id)
3614 or else
3615 Ekind (Id) = E_Subprogram_Type);
3617 Set_Flag6 (Id, V);
3618 end Set_Is_Dispatching_Operation;
3620 procedure Set_Is_Eliminated (Id : E; V : B := True) is
3621 begin
3622 Set_Flag124 (Id, V);
3623 end Set_Is_Eliminated;
3625 procedure Set_Is_Entry_Formal (Id : E; V : B := True) is
3626 begin
3627 Set_Flag52 (Id, V);
3628 end Set_Is_Entry_Formal;
3630 procedure Set_Is_Exported (Id : E; V : B := True) is
3631 begin
3632 Set_Flag99 (Id, V);
3633 end Set_Is_Exported;
3635 procedure Set_Is_First_Subtype (Id : E; V : B := True) is
3636 begin
3637 Set_Flag70 (Id, V);
3638 end Set_Is_First_Subtype;
3640 procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
3641 begin
3642 pragma Assert
3643 (Ekind (Id) = E_Record_Subtype
3644 or else
3645 Ekind (Id) = E_Private_Subtype);
3646 Set_Flag118 (Id, V);
3647 end Set_Is_For_Access_Subtype;
3649 procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is
3650 begin
3651 Set_Flag111 (Id, V);
3652 end Set_Is_Formal_Subprogram;
3654 procedure Set_Is_Frozen (Id : E; V : B := True) is
3655 begin
3656 pragma Assert (Nkind (Id) in N_Entity);
3657 Set_Flag4 (Id, V);
3658 end Set_Is_Frozen;
3660 procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True) is
3661 begin
3662 pragma Assert (Is_Type (Id));
3663 Set_Flag94 (Id, V);
3664 end Set_Is_Generic_Actual_Type;
3666 procedure Set_Is_Generic_Instance (Id : E; V : B := True) is
3667 begin
3668 Set_Flag130 (Id, V);
3669 end Set_Is_Generic_Instance;
3671 procedure Set_Is_Generic_Type (Id : E; V : B := True) is
3672 begin
3673 pragma Assert (Nkind (Id) in N_Entity);
3674 Set_Flag13 (Id, V);
3675 end Set_Is_Generic_Type;
3677 procedure Set_Is_Hidden (Id : E; V : B := True) is
3678 begin
3679 Set_Flag57 (Id, V);
3680 end Set_Is_Hidden;
3682 procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True) is
3683 begin
3684 Set_Flag171 (Id, V);
3685 end Set_Is_Hidden_Open_Scope;
3687 procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
3688 begin
3689 pragma Assert (Nkind (Id) in N_Entity);
3690 Set_Flag7 (Id, V);
3691 end Set_Is_Immediately_Visible;
3693 procedure Set_Is_Imported (Id : E; V : B := True) is
3694 begin
3695 Set_Flag24 (Id, V);
3696 end Set_Is_Imported;
3698 procedure Set_Is_Inlined (Id : E; V : B := True) is
3699 begin
3700 Set_Flag11 (Id, V);
3701 end Set_Is_Inlined;
3703 procedure Set_Is_Interface (Id : E; V : B := True) is
3704 begin
3705 pragma Assert
3706 (Ekind (Id) = E_Record_Type
3707 or else Ekind (Id) = E_Record_Subtype
3708 or else Ekind (Id) = E_Record_Type_With_Private
3709 or else Ekind (Id) = E_Record_Subtype_With_Private
3710 or else Ekind (Id) = E_Class_Wide_Type);
3711 Set_Flag186 (Id, V);
3712 end Set_Is_Interface;
3714 procedure Set_Is_Instantiated (Id : E; V : B := True) is
3715 begin
3716 Set_Flag126 (Id, V);
3717 end Set_Is_Instantiated;
3719 procedure Set_Is_Internal (Id : E; V : B := True) is
3720 begin
3721 pragma Assert (Nkind (Id) in N_Entity);
3722 Set_Flag17 (Id, V);
3723 end Set_Is_Internal;
3725 procedure Set_Is_Interrupt_Handler (Id : E; V : B := True) is
3726 begin
3727 pragma Assert (Nkind (Id) in N_Entity);
3728 Set_Flag89 (Id, V);
3729 end Set_Is_Interrupt_Handler;
3731 procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True) is
3732 begin
3733 Set_Flag64 (Id, V);
3734 end Set_Is_Intrinsic_Subprogram;
3736 procedure Set_Is_Itype (Id : E; V : B := True) is
3737 begin
3738 Set_Flag91 (Id, V);
3739 end Set_Is_Itype;
3741 procedure Set_Is_Known_Non_Null (Id : E; V : B := True) is
3742 begin
3743 Set_Flag37 (Id, V);
3744 end Set_Is_Known_Non_Null;
3746 procedure Set_Is_Known_Valid (Id : E; V : B := True) is
3747 begin
3748 Set_Flag170 (Id, V);
3749 end Set_Is_Known_Valid;
3751 procedure Set_Is_Limited_Composite (Id : E; V : B := True) is
3752 begin
3753 pragma Assert (Is_Type (Id));
3754 Set_Flag106 (Id, V);
3755 end Set_Is_Limited_Composite;
3757 procedure Set_Is_Limited_Record (Id : E; V : B := True) is
3758 begin
3759 Set_Flag25 (Id, V);
3760 end Set_Is_Limited_Record;
3762 procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
3763 begin
3764 pragma Assert (Is_Subprogram (Id));
3765 Set_Flag137 (Id, V);
3766 end Set_Is_Machine_Code_Subprogram;
3768 procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True) is
3769 begin
3770 pragma Assert (Is_Type (Id));
3771 Set_Flag109 (Id, V);
3772 end Set_Is_Non_Static_Subtype;
3774 procedure Set_Is_Null_Init_Proc (Id : E; V : B := True) is
3775 begin
3776 pragma Assert (Ekind (Id) = E_Procedure);
3777 Set_Flag178 (Id, V);
3778 end Set_Is_Null_Init_Proc;
3780 procedure Set_Is_Obsolescent (Id : E; V : B := True) is
3781 begin
3782 Set_Flag153 (Id, V);
3783 end Set_Is_Obsolescent;
3785 procedure Set_Is_Optional_Parameter (Id : E; V : B := True) is
3786 begin
3787 pragma Assert (Is_Formal (Id));
3788 Set_Flag134 (Id, V);
3789 end Set_Is_Optional_Parameter;
3791 procedure Set_Is_Overriding_Operation (Id : E; V : B := True) is
3792 begin
3793 pragma Assert (Is_Subprogram (Id));
3794 Set_Flag39 (Id, V);
3795 end Set_Is_Overriding_Operation;
3797 procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
3798 begin
3799 Set_Flag160 (Id, V);
3800 end Set_Is_Package_Body_Entity;
3802 procedure Set_Is_Packed (Id : E; V : B := True) is
3803 begin
3804 pragma Assert (Base_Type (Id) = Id);
3805 Set_Flag51 (Id, V);
3806 end Set_Is_Packed;
3808 procedure Set_Is_Packed_Array_Type (Id : E; V : B := True) is
3809 begin
3810 Set_Flag138 (Id, V);
3811 end Set_Is_Packed_Array_Type;
3813 procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
3814 begin
3815 pragma Assert (Nkind (Id) in N_Entity);
3816 Set_Flag9 (Id, V);
3817 end Set_Is_Potentially_Use_Visible;
3819 procedure Set_Is_Preelaborated (Id : E; V : B := True) is
3820 begin
3821 Set_Flag59 (Id, V);
3822 end Set_Is_Preelaborated;
3824 procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
3825 begin
3826 pragma Assert (Ekind (Id) = E_Procedure);
3827 Set_Flag195 (Id, V);
3828 end Set_Is_Primitive_Wrapper;
3830 procedure Set_Is_Private_Composite (Id : E; V : B := True) is
3831 begin
3832 pragma Assert (Is_Type (Id));
3833 Set_Flag107 (Id, V);
3834 end Set_Is_Private_Composite;
3836 procedure Set_Is_Private_Descendant (Id : E; V : B := True) is
3837 begin
3838 Set_Flag53 (Id, V);
3839 end Set_Is_Private_Descendant;
3841 procedure Set_Is_Public (Id : E; V : B := True) is
3842 begin
3843 pragma Assert (Nkind (Id) in N_Entity);
3844 Set_Flag10 (Id, V);
3845 end Set_Is_Public;
3847 procedure Set_Is_Pure (Id : E; V : B := True) is
3848 begin
3849 Set_Flag44 (Id, V);
3850 end Set_Is_Pure;
3852 procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True) is
3853 begin
3854 pragma Assert (Is_Access_Type (Id));
3855 Set_Flag189 (Id, V);
3856 end Set_Is_Pure_Unit_Access_Type;
3858 procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is
3859 begin
3860 Set_Flag62 (Id, V);
3861 end Set_Is_Remote_Call_Interface;
3863 procedure Set_Is_Remote_Types (Id : E; V : B := True) is
3864 begin
3865 Set_Flag61 (Id, V);
3866 end Set_Is_Remote_Types;
3868 procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True) is
3869 begin
3870 Set_Flag112 (Id, V);
3871 end Set_Is_Renaming_Of_Object;
3873 procedure Set_Is_Shared_Passive (Id : E; V : B := True) is
3874 begin
3875 Set_Flag60 (Id, V);
3876 end Set_Is_Shared_Passive;
3878 procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is
3879 begin
3880 pragma Assert
3881 (Ekind (Id) = E_Exception
3882 or else Ekind (Id) = E_Variable
3883 or else Ekind (Id) = E_Constant
3884 or else Is_Type (Id)
3885 or else Ekind (Id) = E_Void);
3886 Set_Flag28 (Id, V);
3887 end Set_Is_Statically_Allocated;
3889 procedure Set_Is_Tag (Id : E; V : B := True) is
3890 begin
3891 pragma Assert (Nkind (Id) in N_Entity);
3892 Set_Flag78 (Id, V);
3893 end Set_Is_Tag;
3895 procedure Set_Is_Tagged_Type (Id : E; V : B := True) is
3896 begin
3897 Set_Flag55 (Id, V);
3898 end Set_Is_Tagged_Type;
3900 procedure Set_Is_Thread_Body (Id : E; V : B := True) is
3901 begin
3902 Set_Flag77 (Id, V);
3903 end Set_Is_Thread_Body;
3905 procedure Set_Is_True_Constant (Id : E; V : B := True) is
3906 begin
3907 Set_Flag163 (Id, V);
3908 end Set_Is_True_Constant;
3910 procedure Set_Is_Unchecked_Union (Id : E; V : B := True) is
3911 begin
3912 pragma Assert (Base_Type (Id) = Id);
3913 Set_Flag117 (Id, V);
3914 end Set_Is_Unchecked_Union;
3916 procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
3917 begin
3918 pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
3919 Set_Flag144 (Id, V);
3920 end Set_Is_Unsigned_Type;
3922 procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
3923 begin
3924 pragma Assert (Ekind (Id) = E_Procedure);
3925 Set_Flag127 (Id, V);
3926 end Set_Is_Valued_Procedure;
3928 procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True) is
3929 begin
3930 pragma Assert (Is_Child_Unit (Id));
3931 Set_Flag116 (Id, V);
3932 end Set_Is_Visible_Child_Unit;
3934 procedure Set_Is_VMS_Exception (Id : E; V : B := True) is
3935 begin
3936 pragma Assert (Ekind (Id) = E_Exception);
3937 Set_Flag133 (Id, V);
3938 end Set_Is_VMS_Exception;
3940 procedure Set_Is_Volatile (Id : E; V : B := True) is
3941 begin
3942 pragma Assert (Nkind (Id) in N_Entity);
3943 Set_Flag16 (Id, V);
3944 end Set_Is_Volatile;
3946 procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
3947 begin
3948 Set_Flag32 (Id, V);
3949 end Set_Kill_Elaboration_Checks;
3951 procedure Set_Kill_Range_Checks (Id : E; V : B := True) is
3952 begin
3953 Set_Flag33 (Id, V);
3954 end Set_Kill_Range_Checks;
3956 procedure Set_Kill_Tag_Checks (Id : E; V : B := True) is
3957 begin
3958 Set_Flag34 (Id, V);
3959 end Set_Kill_Tag_Checks;
3961 procedure Set_Last_Entity (Id : E; V : E) is
3962 begin
3963 Set_Node20 (Id, V);
3964 end Set_Last_Entity;
3966 procedure Set_Limited_View (Id : E; V : E) is
3967 begin
3968 pragma Assert (Ekind (Id) = E_Package);
3969 Set_Node23 (Id, V);
3970 end Set_Limited_View;
3972 procedure Set_Lit_Indexes (Id : E; V : E) is
3973 begin
3974 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
3975 Set_Node15 (Id, V);
3976 end Set_Lit_Indexes;
3978 procedure Set_Lit_Strings (Id : E; V : E) is
3979 begin
3980 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
3981 Set_Node16 (Id, V);
3982 end Set_Lit_Strings;
3984 procedure Set_Machine_Radix_10 (Id : E; V : B := True) is
3985 begin
3986 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
3987 Set_Flag84 (Id, V);
3988 end Set_Machine_Radix_10;
3990 procedure Set_Master_Id (Id : E; V : E) is
3991 begin
3992 Set_Node17 (Id, V);
3993 end Set_Master_Id;
3995 procedure Set_Materialize_Entity (Id : E; V : B := True) is
3996 begin
3997 Set_Flag168 (Id, V);
3998 end Set_Materialize_Entity;
4000 procedure Set_Mechanism (Id : E; V : M) is
4001 begin
4002 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
4003 Set_Uint8 (Id, UI_From_Int (V));
4004 end Set_Mechanism;
4006 procedure Set_Modulus (Id : E; V : U) is
4007 begin
4008 pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
4009 Set_Uint17 (Id, V);
4010 end Set_Modulus;
4012 procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True) is
4013 begin
4014 pragma Assert (Is_Type (Id));
4015 Set_Flag183 (Id, V);
4016 end Set_Must_Be_On_Byte_Boundary;
4018 procedure Set_Needs_Debug_Info (Id : E; V : B := True) is
4019 begin
4020 Set_Flag147 (Id, V);
4021 end Set_Needs_Debug_Info;
4023 procedure Set_Needs_No_Actuals (Id : E; V : B := True) is
4024 begin
4025 pragma Assert
4026 (Is_Overloadable (Id)
4027 or else Ekind (Id) = E_Subprogram_Type
4028 or else Ekind (Id) = E_Entry_Family);
4029 Set_Flag22 (Id, V);
4030 end Set_Needs_No_Actuals;
4032 procedure Set_Never_Set_In_Source (Id : E; V : B := True) is
4033 begin
4034 Set_Flag115 (Id, V);
4035 end Set_Never_Set_In_Source;
4037 procedure Set_Next_Inlined_Subprogram (Id : E; V : E) is
4038 begin
4039 Set_Node12 (Id, V);
4040 end Set_Next_Inlined_Subprogram;
4042 procedure Set_No_Pool_Assigned (Id : E; V : B := True) is
4043 begin
4044 pragma Assert (Is_Access_Type (Id) and then Base_Type (Id) = Id);
4045 Set_Flag131 (Id, V);
4046 end Set_No_Pool_Assigned;
4048 procedure Set_No_Return (Id : E; V : B := True) is
4049 begin
4050 pragma Assert
4051 (Ekind (Id) = E_Procedure or else Ekind (Id) = E_Generic_Procedure);
4052 Set_Flag113 (Id, V);
4053 end Set_No_Return;
4055 procedure Set_No_Strict_Aliasing (Id : E; V : B := True) is
4056 begin
4057 pragma Assert (Is_Access_Type (Id) and then Base_Type (Id) = Id);
4058 Set_Flag136 (Id, V);
4059 end Set_No_Strict_Aliasing;
4061 procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
4062 begin
4063 pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
4064 Set_Flag58 (Id, V);
4065 end Set_Non_Binary_Modulus;
4067 procedure Set_Non_Limited_View (Id : E; V : E) is
4068 pragma Assert (False
4069 or else Ekind (Id) = E_Incomplete_Type);
4070 begin
4071 Set_Node17 (Id, V);
4072 end Set_Non_Limited_View;
4074 procedure Set_Nonzero_Is_True (Id : E; V : B := True) is
4075 begin
4076 pragma Assert
4077 (Root_Type (Id) = Standard_Boolean
4078 and then Ekind (Id) = E_Enumeration_Type);
4079 Set_Flag162 (Id, V);
4080 end Set_Nonzero_Is_True;
4082 procedure Set_Normalized_First_Bit (Id : E; V : U) is
4083 begin
4084 pragma Assert
4085 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
4086 Set_Uint8 (Id, V);
4087 end Set_Normalized_First_Bit;
4089 procedure Set_Normalized_Position (Id : E; V : U) is
4090 begin
4091 pragma Assert
4092 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
4093 Set_Uint14 (Id, V);
4094 end Set_Normalized_Position;
4096 procedure Set_Normalized_Position_Max (Id : E; V : U) is
4097 begin
4098 pragma Assert
4099 (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
4100 Set_Uint10 (Id, V);
4101 end Set_Normalized_Position_Max;
4103 procedure Set_Object_Ref (Id : E; V : E) is
4104 begin
4105 pragma Assert (Ekind (Id) = E_Protected_Body);
4106 Set_Node17 (Id, V);
4107 end Set_Object_Ref;
4109 procedure Set_Obsolescent_Warning (Id : E; V : N) is
4110 begin
4111 pragma Assert (Is_Subprogram (Id));
4112 Set_Node24 (Id, V);
4113 end Set_Obsolescent_Warning;
4115 procedure Set_Original_Access_Type (Id : E; V : E) is
4116 begin
4117 pragma Assert
4118 (Ekind (Id) = E_Access_Subprogram_Type
4119 or else Ekind (Id) = E_Access_Protected_Subprogram_Type);
4120 Set_Node21 (Id, V);
4121 end Set_Original_Access_Type;
4123 procedure Set_Original_Array_Type (Id : E; V : E) is
4124 begin
4125 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
4126 Set_Node21 (Id, V);
4127 end Set_Original_Array_Type;
4129 procedure Set_Original_Record_Component (Id : E; V : E) is
4130 begin
4131 pragma Assert
4132 (Ekind (Id) = E_Void
4133 or else Ekind (Id) = E_Component
4134 or else Ekind (Id) = E_Discriminant);
4135 Set_Node22 (Id, V);
4136 end Set_Original_Record_Component;
4138 procedure Set_Overridden_Operation (Id : E; V : E) is
4139 begin
4140 Set_Node26 (Id, V);
4141 end Set_Overridden_Operation;
4143 procedure Set_Packed_Array_Type (Id : E; V : E) is
4144 begin
4145 pragma Assert (Is_Array_Type (Id));
4146 Set_Node23 (Id, V);
4147 end Set_Packed_Array_Type;
4149 procedure Set_Parent_Subtype (Id : E; V : E) is
4150 begin
4151 pragma Assert (Ekind (Id) = E_Record_Type);
4152 Set_Node19 (Id, V);
4153 end Set_Parent_Subtype;
4155 procedure Set_Primitive_Operations (Id : E; V : L) is
4156 begin
4157 pragma Assert (Is_Tagged_Type (Id));
4158 Set_Elist15 (Id, V);
4159 end Set_Primitive_Operations;
4161 procedure Set_Prival (Id : E; V : E) is
4162 begin
4163 pragma Assert (Is_Protected_Private (Id));
4164 Set_Node17 (Id, V);
4165 end Set_Prival;
4167 procedure Set_Privals_Chain (Id : E; V : L) is
4168 begin
4169 pragma Assert (Is_Overloadable (Id)
4170 or else Ekind (Id) = E_Entry_Family);
4171 Set_Elist23 (Id, V);
4172 end Set_Privals_Chain;
4174 procedure Set_Private_Dependents (Id : E; V : L) is
4175 begin
4176 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
4177 Set_Elist18 (Id, V);
4178 end Set_Private_Dependents;
4180 procedure Set_Private_View (Id : E; V : N) is
4181 begin
4182 pragma Assert (Is_Private_Type (Id));
4183 Set_Node22 (Id, V);
4184 end Set_Private_View;
4186 procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
4187 begin
4188 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
4189 Set_Node11 (Id, V);
4190 end Set_Protected_Body_Subprogram;
4192 procedure Set_Protected_Formal (Id : E; V : E) is
4193 begin
4194 pragma Assert (Is_Formal (Id));
4195 Set_Node22 (Id, V);
4196 end Set_Protected_Formal;
4198 procedure Set_Protected_Operation (Id : E; V : N) is
4199 begin
4200 pragma Assert (Is_Protected_Private (Id));
4201 Set_Node23 (Id, V);
4202 end Set_Protected_Operation;
4204 procedure Set_Reachable (Id : E; V : B := True) is
4205 begin
4206 Set_Flag49 (Id, V);
4207 end Set_Reachable;
4209 procedure Set_Referenced (Id : E; V : B := True) is
4210 begin
4211 Set_Flag156 (Id, V);
4212 end Set_Referenced;
4214 procedure Set_Referenced_As_LHS (Id : E; V : B := True) is
4215 begin
4216 Set_Flag36 (Id, V);
4217 end Set_Referenced_As_LHS;
4219 procedure Set_Referenced_Object (Id : E; V : N) is
4220 begin
4221 pragma Assert (Is_Type (Id));
4222 Set_Node10 (Id, V);
4223 end Set_Referenced_Object;
4225 procedure Set_Register_Exception_Call (Id : E; V : N) is
4226 begin
4227 pragma Assert (Ekind (Id) = E_Exception);
4228 Set_Node20 (Id, V);
4229 end Set_Register_Exception_Call;
4231 procedure Set_Related_Array_Object (Id : E; V : E) is
4232 begin
4233 pragma Assert (Is_Array_Type (Id));
4234 Set_Node19 (Id, V);
4235 end Set_Related_Array_Object;
4237 procedure Set_Related_Instance (Id : E; V : E) is
4238 begin
4239 pragma Assert
4240 (Ekind (Id) = E_Package or else Ekind (Id) = E_Package_Body);
4241 Set_Node15 (Id, V);
4242 end Set_Related_Instance;
4244 procedure Set_Renamed_Entity (Id : E; V : N) is
4245 begin
4246 Set_Node18 (Id, V);
4247 end Set_Renamed_Entity;
4249 procedure Set_Renamed_Object (Id : E; V : N) is
4250 begin
4251 Set_Node18 (Id, V);
4252 end Set_Renamed_Object;
4254 procedure Set_Renaming_Map (Id : E; V : U) is
4255 begin
4256 Set_Uint9 (Id, V);
4257 end Set_Renaming_Map;
4259 procedure Set_Return_Present (Id : E; V : B := True) is
4260 begin
4261 Set_Flag54 (Id, V);
4262 end Set_Return_Present;
4264 procedure Set_Returns_By_Ref (Id : E; V : B := True) is
4265 begin
4266 Set_Flag90 (Id, V);
4267 end Set_Returns_By_Ref;
4269 procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
4270 begin
4271 pragma Assert
4272 (Is_Record_Type (Id) and then Id = Base_Type (Id));
4273 Set_Flag164 (Id, V);
4274 end Set_Reverse_Bit_Order;
4276 procedure Set_RM_Size (Id : E; V : U) is
4277 begin
4278 pragma Assert (Is_Type (Id));
4279 Set_Uint13 (Id, V);
4280 end Set_RM_Size;
4282 procedure Set_Scalar_Range (Id : E; V : N) is
4283 begin
4284 Set_Node20 (Id, V);
4285 end Set_Scalar_Range;
4287 procedure Set_Scale_Value (Id : E; V : U) is
4288 begin
4289 Set_Uint15 (Id, V);
4290 end Set_Scale_Value;
4292 procedure Set_Scope_Depth_Value (Id : E; V : U) is
4293 begin
4294 pragma Assert (not Is_Record_Type (Id));
4295 Set_Uint22 (Id, V);
4296 end Set_Scope_Depth_Value;
4298 procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is
4299 begin
4300 Set_Flag167 (Id, V);
4301 end Set_Sec_Stack_Needed_For_Return;
4303 procedure Set_Shadow_Entities (Id : E; V : S) is
4304 begin
4305 pragma Assert
4306 (Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package);
4307 Set_List14 (Id, V);
4308 end Set_Shadow_Entities;
4310 procedure Set_Shared_Var_Assign_Proc (Id : E; V : E) is
4311 begin
4312 pragma Assert (Ekind (Id) = E_Variable);
4313 Set_Node22 (Id, V);
4314 end Set_Shared_Var_Assign_Proc;
4316 procedure Set_Shared_Var_Read_Proc (Id : E; V : E) is
4317 begin
4318 pragma Assert (Ekind (Id) = E_Variable);
4319 Set_Node15 (Id, V);
4320 end Set_Shared_Var_Read_Proc;
4322 procedure Set_Size_Check_Code (Id : E; V : N) is
4323 begin
4324 pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable);
4325 Set_Node19 (Id, V);
4326 end Set_Size_Check_Code;
4328 procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True) is
4329 begin
4330 Set_Flag177 (Id, V);
4331 end Set_Size_Depends_On_Discriminant;
4333 procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True) is
4334 begin
4335 Set_Flag92 (Id, V);
4336 end Set_Size_Known_At_Compile_Time;
4338 procedure Set_Small_Value (Id : E; V : R) is
4339 begin
4340 pragma Assert (Is_Fixed_Point_Type (Id));
4341 Set_Ureal21 (Id, V);
4342 end Set_Small_Value;
4344 procedure Set_Spec_Entity (Id : E; V : E) is
4345 begin
4346 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
4347 Set_Node19 (Id, V);
4348 end Set_Spec_Entity;
4350 procedure Set_Storage_Size_Variable (Id : E; V : E) is
4351 begin
4352 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
4353 pragma Assert (Base_Type (Id) = Id);
4354 Set_Node15 (Id, V);
4355 end Set_Storage_Size_Variable;
4357 procedure Set_Stored_Constraint (Id : E; V : L) is
4358 begin
4359 pragma Assert (Nkind (Id) in N_Entity);
4360 Set_Elist23 (Id, V);
4361 end Set_Stored_Constraint;
4363 procedure Set_Strict_Alignment (Id : E; V : B := True) is
4364 begin
4365 pragma Assert (Base_Type (Id) = Id);
4366 Set_Flag145 (Id, V);
4367 end Set_Strict_Alignment;
4369 procedure Set_String_Literal_Length (Id : E; V : U) is
4370 begin
4371 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
4372 Set_Uint16 (Id, V);
4373 end Set_String_Literal_Length;
4375 procedure Set_String_Literal_Low_Bound (Id : E; V : N) is
4376 begin
4377 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
4378 Set_Node15 (Id, V);
4379 end Set_String_Literal_Low_Bound;
4381 procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
4382 begin
4383 Set_Flag148 (Id, V);
4384 end Set_Suppress_Elaboration_Warnings;
4386 procedure Set_Suppress_Init_Proc (Id : E; V : B := True) is
4387 begin
4388 pragma Assert (Id = Base_Type (Id));
4389 Set_Flag105 (Id, V);
4390 end Set_Suppress_Init_Proc;
4392 procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is
4393 begin
4394 Set_Flag165 (Id, V);
4395 end Set_Suppress_Style_Checks;
4397 procedure Set_Task_Body_Procedure (Id : E; V : N) is
4398 begin
4399 pragma Assert (Ekind (Id) = E_Task_Type
4400 or else Ekind (Id) = E_Task_Subtype);
4401 Set_Node24 (Id, V);
4402 end Set_Task_Body_Procedure;
4404 procedure Set_Treat_As_Volatile (Id : E; V : B := True) is
4405 begin
4406 Set_Flag41 (Id, V);
4407 end Set_Treat_As_Volatile;
4409 procedure Set_Underlying_Full_View (Id : E; V : E) is
4410 begin
4411 pragma Assert (Ekind (Id) in Private_Kind);
4412 Set_Node19 (Id, V);
4413 end Set_Underlying_Full_View;
4415 procedure Set_Unset_Reference (Id : E; V : N) is
4416 begin
4417 Set_Node16 (Id, V);
4418 end Set_Unset_Reference;
4420 procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
4421 begin
4422 Set_Flag95 (Id, V);
4423 end Set_Uses_Sec_Stack;
4425 procedure Set_Vax_Float (Id : E; V : B := True) is
4426 begin
4427 pragma Assert (Id = Base_Type (Id));
4428 Set_Flag151 (Id, V);
4429 end Set_Vax_Float;
4431 procedure Set_Warnings_Off (Id : E; V : B := True) is
4432 begin
4433 Set_Flag96 (Id, V);
4434 end Set_Warnings_Off;
4436 procedure Set_Was_Hidden (Id : E; V : B := True) is
4437 begin
4438 Set_Flag196 (Id, V);
4439 end Set_Was_Hidden;
4441 procedure Set_Wrapped_Entity (Id : E; V : E) is
4442 begin
4443 pragma Assert (Ekind (Id) = E_Procedure
4444 and then Is_Primitive_Wrapper (Id));
4445 Set_Node27 (Id, V);
4446 end Set_Wrapped_Entity;
4448 -----------------------------------
4449 -- Field Initialization Routines --
4450 -----------------------------------
4452 procedure Init_Alignment (Id : E) is
4453 begin
4454 Set_Uint14 (Id, Uint_0);
4455 end Init_Alignment;
4457 procedure Init_Alignment (Id : E; V : Int) is
4458 begin
4459 Set_Uint14 (Id, UI_From_Int (V));
4460 end Init_Alignment;
4462 procedure Init_Component_Bit_Offset (Id : E) is
4463 begin
4464 Set_Uint11 (Id, No_Uint);
4465 end Init_Component_Bit_Offset;
4467 procedure Init_Component_Bit_Offset (Id : E; V : Int) is
4468 begin
4469 Set_Uint11 (Id, UI_From_Int (V));
4470 end Init_Component_Bit_Offset;
4472 procedure Init_Component_Size (Id : E) is
4473 begin
4474 Set_Uint22 (Id, Uint_0);
4475 end Init_Component_Size;
4477 procedure Init_Component_Size (Id : E; V : Int) is
4478 begin
4479 Set_Uint22 (Id, UI_From_Int (V));
4480 end Init_Component_Size;
4482 procedure Init_Digits_Value (Id : E) is
4483 begin
4484 Set_Uint17 (Id, Uint_0);
4485 end Init_Digits_Value;
4487 procedure Init_Digits_Value (Id : E; V : Int) is
4488 begin
4489 Set_Uint17 (Id, UI_From_Int (V));
4490 end Init_Digits_Value;
4492 procedure Init_Esize (Id : E) is
4493 begin
4494 Set_Uint12 (Id, Uint_0);
4495 end Init_Esize;
4497 procedure Init_Esize (Id : E; V : Int) is
4498 begin
4499 Set_Uint12 (Id, UI_From_Int (V));
4500 end Init_Esize;
4502 procedure Init_Normalized_First_Bit (Id : E) is
4503 begin
4504 Set_Uint8 (Id, No_Uint);
4505 end Init_Normalized_First_Bit;
4507 procedure Init_Normalized_First_Bit (Id : E; V : Int) is
4508 begin
4509 Set_Uint8 (Id, UI_From_Int (V));
4510 end Init_Normalized_First_Bit;
4512 procedure Init_Normalized_Position (Id : E) is
4513 begin
4514 Set_Uint14 (Id, No_Uint);
4515 end Init_Normalized_Position;
4517 procedure Init_Normalized_Position (Id : E; V : Int) is
4518 begin
4519 Set_Uint14 (Id, UI_From_Int (V));
4520 end Init_Normalized_Position;
4522 procedure Init_Normalized_Position_Max (Id : E) is
4523 begin
4524 Set_Uint10 (Id, No_Uint);
4525 end Init_Normalized_Position_Max;
4527 procedure Init_Normalized_Position_Max (Id : E; V : Int) is
4528 begin
4529 Set_Uint10 (Id, UI_From_Int (V));
4530 end Init_Normalized_Position_Max;
4532 procedure Init_RM_Size (Id : E) is
4533 begin
4534 Set_Uint13 (Id, Uint_0);
4535 end Init_RM_Size;
4537 procedure Init_RM_Size (Id : E; V : Int) is
4538 begin
4539 Set_Uint13 (Id, UI_From_Int (V));
4540 end Init_RM_Size;
4542 -----------------------------
4543 -- Init_Component_Location --
4544 -----------------------------
4546 procedure Init_Component_Location (Id : E) is
4547 begin
4548 Set_Uint8 (Id, No_Uint); -- Normalized_First_Bit
4549 Set_Uint10 (Id, No_Uint); -- Normalized_Position_Max
4550 Set_Uint11 (Id, No_Uint); -- Component_First_Bit
4551 Set_Uint12 (Id, Uint_0); -- Esize
4552 Set_Uint14 (Id, No_Uint); -- Normalized_Position
4553 end Init_Component_Location;
4555 ---------------
4556 -- Init_Size --
4557 ---------------
4559 procedure Init_Size (Id : E; V : Int) is
4560 begin
4561 Set_Uint12 (Id, UI_From_Int (V)); -- Esize
4562 Set_Uint13 (Id, UI_From_Int (V)); -- RM_Size
4563 end Init_Size;
4565 ---------------------
4566 -- Init_Size_Align --
4567 ---------------------
4569 procedure Init_Size_Align (Id : E) is
4570 begin
4571 Set_Uint12 (Id, Uint_0); -- Esize
4572 Set_Uint13 (Id, Uint_0); -- RM_Size
4573 Set_Uint14 (Id, Uint_0); -- Alignment
4574 end Init_Size_Align;
4576 ----------------------------------------------
4577 -- Type Representation Attribute Predicates --
4578 ----------------------------------------------
4580 function Known_Alignment (E : Entity_Id) return B is
4581 begin
4582 return Uint14 (E) /= Uint_0
4583 and then Uint14 (E) /= No_Uint;
4584 end Known_Alignment;
4586 function Known_Component_Bit_Offset (E : Entity_Id) return B is
4587 begin
4588 return Uint11 (E) /= No_Uint;
4589 end Known_Component_Bit_Offset;
4591 function Known_Component_Size (E : Entity_Id) return B is
4592 begin
4593 return Uint22 (Base_Type (E)) /= Uint_0
4594 and then Uint22 (Base_Type (E)) /= No_Uint;
4595 end Known_Component_Size;
4597 function Known_Esize (E : Entity_Id) return B is
4598 begin
4599 return Uint12 (E) /= Uint_0
4600 and then Uint12 (E) /= No_Uint;
4601 end Known_Esize;
4603 function Known_Normalized_First_Bit (E : Entity_Id) return B is
4604 begin
4605 return Uint8 (E) /= No_Uint;
4606 end Known_Normalized_First_Bit;
4608 function Known_Normalized_Position (E : Entity_Id) return B is
4609 begin
4610 return Uint14 (E) /= No_Uint;
4611 end Known_Normalized_Position;
4613 function Known_Normalized_Position_Max (E : Entity_Id) return B is
4614 begin
4615 return Uint10 (E) /= No_Uint;
4616 end Known_Normalized_Position_Max;
4618 function Known_RM_Size (E : Entity_Id) return B is
4619 begin
4620 return Uint13 (E) /= No_Uint
4621 and then (Uint13 (E) /= Uint_0
4622 or else Is_Discrete_Type (E)
4623 or else Is_Fixed_Point_Type (E));
4624 end Known_RM_Size;
4626 function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is
4627 begin
4628 return Uint11 (E) /= No_Uint
4629 and then Uint11 (E) >= Uint_0;
4630 end Known_Static_Component_Bit_Offset;
4632 function Known_Static_Component_Size (E : Entity_Id) return B is
4633 begin
4634 return Uint22 (Base_Type (E)) > Uint_0;
4635 end Known_Static_Component_Size;
4637 function Known_Static_Esize (E : Entity_Id) return B is
4638 begin
4639 return Uint12 (E) > Uint_0;
4640 end Known_Static_Esize;
4642 function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is
4643 begin
4644 return Uint8 (E) /= No_Uint
4645 and then Uint8 (E) >= Uint_0;
4646 end Known_Static_Normalized_First_Bit;
4648 function Known_Static_Normalized_Position (E : Entity_Id) return B is
4649 begin
4650 return Uint14 (E) /= No_Uint
4651 and then Uint14 (E) >= Uint_0;
4652 end Known_Static_Normalized_Position;
4654 function Known_Static_Normalized_Position_Max (E : Entity_Id) return B is
4655 begin
4656 return Uint10 (E) /= No_Uint
4657 and then Uint10 (E) >= Uint_0;
4658 end Known_Static_Normalized_Position_Max;
4660 function Known_Static_RM_Size (E : Entity_Id) return B is
4661 begin
4662 return Uint13 (E) > Uint_0
4663 or else Is_Discrete_Type (E)
4664 or else Is_Fixed_Point_Type (E);
4665 end Known_Static_RM_Size;
4667 function Unknown_Alignment (E : Entity_Id) return B is
4668 begin
4669 return Uint14 (E) = Uint_0
4670 or else Uint14 (E) = No_Uint;
4671 end Unknown_Alignment;
4673 function Unknown_Component_Bit_Offset (E : Entity_Id) return B is
4674 begin
4675 return Uint11 (E) = No_Uint;
4676 end Unknown_Component_Bit_Offset;
4678 function Unknown_Component_Size (E : Entity_Id) return B is
4679 begin
4680 return Uint22 (Base_Type (E)) = Uint_0
4681 or else
4682 Uint22 (Base_Type (E)) = No_Uint;
4683 end Unknown_Component_Size;
4685 function Unknown_Esize (E : Entity_Id) return B is
4686 begin
4687 return Uint12 (E) = No_Uint
4688 or else
4689 Uint12 (E) = Uint_0;
4690 end Unknown_Esize;
4692 function Unknown_Normalized_First_Bit (E : Entity_Id) return B is
4693 begin
4694 return Uint8 (E) = No_Uint;
4695 end Unknown_Normalized_First_Bit;
4697 function Unknown_Normalized_Position (E : Entity_Id) return B is
4698 begin
4699 return Uint14 (E) = No_Uint;
4700 end Unknown_Normalized_Position;
4702 function Unknown_Normalized_Position_Max (E : Entity_Id) return B is
4703 begin
4704 return Uint10 (E) = No_Uint;
4705 end Unknown_Normalized_Position_Max;
4707 function Unknown_RM_Size (E : Entity_Id) return B is
4708 begin
4709 return (Uint13 (E) = Uint_0
4710 and then not Is_Discrete_Type (E)
4711 and then not Is_Fixed_Point_Type (E))
4712 or else Uint13 (E) = No_Uint;
4713 end Unknown_RM_Size;
4715 --------------------
4716 -- Address_Clause --
4717 --------------------
4719 function Address_Clause (Id : E) return N is
4720 begin
4721 return Rep_Clause (Id, Name_Address);
4722 end Address_Clause;
4724 ----------------------
4725 -- Alignment_Clause --
4726 ----------------------
4728 function Alignment_Clause (Id : E) return N is
4729 begin
4730 return Rep_Clause (Id, Name_Alignment);
4731 end Alignment_Clause;
4733 ----------------------
4734 -- Ancestor_Subtype --
4735 ----------------------
4737 function Ancestor_Subtype (Id : E) return E is
4738 begin
4739 -- If this is first subtype, or is a base type, then there is no
4740 -- ancestor subtype, so we return Empty to indicate this fact.
4742 if Is_First_Subtype (Id) or else Id = Base_Type (Id) then
4743 return Empty;
4744 end if;
4746 declare
4747 D : constant Node_Id := Declaration_Node (Id);
4749 begin
4750 -- If we have a subtype declaration, get the ancestor subtype
4752 if Nkind (D) = N_Subtype_Declaration then
4753 if Nkind (Subtype_Indication (D)) = N_Subtype_Indication then
4754 return Entity (Subtype_Mark (Subtype_Indication (D)));
4755 else
4756 return Entity (Subtype_Indication (D));
4757 end if;
4759 -- If not, then no subtype indication is available
4761 else
4762 return Empty;
4763 end if;
4764 end;
4765 end Ancestor_Subtype;
4767 -------------------
4768 -- Append_Entity --
4769 -------------------
4771 procedure Append_Entity (Id : Entity_Id; V : Entity_Id) is
4772 begin
4773 if Last_Entity (V) = Empty then
4774 Set_First_Entity (V, Id);
4775 else
4776 Set_Next_Entity (Last_Entity (V), Id);
4777 end if;
4779 Set_Next_Entity (Id, Empty);
4780 Set_Scope (Id, V);
4781 Set_Last_Entity (V, Id);
4782 end Append_Entity;
4784 ---------------
4785 -- Base_Type --
4786 ---------------
4788 function Base_Type (Id : E) return E is
4789 begin
4790 case Ekind (Id) is
4791 when E_Enumeration_Subtype |
4792 E_Incomplete_Type |
4793 E_Signed_Integer_Subtype |
4794 E_Modular_Integer_Subtype |
4795 E_Floating_Point_Subtype |
4796 E_Ordinary_Fixed_Point_Subtype |
4797 E_Decimal_Fixed_Point_Subtype |
4798 E_Array_Subtype |
4799 E_String_Subtype |
4800 E_Record_Subtype |
4801 E_Private_Subtype |
4802 E_Record_Subtype_With_Private |
4803 E_Limited_Private_Subtype |
4804 E_Access_Subtype |
4805 E_Protected_Subtype |
4806 E_Task_Subtype |
4807 E_String_Literal_Subtype |
4808 E_Class_Wide_Subtype =>
4809 return Etype (Id);
4811 when others =>
4812 return Id;
4813 end case;
4814 end Base_Type;
4816 -------------------------
4817 -- Component_Alignment --
4818 -------------------------
4820 -- Component Alignment is encoded using two flags, Flag128/129 as
4821 -- follows. Note that both flags False = Align_Default, so that the
4822 -- default initialization of flags to False initializes component
4823 -- alignment to the default value as required.
4825 -- Flag128 Flag129 Value
4826 -- ------- ------- -----
4827 -- False False Calign_Default
4828 -- False True Calign_Component_Size
4829 -- True False Calign_Component_Size_4
4830 -- True True Calign_Storage_Unit
4832 function Component_Alignment (Id : E) return C is
4833 BT : constant Node_Id := Base_Type (Id);
4835 begin
4836 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
4838 if Flag128 (BT) then
4839 if Flag129 (BT) then
4840 return Calign_Storage_Unit;
4841 else
4842 return Calign_Component_Size_4;
4843 end if;
4845 else
4846 if Flag129 (BT) then
4847 return Calign_Component_Size;
4848 else
4849 return Calign_Default;
4850 end if;
4851 end if;
4852 end Component_Alignment;
4854 --------------------
4855 -- Constant_Value --
4856 --------------------
4858 function Constant_Value (Id : E) return N is
4859 D : constant Node_Id := Declaration_Node (Id);
4860 Full_D : Node_Id;
4862 begin
4863 -- If we have no declaration node, then return no constant value.
4864 -- Not clear how this can happen, but it does sometimes ???
4865 -- To investigate, remove this check and compile discrim_po.adb.
4867 if No (D) then
4868 return Empty;
4870 -- Normal case where a declaration node is present
4872 elsif Nkind (D) = N_Object_Renaming_Declaration then
4873 return Renamed_Object (Id);
4875 -- If this is a component declaration whose entity is constant, it
4876 -- is a prival within a protected function. It does not have
4877 -- a constant value.
4879 elsif Nkind (D) = N_Component_Declaration then
4880 return Empty;
4882 -- If there is an expression, return it
4884 elsif Present (Expression (D)) then
4885 return (Expression (D));
4887 -- For a constant, see if we have a full view
4889 elsif Ekind (Id) = E_Constant
4890 and then Present (Full_View (Id))
4891 then
4892 Full_D := Parent (Full_View (Id));
4894 -- The full view may have been rewritten as an object renaming
4896 if Nkind (Full_D) = N_Object_Renaming_Declaration then
4897 return Name (Full_D);
4898 else
4899 return Expression (Full_D);
4900 end if;
4902 -- Otherwise we have no expression to return
4904 else
4905 return Empty;
4906 end if;
4907 end Constant_Value;
4909 ----------------------
4910 -- Declaration_Node --
4911 ----------------------
4913 function Declaration_Node (Id : E) return N is
4914 P : Node_Id;
4916 begin
4917 if Ekind (Id) = E_Incomplete_Type
4918 and then Present (Full_View (Id))
4919 then
4920 P := Parent (Full_View (Id));
4921 else
4922 P := Parent (Id);
4923 end if;
4925 loop
4926 if Nkind (P) /= N_Selected_Component
4927 and then Nkind (P) /= N_Expanded_Name
4928 and then
4929 not (Nkind (P) = N_Defining_Program_Unit_Name
4930 and then Is_Child_Unit (Id))
4931 then
4932 return P;
4933 else
4934 P := Parent (P);
4935 end if;
4936 end loop;
4938 end Declaration_Node;
4940 ---------------------
4941 -- Designated_Type --
4942 ---------------------
4944 function Designated_Type (Id : E) return E is
4945 Desig_Type : E;
4947 begin
4948 Desig_Type := Directly_Designated_Type (Id);
4950 if Ekind (Desig_Type) = E_Incomplete_Type
4951 and then Present (Full_View (Desig_Type))
4952 then
4953 return Full_View (Desig_Type);
4955 elsif Is_Class_Wide_Type (Desig_Type)
4956 and then Ekind (Etype (Desig_Type)) = E_Incomplete_Type
4957 and then Present (Full_View (Etype (Desig_Type)))
4958 and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type))))
4959 then
4960 return Class_Wide_Type (Full_View (Etype (Desig_Type)));
4962 else
4963 return Desig_Type;
4964 end if;
4965 end Designated_Type;
4967 -----------------------------
4968 -- Enclosing_Dynamic_Scope --
4969 -----------------------------
4971 function Enclosing_Dynamic_Scope (Id : E) return E is
4972 S : Entity_Id;
4974 begin
4975 -- The following test is an error defense against some syntax
4976 -- errors that can leave scopes very messed up.
4978 if Id = Standard_Standard then
4979 return Id;
4980 end if;
4982 -- Normal case, search enclosing scopes
4984 S := Scope (Id);
4985 while S /= Standard_Standard
4986 and then not Is_Dynamic_Scope (S)
4987 loop
4988 S := Scope (S);
4989 end loop;
4991 return S;
4992 end Enclosing_Dynamic_Scope;
4994 ----------------------
4995 -- Entry_Index_Type --
4996 ----------------------
4998 function Entry_Index_Type (Id : E) return N is
4999 begin
5000 pragma Assert (Ekind (Id) = E_Entry_Family);
5001 return Etype (Discrete_Subtype_Definition (Parent (Id)));
5002 end Entry_Index_Type;
5004 ---------------------
5005 -- 1 --
5006 ---------------------
5008 function First_Component (Id : E) return E is
5009 Comp_Id : E;
5011 begin
5012 pragma Assert
5013 (Is_Record_Type (Id) or else Is_Incomplete_Or_Private_Type (Id));
5015 Comp_Id := First_Entity (Id);
5016 while Present (Comp_Id) loop
5017 exit when Ekind (Comp_Id) = E_Component;
5018 Comp_Id := Next_Entity (Comp_Id);
5019 end loop;
5021 return Comp_Id;
5022 end First_Component;
5024 ------------------------
5025 -- First_Discriminant --
5026 ------------------------
5028 function First_Discriminant (Id : E) return E is
5029 Ent : Entity_Id;
5031 begin
5032 pragma Assert
5033 (Has_Discriminants (Id)
5034 or else Has_Unknown_Discriminants (Id));
5036 Ent := First_Entity (Id);
5038 -- The discriminants are not necessarily contiguous, because access
5039 -- discriminants will generate itypes. They are not the first entities
5040 -- either, because tag and controller record must be ahead of them.
5042 if Chars (Ent) = Name_uTag then
5043 Ent := Next_Entity (Ent);
5044 end if;
5046 if Chars (Ent) = Name_uController then
5047 Ent := Next_Entity (Ent);
5048 end if;
5050 -- Skip all hidden stored discriminants if any
5052 while Present (Ent) loop
5053 exit when Ekind (Ent) = E_Discriminant
5054 and then not Is_Completely_Hidden (Ent);
5056 Ent := Next_Entity (Ent);
5057 end loop;
5059 pragma Assert (Ekind (Ent) = E_Discriminant);
5061 return Ent;
5062 end First_Discriminant;
5064 ------------------
5065 -- First_Formal --
5066 ------------------
5068 function First_Formal (Id : E) return E is
5069 Formal : E;
5071 begin
5072 pragma Assert
5073 (Is_Overloadable (Id)
5074 or else Ekind (Id) = E_Entry_Family
5075 or else Ekind (Id) = E_Subprogram_Body
5076 or else Ekind (Id) = E_Subprogram_Type);
5078 if Ekind (Id) = E_Enumeration_Literal then
5079 return Empty;
5081 else
5082 Formal := First_Entity (Id);
5084 if Present (Formal) and then Is_Formal (Formal) then
5085 return Formal;
5086 else
5087 return Empty;
5088 end if;
5089 end if;
5090 end First_Formal;
5092 -------------------------------
5093 -- First_Stored_Discriminant --
5094 -------------------------------
5096 function First_Stored_Discriminant (Id : E) return E is
5097 Ent : Entity_Id;
5099 function Has_Completely_Hidden_Discriminant (Id : E) return Boolean;
5100 -- Scans the Discriminants to see whether any are Completely_Hidden
5101 -- (the mechanism for describing non-specified stored discriminants)
5103 ----------------------------------------
5104 -- Has_Completely_Hidden_Discriminant --
5105 ----------------------------------------
5107 function Has_Completely_Hidden_Discriminant (Id : E) return Boolean is
5108 Ent : Entity_Id := Id;
5110 begin
5111 pragma Assert (Ekind (Id) = E_Discriminant);
5113 while Present (Ent) and then Ekind (Ent) = E_Discriminant loop
5114 if Is_Completely_Hidden (Ent) then
5115 return True;
5116 end if;
5118 Ent := Next_Entity (Ent);
5119 end loop;
5121 return False;
5122 end Has_Completely_Hidden_Discriminant;
5124 -- Start of processing for First_Stored_Discriminant
5126 begin
5127 pragma Assert
5128 (Has_Discriminants (Id)
5129 or else Has_Unknown_Discriminants (Id));
5131 Ent := First_Entity (Id);
5133 if Chars (Ent) = Name_uTag then
5134 Ent := Next_Entity (Ent);
5135 end if;
5137 if Chars (Ent) = Name_uController then
5138 Ent := Next_Entity (Ent);
5139 end if;
5141 if Has_Completely_Hidden_Discriminant (Ent) then
5143 while Present (Ent) loop
5144 exit when Is_Completely_Hidden (Ent);
5145 Ent := Next_Entity (Ent);
5146 end loop;
5148 end if;
5150 pragma Assert (Ekind (Ent) = E_Discriminant);
5152 return Ent;
5153 end First_Stored_Discriminant;
5155 -------------------
5156 -- First_Subtype --
5157 -------------------
5159 function First_Subtype (Id : E) return E is
5160 B : constant Entity_Id := Base_Type (Id);
5161 F : constant Node_Id := Freeze_Node (B);
5162 Ent : Entity_Id;
5164 begin
5165 -- If the base type has no freeze node, it is a type in standard,
5166 -- and always acts as its own first subtype unless it is one of
5167 -- the predefined integer types. If the type is formal, it is also
5168 -- a first subtype, and its base type has no freeze node. On the other
5169 -- hand, a subtype of a generic formal is not its own first_subtype.
5170 -- Its base type, if anonymous, is attached to the formal type decl.
5171 -- from which the first subtype is obtained.
5173 if No (F) then
5175 if B = Base_Type (Standard_Integer) then
5176 return Standard_Integer;
5178 elsif B = Base_Type (Standard_Long_Integer) then
5179 return Standard_Long_Integer;
5181 elsif B = Base_Type (Standard_Short_Short_Integer) then
5182 return Standard_Short_Short_Integer;
5184 elsif B = Base_Type (Standard_Short_Integer) then
5185 return Standard_Short_Integer;
5187 elsif B = Base_Type (Standard_Long_Long_Integer) then
5188 return Standard_Long_Long_Integer;
5190 elsif Is_Generic_Type (Id) then
5191 if Present (Parent (B)) then
5192 return Defining_Identifier (Parent (B));
5193 else
5194 return Defining_Identifier (Associated_Node_For_Itype (B));
5195 end if;
5197 else
5198 return B;
5199 end if;
5201 -- Otherwise we check the freeze node, if it has a First_Subtype_Link
5202 -- then we use that link, otherwise (happens with some Itypes), we use
5203 -- the base type itself.
5205 else
5206 Ent := First_Subtype_Link (F);
5208 if Present (Ent) then
5209 return Ent;
5210 else
5211 return B;
5212 end if;
5213 end if;
5214 end First_Subtype;
5216 -------------------------------------
5217 -- Get_Attribute_Definition_Clause --
5218 -------------------------------------
5220 function Get_Attribute_Definition_Clause
5221 (E : Entity_Id;
5222 Id : Attribute_Id) return Node_Id
5224 N : Node_Id;
5226 begin
5227 N := First_Rep_Item (E);
5228 while Present (N) loop
5229 if Nkind (N) = N_Attribute_Definition_Clause
5230 and then Get_Attribute_Id (Chars (N)) = Id
5231 then
5232 return N;
5233 else
5234 Next_Rep_Item (N);
5235 end if;
5236 end loop;
5238 return Empty;
5239 end Get_Attribute_Definition_Clause;
5241 --------------------
5242 -- Get_Rep_Pragma --
5243 --------------------
5245 function Get_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Node_Id is
5246 N : Node_Id;
5248 begin
5249 N := First_Rep_Item (E);
5250 while Present (N) loop
5251 if Nkind (N) = N_Pragma and then Chars (N) = Nam then
5252 return N;
5253 end if;
5255 Next_Rep_Item (N);
5256 end loop;
5258 return Empty;
5259 end Get_Rep_Pragma;
5261 ------------------------
5262 -- Has_Attach_Handler --
5263 ------------------------
5265 function Has_Attach_Handler (Id : E) return B is
5266 Ritem : Node_Id;
5268 begin
5269 pragma Assert (Is_Protected_Type (Id));
5271 Ritem := First_Rep_Item (Id);
5272 while Present (Ritem) loop
5273 if Nkind (Ritem) = N_Pragma
5274 and then Chars (Ritem) = Name_Attach_Handler
5275 then
5276 return True;
5277 else
5278 Ritem := Next_Rep_Item (Ritem);
5279 end if;
5280 end loop;
5282 return False;
5283 end Has_Attach_Handler;
5285 -------------------------------------
5286 -- Has_Attribute_Definition_Clause --
5287 -------------------------------------
5289 function Has_Attribute_Definition_Clause
5290 (E : Entity_Id;
5291 Id : Attribute_Id) return Boolean
5293 begin
5294 return Present (Get_Attribute_Definition_Clause (E, Id));
5295 end Has_Attribute_Definition_Clause;
5297 -----------------
5298 -- Has_Entries --
5299 -----------------
5301 function Has_Entries (Id : E) return B is
5302 Result : Boolean := False;
5303 Ent : Entity_Id;
5305 begin
5306 pragma Assert (Is_Concurrent_Type (Id));
5308 Ent := First_Entity (Id);
5309 while Present (Ent) loop
5310 if Is_Entry (Ent) then
5311 Result := True;
5312 exit;
5313 end if;
5315 Ent := Next_Entity (Ent);
5316 end loop;
5318 return Result;
5319 end Has_Entries;
5321 ----------------------------
5322 -- Has_Foreign_Convention --
5323 ----------------------------
5325 function Has_Foreign_Convention (Id : E) return B is
5326 begin
5327 return Convention (Id) >= Foreign_Convention'First;
5328 end Has_Foreign_Convention;
5330 ---------------------------
5331 -- Has_Interrupt_Handler --
5332 ---------------------------
5334 function Has_Interrupt_Handler (Id : E) return B is
5335 Ritem : Node_Id;
5337 begin
5338 pragma Assert (Is_Protected_Type (Id));
5340 Ritem := First_Rep_Item (Id);
5341 while Present (Ritem) loop
5342 if Nkind (Ritem) = N_Pragma
5343 and then Chars (Ritem) = Name_Interrupt_Handler
5344 then
5345 return True;
5346 else
5347 Ritem := Next_Rep_Item (Ritem);
5348 end if;
5349 end loop;
5351 return False;
5352 end Has_Interrupt_Handler;
5354 --------------------------
5355 -- Has_Private_Ancestor --
5356 --------------------------
5358 function Has_Private_Ancestor (Id : E) return B is
5359 R : constant Entity_Id := Root_Type (Id);
5360 T1 : Entity_Id := Id;
5362 begin
5363 loop
5364 if Is_Private_Type (T1) then
5365 return True;
5367 elsif T1 = R then
5368 return False;
5370 else
5371 T1 := Etype (T1);
5372 end if;
5373 end loop;
5374 end Has_Private_Ancestor;
5376 --------------------
5377 -- Has_Rep_Pragma --
5378 --------------------
5380 function Has_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Boolean is
5381 begin
5382 return Present (Get_Rep_Pragma (E, Nam));
5383 end Has_Rep_Pragma;
5385 ------------------------------
5386 -- Implementation_Base_Type --
5387 ------------------------------
5389 function Implementation_Base_Type (Id : E) return E is
5390 Bastyp : Entity_Id;
5391 Imptyp : Entity_Id;
5393 begin
5394 Bastyp := Base_Type (Id);
5396 if Is_Incomplete_Or_Private_Type (Bastyp) then
5397 Imptyp := Underlying_Type (Bastyp);
5399 -- If we have an implementation type, then just return it,
5400 -- otherwise we return the Base_Type anyway. This can only
5401 -- happen in error situations and should avoid some error bombs.
5403 if Present (Imptyp) then
5404 return Base_Type (Imptyp);
5405 else
5406 return Bastyp;
5407 end if;
5409 else
5410 return Bastyp;
5411 end if;
5412 end Implementation_Base_Type;
5414 -----------------------
5415 -- Is_Always_Inlined --
5416 -----------------------
5418 function Is_Always_Inlined (Id : E) return B is
5419 Item : Node_Id;
5421 begin
5422 Item := First_Rep_Item (Id);
5423 while Present (Item) loop
5424 if Nkind (Item) = N_Pragma
5425 and then Get_Pragma_Id (Chars (Item)) = Pragma_Inline_Always
5426 then
5427 return True;
5428 end if;
5430 Next_Rep_Item (Item);
5431 end loop;
5433 return False;
5434 end Is_Always_Inlined;
5436 ---------------------
5437 -- Is_Boolean_Type --
5438 ---------------------
5440 function Is_Boolean_Type (Id : E) return B is
5441 begin
5442 return Root_Type (Id) = Standard_Boolean;
5443 end Is_Boolean_Type;
5445 ---------------------
5446 -- Is_By_Copy_Type --
5447 ---------------------
5449 function Is_By_Copy_Type (Id : E) return B is
5450 begin
5451 -- If Id is a private type whose full declaration has not been seen,
5452 -- we assume for now that it is not a By_Copy type. Clearly this
5453 -- attribute should not be used before the type is frozen, but it is
5454 -- needed to build the associated record of a protected type. Another
5455 -- place where some lookahead for a full view is needed ???
5457 return
5458 Is_Elementary_Type (Id)
5459 or else (Is_Private_Type (Id)
5460 and then Present (Underlying_Type (Id))
5461 and then Is_Elementary_Type (Underlying_Type (Id)));
5462 end Is_By_Copy_Type;
5464 --------------------------
5465 -- Is_By_Reference_Type --
5466 --------------------------
5468 function Is_By_Reference_Type (Id : E) return B is
5469 Btype : constant Entity_Id := Base_Type (Id);
5471 begin
5472 if Error_Posted (Id)
5473 or else Error_Posted (Btype)
5474 then
5475 return False;
5477 elsif Is_Private_Type (Btype) then
5478 declare
5479 Utyp : constant Entity_Id := Underlying_Type (Btype);
5481 begin
5482 if No (Utyp) then
5483 return False;
5484 else
5485 return Is_By_Reference_Type (Utyp);
5486 end if;
5487 end;
5489 elsif Is_Concurrent_Type (Btype) then
5490 return True;
5492 elsif Is_Record_Type (Btype) then
5493 if Is_Limited_Record (Btype)
5494 or else Is_Tagged_Type (Btype)
5495 or else Is_Volatile (Btype)
5496 then
5497 return True;
5499 else
5500 declare
5501 C : Entity_Id;
5503 begin
5504 C := First_Component (Btype);
5505 while Present (C) loop
5506 if Is_By_Reference_Type (Etype (C))
5507 or else Is_Volatile (Etype (C))
5508 then
5509 return True;
5510 end if;
5512 C := Next_Component (C);
5513 end loop;
5514 end;
5516 return False;
5517 end if;
5519 elsif Is_Array_Type (Btype) then
5520 return
5521 Is_Volatile (Btype)
5522 or else Is_By_Reference_Type (Component_Type (Btype))
5523 or else Is_Volatile (Component_Type (Btype))
5524 or else Has_Volatile_Components (Btype);
5526 else
5527 return False;
5528 end if;
5529 end Is_By_Reference_Type;
5531 ---------------------
5532 -- Is_Derived_Type --
5533 ---------------------
5535 function Is_Derived_Type (Id : E) return B is
5536 Par : Node_Id;
5538 begin
5539 if Base_Type (Id) /= Root_Type (Id)
5540 and then not Is_Generic_Type (Id)
5541 and then not Is_Class_Wide_Type (Id)
5542 then
5543 if not Is_Numeric_Type (Root_Type (Id)) then
5544 return True;
5546 else
5547 Par := Parent (First_Subtype (Id));
5549 return Present (Par)
5550 and then Nkind (Par) = N_Full_Type_Declaration
5551 and then Nkind (Type_Definition (Par))
5552 = N_Derived_Type_Definition;
5553 end if;
5555 else
5556 return False;
5557 end if;
5558 end Is_Derived_Type;
5560 ----------------------
5561 -- Is_Dynamic_Scope --
5562 ----------------------
5564 function Is_Dynamic_Scope (Id : E) return B is
5565 begin
5566 return
5567 Ekind (Id) = E_Block
5568 or else
5569 Ekind (Id) = E_Function
5570 or else
5571 Ekind (Id) = E_Procedure
5572 or else
5573 Ekind (Id) = E_Subprogram_Body
5574 or else
5575 Ekind (Id) = E_Task_Type
5576 or else
5577 Ekind (Id) = E_Entry
5578 or else
5579 Ekind (Id) = E_Entry_Family;
5580 end Is_Dynamic_Scope;
5582 --------------------
5583 -- Is_Entity_Name --
5584 --------------------
5586 function Is_Entity_Name (N : Node_Id) return Boolean is
5587 Kind : constant Node_Kind := Nkind (N);
5589 begin
5590 -- Identifiers, operator symbols, expanded names are entity names
5592 return Kind = N_Identifier
5593 or else Kind = N_Operator_Symbol
5594 or else Kind = N_Expanded_Name
5596 -- Attribute references are entity names if they refer to an entity.
5597 -- Note that we don't do this by testing for the presence of the
5598 -- Entity field in the N_Attribute_Reference node, since it may not
5599 -- have been set yet.
5601 or else (Kind = N_Attribute_Reference
5602 and then Is_Entity_Attribute_Name (Attribute_Name (N)));
5603 end Is_Entity_Name;
5605 ---------------------------
5606 -- Is_Indefinite_Subtype --
5607 ---------------------------
5609 function Is_Indefinite_Subtype (Id : Entity_Id) return B is
5610 K : constant Entity_Kind := Ekind (Id);
5612 begin
5613 if Is_Constrained (Id) then
5614 return False;
5616 elsif K in Array_Kind
5617 or else K in Class_Wide_Kind
5618 or else Has_Unknown_Discriminants (Id)
5619 then
5620 return True;
5622 -- Known discriminants: indefinite if there are no default values
5624 elsif K in Record_Kind
5625 or else Is_Incomplete_Or_Private_Type (Id)
5626 or else Is_Concurrent_Type (Id)
5627 then
5628 return (Has_Discriminants (Id)
5629 and then No (Discriminant_Default_Value (First_Discriminant (Id))));
5631 else
5632 return False;
5633 end if;
5634 end Is_Indefinite_Subtype;
5636 ---------------------
5637 -- Is_Limited_Type --
5638 ---------------------
5640 function Is_Limited_Type (Id : E) return B is
5641 Btype : constant E := Base_Type (Id);
5643 begin
5644 if not Is_Type (Id) then
5645 return False;
5647 elsif Ekind (Btype) = E_Limited_Private_Type
5648 or else Is_Limited_Composite (Btype)
5649 then
5650 return True;
5652 elsif Is_Concurrent_Type (Btype) then
5653 return True;
5655 -- Otherwise we will look around to see if there is some other reason
5656 -- for it to be limited, except that if an error was posted on the
5657 -- entity, then just assume it is non-limited, because it can cause
5658 -- trouble to recurse into a murky erroneous entity!
5660 elsif Error_Posted (Id) then
5661 return False;
5663 elsif Is_Record_Type (Btype) then
5664 if Is_Limited_Record (Root_Type (Btype)) then
5665 return True;
5667 elsif Is_Class_Wide_Type (Btype) then
5668 return Is_Limited_Type (Root_Type (Btype));
5670 else
5671 declare
5672 C : E;
5674 begin
5675 C := First_Component (Btype);
5676 while Present (C) loop
5677 if Is_Limited_Type (Etype (C)) then
5678 return True;
5679 end if;
5681 C := Next_Component (C);
5682 end loop;
5683 end;
5685 return False;
5686 end if;
5688 elsif Is_Array_Type (Btype) then
5689 return Is_Limited_Type (Component_Type (Btype));
5691 else
5692 return False;
5693 end if;
5694 end Is_Limited_Type;
5696 ----------------
5697 -- Is_Package --
5698 ----------------
5700 function Is_Package (Id : E) return B is
5701 begin
5702 return
5703 Ekind (Id) = E_Package
5704 or else
5705 Ekind (Id) = E_Generic_Package;
5706 end Is_Package;
5708 --------------------------
5709 -- Is_Protected_Private --
5710 --------------------------
5712 function Is_Protected_Private (Id : E) return B is
5713 begin
5714 pragma Assert (Ekind (Id) = E_Component);
5715 return Is_Protected_Type (Scope (Id));
5716 end Is_Protected_Private;
5718 ------------------------------
5719 -- Is_Protected_Record_Type --
5720 ------------------------------
5722 function Is_Protected_Record_Type (Id : E) return B is
5723 begin
5724 return
5725 Is_Concurrent_Record_Type (Id)
5726 and then Is_Protected_Type (Corresponding_Concurrent_Type (Id));
5727 end Is_Protected_Record_Type;
5729 ---------------------------------
5730 -- Is_Return_By_Reference_Type --
5731 ---------------------------------
5733 function Is_Return_By_Reference_Type (Id : E) return B is
5734 Btype : constant Entity_Id := Base_Type (Id);
5736 begin
5737 if Is_Private_Type (Btype) then
5738 declare
5739 Utyp : constant Entity_Id := Underlying_Type (Btype);
5741 begin
5742 if No (Utyp) then
5743 return False;
5744 else
5745 return Is_Return_By_Reference_Type (Utyp);
5746 end if;
5747 end;
5749 elsif Is_Concurrent_Type (Btype) then
5750 return True;
5752 elsif Is_Record_Type (Btype) then
5753 if Is_Limited_Record (Btype) then
5754 return True;
5756 elsif Is_Class_Wide_Type (Btype) then
5757 return Is_Return_By_Reference_Type (Root_Type (Btype));
5759 else
5760 declare
5761 C : Entity_Id;
5763 begin
5764 C := First_Component (Btype);
5765 while Present (C) loop
5766 if Is_Return_By_Reference_Type (Etype (C)) then
5767 return True;
5768 end if;
5770 C := Next_Component (C);
5771 end loop;
5772 end;
5774 return False;
5775 end if;
5777 elsif Is_Array_Type (Btype) then
5778 return Is_Return_By_Reference_Type (Component_Type (Btype));
5780 else
5781 return False;
5782 end if;
5783 end Is_Return_By_Reference_Type;
5785 --------------------
5786 -- Is_String_Type --
5787 --------------------
5789 function Is_String_Type (Id : E) return B is
5790 begin
5791 return Ekind (Id) in String_Kind
5792 or else (Is_Array_Type (Id)
5793 and then Number_Dimensions (Id) = 1
5794 and then Is_Character_Type (Component_Type (Id)));
5795 end Is_String_Type;
5797 -------------------------
5798 -- Is_Task_Record_Type --
5799 -------------------------
5801 function Is_Task_Record_Type (Id : E) return B is
5802 begin
5803 return
5804 Is_Concurrent_Record_Type (Id)
5805 and then Is_Task_Type (Corresponding_Concurrent_Type (Id));
5806 end Is_Task_Record_Type;
5808 ------------------------
5809 -- Is_Wrapper_Package --
5810 ------------------------
5812 function Is_Wrapper_Package (Id : E) return B is
5813 begin
5814 return (Ekind (Id) = E_Package
5815 and then Present (Related_Instance (Id)));
5816 end Is_Wrapper_Package;
5818 --------------------
5819 -- Next_Component --
5820 --------------------
5822 function Next_Component (Id : E) return E is
5823 Comp_Id : E;
5825 begin
5826 Comp_Id := Next_Entity (Id);
5827 while Present (Comp_Id) loop
5828 exit when Ekind (Comp_Id) = E_Component;
5829 Comp_Id := Next_Entity (Comp_Id);
5830 end loop;
5832 return Comp_Id;
5833 end Next_Component;
5835 -----------------------
5836 -- Next_Discriminant --
5837 -----------------------
5839 -- This function actually implements both Next_Discriminant and
5840 -- Next_Stored_Discriminant by making sure that the Discriminant
5841 -- returned is of the same variety as Id.
5843 function Next_Discriminant (Id : E) return E is
5845 -- Derived Tagged types with private extensions look like this...
5847 -- E_Discriminant d1
5848 -- E_Discriminant d2
5849 -- E_Component _tag
5850 -- E_Discriminant d1
5851 -- E_Discriminant d2
5852 -- ...
5854 -- so it is critical not to go past the leading discriminants
5856 D : E := Id;
5858 begin
5859 pragma Assert (Ekind (Id) = E_Discriminant);
5861 loop
5862 D := Next_Entity (D);
5863 if not Present (D)
5864 or else (Ekind (D) /= E_Discriminant
5865 and then not Is_Itype (D))
5866 then
5867 return Empty;
5868 end if;
5870 exit when Ekind (D) = E_Discriminant
5871 and then (Is_Completely_Hidden (D) = Is_Completely_Hidden (Id));
5872 end loop;
5874 return D;
5875 end Next_Discriminant;
5877 -----------------
5878 -- Next_Formal --
5879 -----------------
5881 function Next_Formal (Id : E) return E is
5882 P : E;
5884 begin
5885 -- Follow the chain of declared entities as long as the kind of
5886 -- the entity corresponds to a formal parameter. Skip internal
5887 -- entities that may have been created for implicit subtypes,
5888 -- in the process of analyzing default expressions.
5890 P := Id;
5892 loop
5893 P := Next_Entity (P);
5895 if No (P) or else Is_Formal (P) then
5896 return P;
5897 elsif not Is_Internal (P) then
5898 return Empty;
5899 end if;
5900 end loop;
5901 end Next_Formal;
5903 -----------------------------
5904 -- Next_Formal_With_Extras --
5905 -----------------------------
5907 function Next_Formal_With_Extras (Id : E) return E is
5908 begin
5909 if Present (Extra_Formal (Id)) then
5910 return Extra_Formal (Id);
5911 else
5912 return Next_Formal (Id);
5913 end if;
5914 end Next_Formal_With_Extras;
5916 ----------------
5917 -- Next_Index --
5918 ----------------
5920 function Next_Index (Id : Node_Id) return Node_Id is
5921 begin
5922 return Next (Id);
5923 end Next_Index;
5925 ------------------
5926 -- Next_Literal --
5927 ------------------
5929 function Next_Literal (Id : E) return E is
5930 begin
5931 pragma Assert (Nkind (Id) in N_Entity);
5932 return Next (Id);
5933 end Next_Literal;
5935 ------------------------------
5936 -- Next_Stored_Discriminant --
5937 ------------------------------
5939 function Next_Stored_Discriminant (Id : E) return E is
5940 begin
5941 -- See comment in Next_Discriminant
5943 return Next_Discriminant (Id);
5944 end Next_Stored_Discriminant;
5946 -----------------------
5947 -- Number_Dimensions --
5948 -----------------------
5950 function Number_Dimensions (Id : E) return Pos is
5951 N : Int;
5952 T : Node_Id;
5954 begin
5955 if Ekind (Id) in String_Kind then
5956 return 1;
5958 else
5959 N := 0;
5960 T := First_Index (Id);
5961 while Present (T) loop
5962 N := N + 1;
5963 T := Next (T);
5964 end loop;
5966 return N;
5967 end if;
5968 end Number_Dimensions;
5970 --------------------------
5971 -- Number_Discriminants --
5972 --------------------------
5974 function Number_Discriminants (Id : E) return Pos is
5975 N : Int;
5976 Discr : Entity_Id;
5978 begin
5979 N := 0;
5980 Discr := First_Discriminant (Id);
5981 while Present (Discr) loop
5982 N := N + 1;
5983 Discr := Next_Discriminant (Discr);
5984 end loop;
5986 return N;
5987 end Number_Discriminants;
5989 --------------------
5990 -- Number_Entries --
5991 --------------------
5993 function Number_Entries (Id : E) return Nat is
5994 N : Int;
5995 Ent : Entity_Id;
5997 begin
5998 pragma Assert (Is_Concurrent_Type (Id));
6000 N := 0;
6001 Ent := First_Entity (Id);
6002 while Present (Ent) loop
6003 if Is_Entry (Ent) then
6004 N := N + 1;
6005 end if;
6007 Ent := Next_Entity (Ent);
6008 end loop;
6010 return N;
6011 end Number_Entries;
6013 --------------------
6014 -- Number_Formals --
6015 --------------------
6017 function Number_Formals (Id : E) return Pos is
6018 N : Int;
6019 Formal : Entity_Id;
6021 begin
6022 N := 0;
6023 Formal := First_Formal (Id);
6024 while Present (Formal) loop
6025 N := N + 1;
6026 Formal := Next_Formal (Formal);
6027 end loop;
6029 return N;
6030 end Number_Formals;
6032 --------------------
6033 -- Parameter_Mode --
6034 --------------------
6036 function Parameter_Mode (Id : E) return Formal_Kind is
6037 begin
6038 return Ekind (Id);
6039 end Parameter_Mode;
6041 ---------------------
6042 -- Record_Rep_Item --
6043 ---------------------
6045 procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is
6046 begin
6047 Set_Next_Rep_Item (N, First_Rep_Item (E));
6048 Set_First_Rep_Item (E, N);
6049 end Record_Rep_Item;
6051 ---------------
6052 -- Root_Type --
6053 ---------------
6055 function Root_Type (Id : E) return E is
6056 T, Etyp : E;
6058 begin
6059 pragma Assert (Nkind (Id) in N_Entity);
6061 T := Base_Type (Id);
6063 if Ekind (T) = E_Class_Wide_Type then
6064 return Etype (T);
6066 -- All other cases
6068 else
6069 loop
6070 Etyp := Etype (T);
6072 if T = Etyp then
6073 return T;
6075 -- Following test catches some error cases resulting from
6076 -- previous errors.
6078 elsif No (Etyp) then
6079 return T;
6081 elsif Is_Private_Type (T) and then Etyp = Full_View (T) then
6082 return T;
6084 elsif Is_Private_Type (Etyp) and then Full_View (Etyp) = T then
6085 return T;
6086 end if;
6088 T := Etyp;
6090 -- Return if there is a circularity in the inheritance chain.
6091 -- This happens in some error situations and we do not want
6092 -- to get stuck in this loop.
6094 if T = Base_Type (Id) then
6095 return T;
6096 end if;
6097 end loop;
6098 end if;
6100 raise Program_Error;
6101 end Root_Type;
6103 -----------------
6104 -- Scope_Depth --
6105 -----------------
6107 function Scope_Depth (Id : E) return Uint is
6108 Scop : Entity_Id;
6110 begin
6111 Scop := Id;
6112 while Is_Record_Type (Scop) loop
6113 Scop := Scope (Scop);
6114 end loop;
6116 return Scope_Depth_Value (Scop);
6117 end Scope_Depth;
6119 ---------------------
6120 -- Scope_Depth_Set --
6121 ---------------------
6123 function Scope_Depth_Set (Id : E) return B is
6124 begin
6125 return not Is_Record_Type (Id)
6126 and then Field22 (Id) /= Union_Id (Empty);
6127 end Scope_Depth_Set;
6129 -----------------------------
6130 -- Set_Component_Alignment --
6131 -----------------------------
6133 -- Component Alignment is encoded using two flags, Flag128/129 as
6134 -- follows. Note that both flags False = Align_Default, so that the
6135 -- default initialization of flags to False initializes component
6136 -- alignment to the default value as required.
6138 -- Flag128 Flag129 Value
6139 -- ------- ------- -----
6140 -- False False Calign_Default
6141 -- False True Calign_Component_Size
6142 -- True False Calign_Component_Size_4
6143 -- True True Calign_Storage_Unit
6145 procedure Set_Component_Alignment (Id : E; V : C) is
6146 begin
6147 pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
6148 and then Id = Base_Type (Id));
6150 case V is
6151 when Calign_Default =>
6152 Set_Flag128 (Id, False);
6153 Set_Flag129 (Id, False);
6155 when Calign_Component_Size =>
6156 Set_Flag128 (Id, False);
6157 Set_Flag129 (Id, True);
6159 when Calign_Component_Size_4 =>
6160 Set_Flag128 (Id, True);
6161 Set_Flag129 (Id, False);
6163 when Calign_Storage_Unit =>
6164 Set_Flag128 (Id, True);
6165 Set_Flag129 (Id, True);
6166 end case;
6167 end Set_Component_Alignment;
6169 -----------------
6170 -- Size_Clause --
6171 -----------------
6173 function Size_Clause (Id : E) return N is
6174 begin
6175 return Rep_Clause (Id, Name_Size);
6176 end Size_Clause;
6178 ------------------------
6179 -- Stream_Size_Clause --
6180 ------------------------
6182 function Stream_Size_Clause (Id : E) return N is
6183 begin
6184 return Rep_Clause (Id, Name_Stream_Size);
6185 end Stream_Size_Clause;
6187 ------------------
6188 -- Subtype_Kind --
6189 ------------------
6191 function Subtype_Kind (K : Entity_Kind) return Entity_Kind is
6192 Kind : Entity_Kind;
6194 begin
6195 case K is
6196 when Access_Kind =>
6197 Kind := E_Access_Subtype;
6199 when E_Array_Type |
6200 E_Array_Subtype =>
6201 Kind := E_Array_Subtype;
6203 when E_Class_Wide_Type |
6204 E_Class_Wide_Subtype =>
6205 Kind := E_Class_Wide_Subtype;
6207 when E_Decimal_Fixed_Point_Type |
6208 E_Decimal_Fixed_Point_Subtype =>
6209 Kind := E_Decimal_Fixed_Point_Subtype;
6211 when E_Ordinary_Fixed_Point_Type |
6212 E_Ordinary_Fixed_Point_Subtype =>
6213 Kind := E_Ordinary_Fixed_Point_Subtype;
6215 when E_Private_Type |
6216 E_Private_Subtype =>
6217 Kind := E_Private_Subtype;
6219 when E_Limited_Private_Type |
6220 E_Limited_Private_Subtype =>
6221 Kind := E_Limited_Private_Subtype;
6223 when E_Record_Type_With_Private |
6224 E_Record_Subtype_With_Private =>
6225 Kind := E_Record_Subtype_With_Private;
6227 when E_Record_Type |
6228 E_Record_Subtype =>
6229 Kind := E_Record_Subtype;
6231 when E_String_Type |
6232 E_String_Subtype =>
6233 Kind := E_String_Subtype;
6235 when Enumeration_Kind =>
6236 Kind := E_Enumeration_Subtype;
6238 when Float_Kind =>
6239 Kind := E_Floating_Point_Subtype;
6241 when Signed_Integer_Kind =>
6242 Kind := E_Signed_Integer_Subtype;
6244 when Modular_Integer_Kind =>
6245 Kind := E_Modular_Integer_Subtype;
6247 when Protected_Kind =>
6248 Kind := E_Protected_Subtype;
6250 when Task_Kind =>
6251 Kind := E_Task_Subtype;
6253 when others =>
6254 Kind := E_Void;
6255 raise Program_Error;
6256 end case;
6258 return Kind;
6259 end Subtype_Kind;
6261 -------------------------
6262 -- First_Tag_Component --
6263 -------------------------
6265 function First_Tag_Component (Id : E) return E is
6266 Comp : Entity_Id;
6267 Typ : Entity_Id := Id;
6269 begin
6270 pragma Assert (Is_Tagged_Type (Typ));
6272 if Is_Class_Wide_Type (Typ) then
6273 Typ := Root_Type (Typ);
6274 end if;
6276 if Is_Private_Type (Typ) then
6277 Typ := Underlying_Type (Typ);
6278 end if;
6280 Comp := First_Entity (Typ);
6281 while Present (Comp) loop
6282 if Is_Tag (Comp) then
6283 return Comp;
6284 end if;
6286 Comp := Next_Entity (Comp);
6287 end loop;
6289 -- No tag component found
6291 return Empty;
6292 end First_Tag_Component;
6294 ------------------------
6295 -- Next_Tag_Component --
6296 ------------------------
6298 function Next_Tag_Component (Id : E) return E is
6299 Comp : Entity_Id;
6300 Typ : constant Entity_Id := Scope (Id);
6302 begin
6303 pragma Assert (Ekind (Id) = E_Component
6304 and then Is_Tagged_Type (Typ));
6306 Comp := Next_Entity (Id);
6307 while Present (Comp) loop
6308 if Is_Tag (Comp) then
6309 pragma Assert (Chars (Comp) /= Name_uTag);
6310 return Comp;
6311 end if;
6313 Comp := Next_Entity (Comp);
6314 end loop;
6316 -- No tag component found
6318 return Empty;
6319 end Next_Tag_Component;
6321 ---------------------
6322 -- Type_High_Bound --
6323 ---------------------
6325 function Type_High_Bound (Id : E) return Node_Id is
6326 begin
6327 if Nkind (Scalar_Range (Id)) = N_Subtype_Indication then
6328 return High_Bound (Range_Expression (Constraint (Scalar_Range (Id))));
6329 else
6330 return High_Bound (Scalar_Range (Id));
6331 end if;
6332 end Type_High_Bound;
6334 --------------------
6335 -- Type_Low_Bound --
6336 --------------------
6338 function Type_Low_Bound (Id : E) return Node_Id is
6339 begin
6340 if Nkind (Scalar_Range (Id)) = N_Subtype_Indication then
6341 return Low_Bound (Range_Expression (Constraint (Scalar_Range (Id))));
6342 else
6343 return Low_Bound (Scalar_Range (Id));
6344 end if;
6345 end Type_Low_Bound;
6347 ---------------------
6348 -- Underlying_Type --
6349 ---------------------
6351 function Underlying_Type (Id : E) return E is
6352 begin
6353 -- For record_with_private the underlying type is always the direct
6354 -- full view. Never try to take the full view of the parent it
6355 -- doesn't make sense.
6357 if Ekind (Id) = E_Record_Type_With_Private then
6358 return Full_View (Id);
6360 elsif Ekind (Id) in Incomplete_Or_Private_Kind then
6362 -- If we have an incomplete or private type with a full view,
6363 -- then we return the Underlying_Type of this full view
6365 if Present (Full_View (Id)) then
6366 if Id = Full_View (Id) then
6368 -- Previous error in declaration
6370 return Empty;
6372 else
6373 return Underlying_Type (Full_View (Id));
6374 end if;
6376 -- If we have an incomplete entity that comes from the limited
6377 -- view then we return the Underlying_Type of its non-limited
6378 -- view.
6380 elsif From_With_Type (Id)
6381 and then Present (Non_Limited_View (Id))
6382 then
6383 return Underlying_Type (Non_Limited_View (Id));
6385 -- Otherwise check for the case where we have a derived type or
6386 -- subtype, and if so get the Underlying_Type of the parent type.
6388 elsif Etype (Id) /= Id then
6389 return Underlying_Type (Etype (Id));
6391 -- Otherwise we have an incomplete or private type that has
6392 -- no full view, which means that we have not encountered the
6393 -- completion, so return Empty to indicate the underlying type
6394 -- is not yet known.
6396 else
6397 return Empty;
6398 end if;
6400 -- For non-incomplete, non-private types, return the type itself
6401 -- Also for entities that are not types at all return the entity
6402 -- itself.
6404 else
6405 return Id;
6406 end if;
6407 end Underlying_Type;
6409 ------------------------
6410 -- Write_Entity_Flags --
6411 ------------------------
6413 procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String) is
6415 procedure W (Flag_Name : String; Flag : Boolean);
6416 -- Write out given flag if it is set
6418 -------
6419 -- W --
6420 -------
6422 procedure W (Flag_Name : String; Flag : Boolean) is
6423 begin
6424 if Flag then
6425 Write_Str (Prefix);
6426 Write_Str (Flag_Name);
6427 Write_Str (" = True");
6428 Write_Eol;
6429 end if;
6430 end W;
6432 -- Start of processing for Write_Entity_Flags
6434 begin
6435 if (Is_Array_Type (Id) or else Is_Record_Type (Id))
6436 and then Base_Type (Id) = Id
6437 then
6438 Write_Str (Prefix);
6439 Write_Str ("Component_Alignment = ");
6441 case Component_Alignment (Id) is
6442 when Calign_Default =>
6443 Write_Str ("Calign_Default");
6445 when Calign_Component_Size =>
6446 Write_Str ("Calign_Component_Size");
6448 when Calign_Component_Size_4 =>
6449 Write_Str ("Calign_Component_Size_4");
6451 when Calign_Storage_Unit =>
6452 Write_Str ("Calign_Storage_Unit");
6453 end case;
6455 Write_Eol;
6456 end if;
6458 W ("Address_Taken", Flag104 (Id));
6459 W ("Body_Needed_For_SAL", Flag40 (Id));
6460 W ("C_Pass_By_Copy", Flag125 (Id));
6461 W ("Can_Never_Be_Null", Flag38 (Id));
6462 W ("Checks_May_Be_Suppressed", Flag31 (Id));
6463 W ("Debug_Info_Off", Flag166 (Id));
6464 W ("Default_Expressions_Processed", Flag108 (Id));
6465 W ("Delay_Cleanups", Flag114 (Id));
6466 W ("Delay_Subprogram_Descriptors", Flag50 (Id));
6467 W ("Depends_On_Private", Flag14 (Id));
6468 W ("Discard_Names", Flag88 (Id));
6469 W ("Elaborate_All_Desirable", Flag146 (Id));
6470 W ("Elaboration_Entity_Required", Flag174 (Id));
6471 W ("Entry_Accepted", Flag152 (Id));
6472 W ("Finalize_Storage_Only", Flag158 (Id));
6473 W ("From_With_Type", Flag159 (Id));
6474 W ("Function_Returns_With_DSP", Flag169 (Id));
6475 W ("Has_Aliased_Components", Flag135 (Id));
6476 W ("Has_Alignment_Clause", Flag46 (Id));
6477 W ("Has_All_Calls_Remote", Flag79 (Id));
6478 W ("Has_Atomic_Components", Flag86 (Id));
6479 W ("Has_Biased_Representation", Flag139 (Id));
6480 W ("Has_Completion", Flag26 (Id));
6481 W ("Has_Completion_In_Body", Flag71 (Id));
6482 W ("Has_Complex_Representation", Flag140 (Id));
6483 W ("Has_Component_Size_Clause", Flag68 (Id));
6484 W ("Has_Contiguous_Rep", Flag181 (Id));
6485 W ("Has_Controlled_Component", Flag43 (Id));
6486 W ("Has_Controlling_Result", Flag98 (Id));
6487 W ("Has_Convention_Pragma", Flag119 (Id));
6488 W ("Has_Delayed_Freeze", Flag18 (Id));
6489 W ("Has_Discriminants", Flag5 (Id));
6490 W ("Has_Enumeration_Rep_Clause", Flag66 (Id));
6491 W ("Has_Exit", Flag47 (Id));
6492 W ("Has_External_Tag_Rep_Clause", Flag110 (Id));
6493 W ("Has_Forward_Instantiation", Flag175 (Id));
6494 W ("Has_Fully_Qualified_Name", Flag173 (Id));
6495 W ("Has_Gigi_Rep_Item", Flag82 (Id));
6496 W ("Has_Homonym", Flag56 (Id));
6497 W ("Has_Machine_Radix_Clause", Flag83 (Id));
6498 W ("Has_Master_Entity", Flag21 (Id));
6499 W ("Has_Missing_Return", Flag142 (Id));
6500 W ("Has_Nested_Block_With_Handler", Flag101 (Id));
6501 W ("Has_Non_Standard_Rep", Flag75 (Id));
6502 W ("Has_Object_Size_Clause", Flag172 (Id));
6503 W ("Has_Per_Object_Constraint", Flag154 (Id));
6504 W ("Has_Persistent_BSS", Flag188 (Id));
6505 W ("Has_Pragma_Controlled", Flag27 (Id));
6506 W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
6507 W ("Has_Pragma_Inline", Flag157 (Id));
6508 W ("Has_Pragma_Pack", Flag121 (Id));
6509 W ("Has_Pragma_Pure_Function", Flag179 (Id));
6510 W ("Has_Pragma_Unreferenced", Flag180 (Id));
6511 W ("Has_Primitive_Operations", Flag120 (Id));
6512 W ("Has_Private_Declaration", Flag155 (Id));
6513 W ("Has_Qualified_Name", Flag161 (Id));
6514 W ("Has_Record_Rep_Clause", Flag65 (Id));
6515 W ("Has_Recursive_Call", Flag143 (Id));
6516 W ("Has_Size_Clause", Flag29 (Id));
6517 W ("Has_Small_Clause", Flag67 (Id));
6518 W ("Has_Specified_Layout", Flag100 (Id));
6519 W ("Has_Specified_Stream_Input", Flag190 (Id));
6520 W ("Has_Specified_Stream_Output", Flag191 (Id));
6521 W ("Has_Specified_Stream_Read", Flag192 (Id));
6522 W ("Has_Specified_Stream_Write", Flag193 (Id));
6523 W ("Has_Storage_Size_Clause", Flag23 (Id));
6524 W ("Has_Stream_Size_Clause", Flag184 (Id));
6525 W ("Has_Subprogram_Descriptor", Flag93 (Id));
6526 W ("Has_Task", Flag30 (Id));
6527 W ("Has_Unchecked_Union", Flag123 (Id));
6528 W ("Has_Unknown_Discriminants", Flag72 (Id));
6529 W ("Has_Volatile_Components", Flag87 (Id));
6530 W ("Has_Xref_Entry", Flag182 (Id));
6531 W ("In_Package_Body", Flag48 (Id));
6532 W ("In_Private_Part", Flag45 (Id));
6533 W ("In_Use", Flag8 (Id));
6534 W ("Is_AST_Entry", Flag132 (Id));
6535 W ("Is_Abstract", Flag19 (Id));
6536 W ("Is_Local_Anonymous_Access", Flag194 (Id));
6537 W ("Is_Access_Constant", Flag69 (Id));
6538 W ("Is_Ada_2005", Flag185 (Id));
6539 W ("Is_Aliased", Flag15 (Id));
6540 W ("Is_Asynchronous", Flag81 (Id));
6541 W ("Is_Atomic", Flag85 (Id));
6542 W ("Is_Bit_Packed_Array", Flag122 (Id));
6543 W ("Is_CPP_Class", Flag74 (Id));
6544 W ("Is_Called", Flag102 (Id));
6545 W ("Is_Character_Type", Flag63 (Id));
6546 W ("Is_Child_Unit", Flag73 (Id));
6547 W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
6548 W ("Is_Compilation_Unit", Flag149 (Id));
6549 W ("Is_Completely_Hidden", Flag103 (Id));
6550 W ("Is_Concurrent_Record_Type", Flag20 (Id));
6551 W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id));
6552 W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
6553 W ("Is_Constrained", Flag12 (Id));
6554 W ("Is_Constructor", Flag76 (Id));
6555 W ("Is_Controlled", Flag42 (Id));
6556 W ("Is_Controlling_Formal", Flag97 (Id));
6557 W ("Is_Discrim_SO_Function", Flag176 (Id));
6558 W ("Is_Dispatching_Operation", Flag6 (Id));
6559 W ("Is_Eliminated", Flag124 (Id));
6560 W ("Is_Entry_Formal", Flag52 (Id));
6561 W ("Is_Exported", Flag99 (Id));
6562 W ("Is_First_Subtype", Flag70 (Id));
6563 W ("Is_For_Access_Subtype", Flag118 (Id));
6564 W ("Is_Formal_Subprogram", Flag111 (Id));
6565 W ("Is_Frozen", Flag4 (Id));
6566 W ("Is_Generic_Actual_Type", Flag94 (Id));
6567 W ("Is_Generic_Instance", Flag130 (Id));
6568 W ("Is_Generic_Type", Flag13 (Id));
6569 W ("Is_Hidden", Flag57 (Id));
6570 W ("Is_Hidden_Open_Scope", Flag171 (Id));
6571 W ("Is_Immediately_Visible", Flag7 (Id));
6572 W ("Is_Imported", Flag24 (Id));
6573 W ("Is_Inlined", Flag11 (Id));
6574 W ("Is_Instantiated", Flag126 (Id));
6575 W ("Is_Interface", Flag186 (Id));
6576 W ("Is_Internal", Flag17 (Id));
6577 W ("Is_Interrupt_Handler", Flag89 (Id));
6578 W ("Is_Intrinsic_Subprogram", Flag64 (Id));
6579 W ("Is_Itype", Flag91 (Id));
6580 W ("Is_Known_Valid", Flag37 (Id));
6581 W ("Is_Known_Valid", Flag170 (Id));
6582 W ("Is_Limited_Composite", Flag106 (Id));
6583 W ("Is_Limited_Record", Flag25 (Id));
6584 W ("Is_Machine_Code_Subprogram", Flag137 (Id));
6585 W ("Is_Non_Static_Subtype", Flag109 (Id));
6586 W ("Is_Null_Init_Proc", Flag178 (Id));
6587 W ("Is_Obsolescent", Flag153 (Id));
6588 W ("Is_Optional_Parameter", Flag134 (Id));
6589 W ("Is_Overriding_Operation", Flag39 (Id));
6590 W ("Is_Package_Body_Entity", Flag160 (Id));
6591 W ("Is_Packed", Flag51 (Id));
6592 W ("Is_Packed_Array_Type", Flag138 (Id));
6593 W ("Is_Potentially_Use_Visible", Flag9 (Id));
6594 W ("Is_Preelaborated", Flag59 (Id));
6595 W ("Is_Primitive_Wrapper", Flag195 (Id));
6596 W ("Is_Private_Composite", Flag107 (Id));
6597 W ("Is_Private_Descendant", Flag53 (Id));
6598 W ("Is_Public", Flag10 (Id));
6599 W ("Is_Pure", Flag44 (Id));
6600 W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
6601 W ("Is_Remote_Call_Interface", Flag62 (Id));
6602 W ("Is_Remote_Types", Flag61 (Id));
6603 W ("Is_Renaming_Of_Object", Flag112 (Id));
6604 W ("Is_Shared_Passive", Flag60 (Id));
6605 W ("Is_Statically_Allocated", Flag28 (Id));
6606 W ("Is_Tag", Flag78 (Id));
6607 W ("Is_Tagged_Type", Flag55 (Id));
6608 W ("Is_Thread_Body", Flag77 (Id));
6609 W ("Is_True_Constant", Flag163 (Id));
6610 W ("Is_Unchecked_Union", Flag117 (Id));
6611 W ("Is_Unsigned_Type", Flag144 (Id));
6612 W ("Is_VMS_Exception", Flag133 (Id));
6613 W ("Is_Valued_Procedure", Flag127 (Id));
6614 W ("Is_Visible_Child_Unit", Flag116 (Id));
6615 W ("Is_Volatile", Flag16 (Id));
6616 W ("Kill_Elaboration_Checks", Flag32 (Id));
6617 W ("Kill_Range_Checks", Flag33 (Id));
6618 W ("Kill_Tag_Checks", Flag34 (Id));
6619 W ("Machine_Radix_10", Flag84 (Id));
6620 W ("Materialize_Entity", Flag168 (Id));
6621 W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
6622 W ("Needs_Debug_Info", Flag147 (Id));
6623 W ("Needs_No_Actuals", Flag22 (Id));
6624 W ("Never_Set_In_Source", Flag115 (Id));
6625 W ("No_Pool_Assigned", Flag131 (Id));
6626 W ("No_Return", Flag113 (Id));
6627 W ("No_Strict_Aliasing", Flag136 (Id));
6628 W ("Non_Binary_Modulus", Flag58 (Id));
6629 W ("Nonzero_Is_True", Flag162 (Id));
6630 W ("Reachable", Flag49 (Id));
6631 W ("Referenced", Flag156 (Id));
6632 W ("Referenced_As_LHS", Flag36 (Id));
6633 W ("Return_Present", Flag54 (Id));
6634 W ("Returns_By_Ref", Flag90 (Id));
6635 W ("Reverse_Bit_Order", Flag164 (Id));
6636 W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
6637 W ("Size_Depends_On_Discriminant", Flag177 (Id));
6638 W ("Size_Known_At_Compile_Time", Flag92 (Id));
6639 W ("Strict_Alignment", Flag145 (Id));
6640 W ("Suppress_Elaboration_Warnings", Flag148 (Id));
6641 W ("Suppress_Init_Proc", Flag105 (Id));
6642 W ("Suppress_Style_Checks", Flag165 (Id));
6643 W ("Treat_As_Volatile", Flag41 (Id));
6644 W ("Uses_Sec_Stack", Flag95 (Id));
6645 W ("Vax_Float", Flag151 (Id));
6646 W ("Warnings_Off", Flag96 (Id));
6647 W ("Was_Hidden", Flag196 (Id));
6648 end Write_Entity_Flags;
6650 -----------------------
6651 -- Write_Entity_Info --
6652 -----------------------
6654 procedure Write_Entity_Info (Id : Entity_Id; Prefix : String) is
6656 procedure Write_Attribute (Which : String; Nam : E);
6657 -- Write attribute value with given string name
6659 procedure Write_Kind (Id : Entity_Id);
6660 -- Write Ekind field of entity
6662 procedure Write_Attribute (Which : String; Nam : E) is
6663 begin
6664 Write_Str (Prefix);
6665 Write_Str (Which);
6666 Write_Int (Int (Nam));
6667 Write_Str (" ");
6668 Write_Name (Chars (Nam));
6669 Write_Str (" ");
6670 end Write_Attribute;
6672 procedure Write_Kind (Id : Entity_Id) is
6673 K : constant String := Entity_Kind'Image (Ekind (Id));
6675 begin
6676 Write_Str (Prefix);
6677 Write_Str (" Kind ");
6679 if Is_Type (Id) and then Is_Tagged_Type (Id) then
6680 Write_Str ("TAGGED ");
6681 end if;
6683 Write_Str (K (3 .. K'Length));
6684 Write_Str (" ");
6686 if Is_Type (Id) and then Depends_On_Private (Id) then
6687 Write_Str ("Depends_On_Private ");
6688 end if;
6689 end Write_Kind;
6691 -- Start of processing for Write_Entity_Info
6693 begin
6694 Write_Eol;
6695 Write_Attribute ("Name ", Id);
6696 Write_Int (Int (Id));
6697 Write_Eol;
6698 Write_Kind (Id);
6699 Write_Eol;
6700 Write_Attribute (" Type ", Etype (Id));
6701 Write_Eol;
6702 Write_Attribute (" Scope ", Scope (Id));
6703 Write_Eol;
6705 case Ekind (Id) is
6707 when Discrete_Kind =>
6708 Write_Str ("Bounds: Id = ");
6710 if Present (Scalar_Range (Id)) then
6711 Write_Int (Int (Type_Low_Bound (Id)));
6712 Write_Str (" .. Id = ");
6713 Write_Int (Int (Type_High_Bound (Id)));
6714 else
6715 Write_Str ("Empty");
6716 end if;
6718 Write_Eol;
6720 when Array_Kind =>
6721 declare
6722 Index : E;
6724 begin
6725 Write_Attribute
6726 (" Component Type ", Component_Type (Id));
6727 Write_Eol;
6728 Write_Str (Prefix);
6729 Write_Str (" Indices ");
6731 Index := First_Index (Id);
6732 while Present (Index) loop
6733 Write_Attribute (" ", Etype (Index));
6734 Index := Next_Index (Index);
6735 end loop;
6737 Write_Eol;
6738 end;
6740 when Access_Kind =>
6741 Write_Attribute
6742 (" Directly Designated Type ",
6743 Directly_Designated_Type (Id));
6744 Write_Eol;
6746 when Overloadable_Kind =>
6747 if Present (Homonym (Id)) then
6748 Write_Str (" Homonym ");
6749 Write_Name (Chars (Homonym (Id)));
6750 Write_Str (" ");
6751 Write_Int (Int (Homonym (Id)));
6752 Write_Eol;
6753 end if;
6755 Write_Eol;
6757 when E_Component =>
6758 if Ekind (Scope (Id)) in Record_Kind then
6759 Write_Attribute (
6760 " Original_Record_Component ",
6761 Original_Record_Component (Id));
6762 Write_Int (Int (Original_Record_Component (Id)));
6763 Write_Eol;
6764 end if;
6766 when others => null;
6767 end case;
6768 end Write_Entity_Info;
6770 -----------------------
6771 -- Write_Field6_Name --
6772 -----------------------
6774 procedure Write_Field6_Name (Id : Entity_Id) is
6775 pragma Warnings (Off, Id);
6777 begin
6778 Write_Str ("First_Rep_Item");
6779 end Write_Field6_Name;
6781 -----------------------
6782 -- Write_Field7_Name --
6783 -----------------------
6785 procedure Write_Field7_Name (Id : Entity_Id) is
6786 pragma Warnings (Off, Id);
6788 begin
6789 Write_Str ("Freeze_Node");
6790 end Write_Field7_Name;
6792 -----------------------
6793 -- Write_Field8_Name --
6794 -----------------------
6796 procedure Write_Field8_Name (Id : Entity_Id) is
6797 begin
6798 case Ekind (Id) is
6799 when E_Component |
6800 E_Discriminant =>
6801 Write_Str ("Normalized_First_Bit");
6803 when Formal_Kind |
6804 E_Function |
6805 E_Subprogram_Body =>
6806 Write_Str ("Mechanism");
6808 when Type_Kind =>
6809 Write_Str ("Associated_Node_For_Itype");
6811 when E_Package =>
6812 Write_Str ("Dependent_Instances");
6814 when E_Variable =>
6815 Write_Str ("Hiding_Loop_Variable");
6817 when others =>
6818 Write_Str ("Field8??");
6819 end case;
6820 end Write_Field8_Name;
6822 -----------------------
6823 -- Write_Field9_Name --
6824 -----------------------
6826 procedure Write_Field9_Name (Id : Entity_Id) is
6827 begin
6828 case Ekind (Id) is
6829 when Type_Kind =>
6830 Write_Str ("Class_Wide_Type");
6832 when E_Function |
6833 E_Generic_Function |
6834 E_Generic_Package |
6835 E_Generic_Procedure |
6836 E_Package |
6837 E_Procedure =>
6838 Write_Str ("Renaming_Map");
6840 when Object_Kind =>
6841 Write_Str ("Current_Value");
6843 when others =>
6844 Write_Str ("Field9??");
6845 end case;
6846 end Write_Field9_Name;
6848 ------------------------
6849 -- Write_Field10_Name --
6850 ------------------------
6852 procedure Write_Field10_Name (Id : Entity_Id) is
6853 begin
6854 case Ekind (Id) is
6855 when Type_Kind =>
6856 Write_Str ("Referenced_Object");
6858 when E_In_Parameter |
6859 E_Constant =>
6860 Write_Str ("Discriminal_Link");
6862 when E_Function |
6863 E_Package |
6864 E_Package_Body |
6865 E_Procedure =>
6866 Write_Str ("Handler_Records");
6868 when E_Component |
6869 E_Discriminant =>
6870 Write_Str ("Normalized_Position_Max");
6872 when others =>
6873 Write_Str ("Field10??");
6874 end case;
6875 end Write_Field10_Name;
6877 ------------------------
6878 -- Write_Field11_Name --
6879 ------------------------
6881 procedure Write_Field11_Name (Id : Entity_Id) is
6882 begin
6883 case Ekind (Id) is
6884 when Formal_Kind =>
6885 Write_Str ("Entry_Component");
6887 when E_Component |
6888 E_Discriminant =>
6889 Write_Str ("Component_Bit_Offset");
6891 when E_Constant =>
6892 Write_Str ("Full_View");
6894 when E_Enumeration_Literal =>
6895 Write_Str ("Enumeration_Pos");
6897 when E_Block =>
6898 Write_Str ("Block_Node");
6900 when E_Function |
6901 E_Procedure |
6902 E_Entry |
6903 E_Entry_Family =>
6904 Write_Str ("Protected_Body_Subprogram");
6906 when E_Generic_Package =>
6907 Write_Str ("Generic_Homonym");
6909 when Type_Kind =>
6910 Write_Str ("Full_View");
6912 when others =>
6913 Write_Str ("Field11??");
6914 end case;
6915 end Write_Field11_Name;
6917 ------------------------
6918 -- Write_Field12_Name --
6919 ------------------------
6921 procedure Write_Field12_Name (Id : Entity_Id) is
6922 begin
6923 case Ekind (Id) is
6924 when Entry_Kind =>
6925 Write_Str ("Barrier_Function");
6927 when E_Enumeration_Literal =>
6928 Write_Str ("Enumeration_Rep");
6930 when Type_Kind |
6931 E_Component |
6932 E_Constant |
6933 E_Discriminant |
6934 E_In_Parameter |
6935 E_In_Out_Parameter |
6936 E_Out_Parameter |
6937 E_Loop_Parameter |
6938 E_Variable =>
6939 Write_Str ("Esize");
6941 when E_Function |
6942 E_Procedure =>
6943 Write_Str ("Next_Inlined_Subprogram");
6945 when E_Package =>
6946 Write_Str ("Associated_Formal_Package");
6948 when others =>
6949 Write_Str ("Field12??");
6950 end case;
6951 end Write_Field12_Name;
6953 ------------------------
6954 -- Write_Field13_Name --
6955 ------------------------
6957 procedure Write_Field13_Name (Id : Entity_Id) is
6958 begin
6959 case Ekind (Id) is
6960 when Type_Kind =>
6961 Write_Str ("RM_Size");
6963 when E_Component |
6964 E_Discriminant =>
6965 Write_Str ("Component_Clause");
6967 when E_Enumeration_Literal =>
6968 Write_Str ("Debug_Renaming_Link");
6970 when E_Function =>
6971 if not Comes_From_Source (Id)
6972 and then
6973 Chars (Id) = Name_Op_Ne
6974 then
6975 Write_Str ("Corresponding_Equality");
6977 elsif Comes_From_Source (Id) then
6978 Write_Str ("Elaboration_Entity");
6980 else
6981 Write_Str ("Field13??");
6982 end if;
6984 when Formal_Kind |
6985 E_Variable =>
6986 Write_Str ("Extra_Accessibility");
6988 when E_Procedure |
6989 E_Package |
6990 Generic_Unit_Kind =>
6991 Write_Str ("Elaboration_Entity");
6993 when others =>
6994 Write_Str ("Field13??");
6995 end case;
6996 end Write_Field13_Name;
6998 -----------------------
6999 -- Write_Field14_Name --
7000 -----------------------
7002 procedure Write_Field14_Name (Id : Entity_Id) is
7003 begin
7004 case Ekind (Id) is
7005 when Type_Kind |
7006 Formal_Kind |
7007 E_Constant |
7008 E_Variable |
7009 E_Loop_Parameter =>
7010 Write_Str ("Alignment");
7012 when E_Component |
7013 E_Discriminant =>
7014 Write_Str ("Normalized_Position");
7016 when E_Function |
7017 E_Procedure =>
7018 Write_Str ("First_Optional_Parameter");
7020 when E_Package |
7021 E_Generic_Package =>
7022 Write_Str ("Shadow_Entities");
7024 when others =>
7025 Write_Str ("Field14??");
7026 end case;
7027 end Write_Field14_Name;
7029 ------------------------
7030 -- Write_Field15_Name --
7031 ------------------------
7033 procedure Write_Field15_Name (Id : Entity_Id) is
7034 begin
7035 case Ekind (Id) is
7036 when Access_Kind |
7037 Task_Kind =>
7038 Write_Str ("Storage_Size_Variable");
7040 when Class_Wide_Kind |
7041 E_Record_Type |
7042 E_Record_Subtype |
7043 Private_Kind =>
7044 Write_Str ("Primitive_Operations");
7046 when E_Component =>
7047 Write_Str ("DT_Entry_Count");
7049 when Decimal_Fixed_Point_Kind =>
7050 Write_Str ("Scale_Value");
7052 when E_Discriminant =>
7053 Write_Str ("Discriminant_Number");
7055 when Formal_Kind =>
7056 Write_Str ("Extra_Formal");
7058 when E_Function |
7059 E_Procedure =>
7060 Write_Str ("DT_Position");
7062 when Entry_Kind =>
7063 Write_Str ("Entry_Parameters_Type");
7065 when Enumeration_Kind =>
7066 Write_Str ("Lit_Indexes");
7068 when E_Package |
7069 E_Package_Body =>
7070 Write_Str ("Related_Instance");
7072 when E_Protected_Type =>
7073 Write_Str ("Entry_Bodies_Array");
7075 when E_String_Literal_Subtype =>
7076 Write_Str ("String_Literal_Low_Bound");
7078 when E_Variable =>
7079 Write_Str ("Shared_Var_Read_Proc");
7081 when others =>
7082 Write_Str ("Field15??");
7083 end case;
7084 end Write_Field15_Name;
7086 ------------------------
7087 -- Write_Field16_Name --
7088 ------------------------
7090 procedure Write_Field16_Name (Id : Entity_Id) is
7091 begin
7092 case Ekind (Id) is
7093 when E_Component =>
7094 Write_Str ("Entry_Formal");
7096 when E_Function |
7097 E_Procedure =>
7098 Write_Str ("DTC_Entity");
7100 when E_Package |
7101 E_Generic_Package |
7102 Concurrent_Kind =>
7103 Write_Str ("First_Private_Entity");
7105 when E_Record_Type |
7106 E_Record_Type_With_Private =>
7107 Write_Str ("Access_Disp_Table");
7109 when E_String_Literal_Subtype =>
7110 Write_Str ("String_Literal_Length");
7112 when Enumeration_Kind =>
7113 Write_Str ("Lit_Strings");
7115 when E_Variable |
7116 E_Out_Parameter =>
7117 Write_Str ("Unset_Reference");
7119 when E_Record_Subtype |
7120 E_Class_Wide_Subtype =>
7121 Write_Str ("Cloned_Subtype");
7123 when others =>
7124 Write_Str ("Field16??");
7125 end case;
7126 end Write_Field16_Name;
7128 ------------------------
7129 -- Write_Field17_Name --
7130 ------------------------
7132 procedure Write_Field17_Name (Id : Entity_Id) is
7133 begin
7134 case Ekind (Id) is
7135 when Digits_Kind =>
7136 Write_Str ("Digits_Value");
7138 when E_Component =>
7139 Write_Str ("Prival");
7141 when E_Discriminant =>
7142 Write_Str ("Discriminal");
7144 when E_Block |
7145 Class_Wide_Kind |
7146 Concurrent_Kind |
7147 Private_Kind |
7148 E_Entry |
7149 E_Entry_Family |
7150 E_Function |
7151 E_Generic_Function |
7152 E_Generic_Package |
7153 E_Generic_Procedure |
7154 E_Loop |
7155 E_Operator |
7156 E_Package |
7157 E_Package_Body |
7158 E_Procedure |
7159 E_Record_Type |
7160 E_Record_Subtype |
7161 E_Subprogram_Body |
7162 E_Subprogram_Type =>
7163 Write_Str ("First_Entity");
7165 when Array_Kind =>
7166 Write_Str ("First_Index");
7168 when E_Protected_Body =>
7169 Write_Str ("Object_Ref");
7171 when Enumeration_Kind =>
7172 Write_Str ("First_Literal");
7174 when Access_Kind =>
7175 Write_Str ("Master_Id");
7177 when Modular_Integer_Kind =>
7178 Write_Str ("Modulus");
7180 when Formal_Kind |
7181 E_Constant |
7182 E_Generic_In_Out_Parameter |
7183 E_Variable =>
7184 Write_Str ("Actual_Subtype");
7186 when E_Incomplete_Type =>
7187 Write_Str ("Non-limited view");
7189 when others =>
7190 Write_Str ("Field17??");
7191 end case;
7192 end Write_Field17_Name;
7194 -----------------------
7195 -- Write_Field18_Name --
7196 -----------------------
7198 procedure Write_Field18_Name (Id : Entity_Id) is
7199 begin
7200 case Ekind (Id) is
7201 when E_Enumeration_Literal |
7202 E_Function |
7203 E_Operator |
7204 E_Procedure =>
7205 Write_Str ("Alias");
7207 when E_Record_Type =>
7208 Write_Str ("Corresponding_Concurrent_Type");
7210 when E_Entry_Index_Parameter =>
7211 Write_Str ("Entry_Index_Constant");
7213 when E_Class_Wide_Subtype |
7214 E_Access_Protected_Subprogram_Type |
7215 E_Access_Subprogram_Type |
7216 E_Exception_Type =>
7217 Write_Str ("Equivalent_Type");
7219 when Fixed_Point_Kind =>
7220 Write_Str ("Delta_Value");
7222 when E_Constant |
7223 E_Variable =>
7224 Write_Str ("Renamed_Object");
7226 when E_Exception |
7227 E_Package |
7228 E_Generic_Function |
7229 E_Generic_Procedure |
7230 E_Generic_Package =>
7231 Write_Str ("Renamed_Entity");
7233 when Incomplete_Or_Private_Kind =>
7234 Write_Str ("Private_Dependents");
7236 when Concurrent_Kind =>
7237 Write_Str ("Corresponding_Record_Type");
7239 when E_Label |
7240 E_Loop |
7241 E_Block =>
7242 Write_Str ("Enclosing_Scope");
7244 when others =>
7245 Write_Str ("Field18??");
7246 end case;
7247 end Write_Field18_Name;
7249 -----------------------
7250 -- Write_Field19_Name --
7251 -----------------------
7253 procedure Write_Field19_Name (Id : Entity_Id) is
7254 begin
7255 case Ekind (Id) is
7256 when E_Array_Type |
7257 E_Array_Subtype =>
7258 Write_Str ("Related_Array_Object");
7260 when E_Block |
7261 Concurrent_Kind |
7262 E_Function |
7263 E_Procedure |
7264 Entry_Kind =>
7265 Write_Str ("Finalization_Chain_Entity");
7267 when E_Constant | E_Variable =>
7268 Write_Str ("Size_Check_Code");
7270 when E_Discriminant =>
7271 Write_Str ("Corresponding_Discriminant");
7273 when E_Package |
7274 E_Generic_Package =>
7275 Write_Str ("Body_Entity");
7277 when E_Package_Body |
7278 Formal_Kind =>
7279 Write_Str ("Spec_Entity");
7281 when Private_Kind =>
7282 Write_Str ("Underlying_Full_View");
7284 when E_Record_Type =>
7285 Write_Str ("Parent_Subtype");
7287 when others =>
7288 Write_Str ("Field19??");
7289 end case;
7290 end Write_Field19_Name;
7292 -----------------------
7293 -- Write_Field20_Name --
7294 -----------------------
7296 procedure Write_Field20_Name (Id : Entity_Id) is
7297 begin
7298 case Ekind (Id) is
7299 when Array_Kind =>
7300 Write_Str ("Component_Type");
7302 when E_In_Parameter |
7303 E_Generic_In_Parameter =>
7304 Write_Str ("Default_Value");
7306 when Access_Kind =>
7307 Write_Str ("Directly_Designated_Type");
7309 when E_Component =>
7310 Write_Str ("Discriminant_Checking_Func");
7312 when E_Discriminant =>
7313 Write_Str ("Discriminant_Default_Value");
7315 when E_Block |
7316 Class_Wide_Kind |
7317 Concurrent_Kind |
7318 Private_Kind |
7319 E_Entry |
7320 E_Entry_Family |
7321 E_Function |
7322 E_Generic_Function |
7323 E_Generic_Package |
7324 E_Generic_Procedure |
7325 E_Loop |
7326 E_Operator |
7327 E_Package |
7328 E_Package_Body |
7329 E_Procedure |
7330 E_Record_Type |
7331 E_Record_Subtype |
7332 E_Subprogram_Body |
7333 E_Subprogram_Type =>
7335 Write_Str ("Last_Entity");
7337 when Scalar_Kind =>
7338 Write_Str ("Scalar_Range");
7340 when E_Exception =>
7341 Write_Str ("Register_Exception_Call");
7343 when others =>
7344 Write_Str ("Field20??");
7345 end case;
7346 end Write_Field20_Name;
7348 -----------------------
7349 -- Write_Field21_Name --
7350 -----------------------
7352 procedure Write_Field21_Name (Id : Entity_Id) is
7353 begin
7354 case Ekind (Id) is
7355 when E_Constant |
7356 E_Exception |
7357 E_Function |
7358 E_Generic_Function |
7359 E_Procedure |
7360 E_Generic_Procedure |
7361 E_Variable =>
7362 Write_Str ("Interface_Name");
7364 when Concurrent_Kind |
7365 Incomplete_Or_Private_Kind |
7366 Class_Wide_Kind |
7367 E_Record_Type |
7368 E_Record_Subtype =>
7369 Write_Str ("Discriminant_Constraint");
7371 when Entry_Kind =>
7372 Write_Str ("Accept_Address");
7374 when Fixed_Point_Kind =>
7375 Write_Str ("Small_Value");
7377 when E_In_Parameter =>
7378 Write_Str ("Default_Expr_Function");
7380 when Array_Kind |
7381 Modular_Integer_Kind =>
7382 Write_Str ("Original_Array_Type");
7384 when E_Access_Subprogram_Type |
7385 E_Access_Protected_Subprogram_Type =>
7386 Write_Str ("Original_Access_Type");
7388 when others =>
7389 Write_Str ("Field21??");
7390 end case;
7391 end Write_Field21_Name;
7393 -----------------------
7394 -- Write_Field22_Name --
7395 -----------------------
7397 procedure Write_Field22_Name (Id : Entity_Id) is
7398 begin
7399 case Ekind (Id) is
7400 when Access_Kind =>
7401 Write_Str ("Associated_Storage_Pool");
7403 when Array_Kind =>
7404 Write_Str ("Component_Size");
7406 when E_Component |
7407 E_Discriminant =>
7408 Write_Str ("Original_Record_Component");
7410 when E_Enumeration_Literal =>
7411 Write_Str ("Enumeration_Rep_Expr");
7413 when E_Exception =>
7414 Write_Str ("Exception_Code");
7416 when Formal_Kind =>
7417 Write_Str ("Protected_Formal");
7419 when E_Record_Type =>
7420 Write_Str ("Corresponding_Remote_Type");
7422 when E_Block |
7423 E_Entry |
7424 E_Entry_Family |
7425 E_Function |
7426 E_Loop |
7427 E_Package |
7428 E_Package_Body |
7429 E_Generic_Package |
7430 E_Generic_Function |
7431 E_Generic_Procedure |
7432 E_Procedure |
7433 E_Protected_Type |
7434 E_Subprogram_Body |
7435 E_Task_Type =>
7436 Write_Str ("Scope_Depth_Value");
7438 when E_Record_Type_With_Private |
7439 E_Record_Subtype_With_Private |
7440 E_Private_Type |
7441 E_Private_Subtype |
7442 E_Limited_Private_Type |
7443 E_Limited_Private_Subtype =>
7444 Write_Str ("Private_View");
7446 when E_Variable =>
7447 Write_Str ("Shared_Var_Assign_Proc");
7449 when others =>
7450 Write_Str ("Field22??");
7451 end case;
7452 end Write_Field22_Name;
7454 ------------------------
7455 -- Write_Field23_Name --
7456 ------------------------
7458 procedure Write_Field23_Name (Id : Entity_Id) is
7459 begin
7460 case Ekind (Id) is
7461 when Access_Kind =>
7462 Write_Str ("Associated_Final_Chain");
7464 when Array_Kind =>
7465 Write_Str ("Packed_Array_Type");
7467 when E_Block =>
7468 Write_Str ("Entry_Cancel_Parameter");
7470 when E_Component =>
7471 Write_Str ("Protected_Operation");
7473 when E_Discriminant =>
7474 Write_Str ("CR_Discriminant");
7476 when E_Enumeration_Type =>
7477 Write_Str ("Enum_Pos_To_Rep");
7479 when Formal_Kind |
7480 E_Variable =>
7481 Write_Str ("Extra_Constrained");
7483 when E_Generic_Function |
7484 E_Generic_Package |
7485 E_Generic_Procedure =>
7486 Write_Str ("Inner_Instances");
7488 when Concurrent_Kind |
7489 Incomplete_Or_Private_Kind |
7490 Class_Wide_Kind |
7491 E_Record_Type |
7492 E_Record_Subtype =>
7493 Write_Str ("Stored_Constraint");
7495 when E_Function |
7496 E_Procedure =>
7497 Write_Str ("Generic_Renamings");
7499 when E_Package =>
7500 if Is_Generic_Instance (Id) then
7501 Write_Str ("Generic_Renamings");
7502 else
7503 Write_Str ("Limited Views");
7504 end if;
7506 -- What about Privals_Chain for protected operations ???
7508 when Entry_Kind =>
7509 Write_Str ("Privals_Chain");
7511 when others =>
7512 Write_Str ("Field23??");
7513 end case;
7514 end Write_Field23_Name;
7516 ------------------------
7517 -- Write_Field24_Name --
7518 ------------------------
7520 procedure Write_Field24_Name (Id : Entity_Id) is
7521 begin
7522 case Ekind (Id) is
7523 when E_Record_Type |
7524 E_Record_Subtype |
7525 E_Record_Type_With_Private |
7526 E_Record_Subtype_With_Private =>
7527 Write_Str ("Abstract_Interfaces");
7529 when Subprogram_Kind =>
7530 Write_Str ("Obsolescent_Warning");
7532 when Task_Kind =>
7533 Write_Str ("Task_Body_Procedure");
7535 when others =>
7536 Write_Str ("Field24??");
7537 end case;
7538 end Write_Field24_Name;
7540 ------------------------
7541 -- Write_Field25_Name --
7542 ------------------------
7544 procedure Write_Field25_Name (Id : Entity_Id) is
7545 begin
7546 case Ekind (Id) is
7547 when E_Procedure |
7548 E_Function =>
7549 Write_Str ("Abstract_Interface_Alias");
7551 when others =>
7552 Write_Str ("Field25??");
7553 end case;
7554 end Write_Field25_Name;
7556 ------------------------
7557 -- Write_Field26_Name --
7558 ------------------------
7560 procedure Write_Field26_Name (Id : Entity_Id) is
7561 begin
7562 case Ekind (Id) is
7563 when E_Procedure |
7564 E_Function =>
7565 Write_Str ("Overridden_Operation");
7567 when others =>
7568 Write_Str ("Field26??");
7569 end case;
7570 end Write_Field26_Name;
7572 ------------------------
7573 -- Write_Field27_Name --
7574 ------------------------
7576 procedure Write_Field27_Name (Id : Entity_Id) is
7577 begin
7578 case Ekind (Id) is
7579 when E_Procedure =>
7580 Write_Str ("Wrapped_Entity");
7582 when others =>
7583 Write_Str ("Field27??");
7584 end case;
7585 end Write_Field27_Name;
7587 -------------------------
7588 -- Iterator Procedures --
7589 -------------------------
7591 procedure Proc_Next_Component (N : in out Node_Id) is
7592 begin
7593 N := Next_Component (N);
7594 end Proc_Next_Component;
7596 procedure Proc_Next_Discriminant (N : in out Node_Id) is
7597 begin
7598 N := Next_Discriminant (N);
7599 end Proc_Next_Discriminant;
7601 procedure Proc_Next_Formal (N : in out Node_Id) is
7602 begin
7603 N := Next_Formal (N);
7604 end Proc_Next_Formal;
7606 procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is
7607 begin
7608 N := Next_Formal_With_Extras (N);
7609 end Proc_Next_Formal_With_Extras;
7611 procedure Proc_Next_Index (N : in out Node_Id) is
7612 begin
7613 N := Next_Index (N);
7614 end Proc_Next_Index;
7616 procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is
7617 begin
7618 N := Next_Inlined_Subprogram (N);
7619 end Proc_Next_Inlined_Subprogram;
7621 procedure Proc_Next_Literal (N : in out Node_Id) is
7622 begin
7623 N := Next_Literal (N);
7624 end Proc_Next_Literal;
7626 procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is
7627 begin
7628 N := Next_Stored_Discriminant (N);
7629 end Proc_Next_Stored_Discriminant;
7631 end Einfo;