OSDN Git Service

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