OSDN Git Service

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