OSDN Git Service

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