OSDN Git Service

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