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