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