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