OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [ada/] [einfo.adb] - Blame information for rev 384

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.