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