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