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