OSDN Git Service

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