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