OSDN Git Service

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