OSDN Git Service

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