OSDN Git Service

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