OSDN Git Service

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