OSDN Git Service

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