OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [einfo.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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