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