OSDN Git Service

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