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