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