OSDN Git Service

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