OSDN Git Service

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