OSDN Git Service

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