OSDN Git Service

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