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