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