OSDN Git Service

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