OSDN Git Service

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