OSDN Git Service

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