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