1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- E X P _ C H 2 -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Atree; use Atree; 27with Checks; use Checks; 28with Debug; use Debug; 29with Einfo; use Einfo; 30with Einfo.Entities; use Einfo.Entities; 31with Einfo.Utils; use Einfo.Utils; 32with Elists; use Elists; 33with Exp_Smem; use Exp_Smem; 34with Exp_Tss; use Exp_Tss; 35with Exp_Util; use Exp_Util; 36with Namet; use Namet; 37with Nmake; use Nmake; 38with Opt; use Opt; 39with Output; use Output; 40with Sem; use Sem; 41with Sem_Eval; use Sem_Eval; 42with Sem_Res; use Sem_Res; 43with Sem_Util; use Sem_Util; 44with Sem_Warn; use Sem_Warn; 45with Sinfo; use Sinfo; 46with Sinfo.Nodes; use Sinfo.Nodes; 47with Sinfo.Utils; use Sinfo.Utils; 48with Sinput; use Sinput; 49with Snames; use Snames; 50with Tbuild; use Tbuild; 51 52package body Exp_Ch2 is 53 54 ----------------------- 55 -- Local Subprograms -- 56 ----------------------- 57 58 procedure Expand_Current_Value (N : Node_Id); 59 -- N is a node for a variable whose Current_Value field is set. If N is 60 -- node is for a discrete type, replaces node with a copy of the referenced 61 -- value. This provides a limited form of value propagation for variables 62 -- which are initialized or assigned not been further modified at the time 63 -- of reference. The call has no effect if the Current_Value refers to a 64 -- conditional with condition other than equality. 65 66 procedure Expand_Discriminant (N : Node_Id); 67 -- An occurrence of a discriminant within a discriminated type is replaced 68 -- with the corresponding discriminal, that is to say the formal parameter 69 -- of the initialization procedure for the type that is associated with 70 -- that particular discriminant. This replacement is not performed for 71 -- discriminants of records that appear in constraints of component of the 72 -- record, because Gigi uses the discriminant name to retrieve its value. 73 -- In the other hand, it has to be performed for default expressions of 74 -- components because they are used in the record init procedure. See Einfo 75 -- for more details, and Exp_Ch3, Exp_Ch9 for examples of use. For 76 -- discriminants of tasks and protected types, the transformation is more 77 -- complex when it occurs within a default expression for an entry or 78 -- protected operation. The corresponding default_expression_function has 79 -- an additional parameter which is the target of an entry call, and the 80 -- discriminant of the task must be replaced with a reference to the 81 -- discriminant of that formal parameter. 82 83 procedure Expand_Entity_Reference (N : Node_Id); 84 -- Common processing for expansion of identifiers and expanded names 85 -- Dispatches to specific expansion procedures. 86 87 procedure Expand_Entry_Index_Parameter (N : Node_Id); 88 -- A reference to the identifier in the entry index specification of an 89 -- entry body is modified to a reference to a constant definition equal to 90 -- the index of the entry family member being called. This constant is 91 -- calculated as part of the elaboration of the expanded code for the body, 92 -- and is calculated from the object-wide entry index returned by Next_ 93 -- Entry_Call. 94 95 procedure Expand_Entry_Parameter (N : Node_Id); 96 -- A reference to an entry parameter is modified to be a reference to the 97 -- corresponding component of the entry parameter record that is passed by 98 -- the runtime to the accept body procedure. 99 100 procedure Expand_Formal (N : Node_Id); 101 -- A reference to a formal parameter of a protected subprogram is expanded 102 -- into the corresponding formal of the unprotected procedure used to 103 -- represent the operation within the protected object. In other cases 104 -- Expand_Formal is a no-op. 105 106 procedure Expand_Protected_Component (N : Node_Id); 107 -- A reference to a private component of a protected type is expanded into 108 -- a reference to the corresponding prival in the current protected entry 109 -- or subprogram. 110 111 procedure Expand_Renaming (N : Node_Id); 112 -- For renamings, just replace the identifier by the corresponding 113 -- named expression. Note that this has been evaluated (see routine 114 -- Exp_Ch8.Expand_N_Object_Renaming.Evaluate_Name) so this gives 115 -- the correct renaming semantics. 116 117 -------------------------- 118 -- Expand_Current_Value -- 119 -------------------------- 120 121 procedure Expand_Current_Value (N : Node_Id) is 122 Loc : constant Source_Ptr := Sloc (N); 123 E : constant Entity_Id := Entity (N); 124 CV : constant Node_Id := Current_Value (E); 125 T : constant Entity_Id := Etype (N); 126 Val : Node_Id; 127 Op : Node_Kind; 128 129 begin 130 if True 131 132 -- No replacement if value raises constraint error 133 134 and then Nkind (CV) /= N_Raise_Constraint_Error 135 136 -- Do this only for discrete types 137 138 and then Is_Discrete_Type (T) 139 140 -- Do not replace biased types, since it is problematic to 141 -- consistently generate a sensible constant value in this case. 142 143 and then not Has_Biased_Representation (T) 144 145 -- Do not replace lvalues 146 147 and then not May_Be_Lvalue (N) 148 149 -- Check that entity is suitable for replacement 150 151 and then OK_To_Do_Constant_Replacement (E) 152 153 -- Do not replace occurrences in pragmas (where names typically 154 -- appear not as values, but as simply names. If there are cases 155 -- where values are required, it is only a very minor efficiency 156 -- issue that they do not get replaced when they could be). 157 158 and then Nkind (Parent (N)) /= N_Pragma_Argument_Association 159 160 -- Do not replace the prefixes of attribute references, since this 161 -- causes trouble with cases like 4'Size. Also for Name_Asm_Input and 162 -- Name_Asm_Output, don't do replacement anywhere, since we can have 163 -- lvalue references in the arguments. 164 165 and then not (Nkind (Parent (N)) = N_Attribute_Reference 166 and then 167 (Attribute_Name (Parent (N)) in Name_Asm_Input 168 | Name_Asm_Output 169 or else Prefix (Parent (N)) = N)) 170 then 171 -- Case of Current_Value is a compile time known value 172 173 if Nkind (CV) in N_Subexpr then 174 Val := CV; 175 176 -- Case of Current_Value is an if expression reference 177 178 else 179 Get_Current_Value_Condition (N, Op, Val); 180 181 if Op /= N_Op_Eq then 182 return; 183 end if; 184 end if; 185 186 -- If constant value is an occurrence of an enumeration literal, 187 -- then we just make another occurrence of the same literal. 188 189 if Is_Entity_Name (Val) 190 and then Ekind (Entity (Val)) = E_Enumeration_Literal 191 then 192 Rewrite (N, 193 Unchecked_Convert_To (T, 194 New_Occurrence_Of (Entity (Val), Loc))); 195 196 -- If constant is of a character type, just make an appropriate 197 -- character literal, which will get the proper type. 198 199 elsif Is_Character_Type (T) then 200 Rewrite (N, 201 Make_Character_Literal (Loc, 202 Chars => Chars (Val), 203 Char_Literal_Value => Expr_Rep_Value (Val))); 204 205 -- If constant is of an integer type, just make an appropriate 206 -- integer literal, which will get the proper type. 207 208 elsif Is_Integer_Type (T) then 209 Rewrite (N, 210 Make_Integer_Literal (Loc, 211 Intval => Expr_Rep_Value (Val))); 212 213 -- Otherwise do unchecked conversion of value to right type 214 215 else 216 Rewrite (N, 217 Unchecked_Convert_To (T, 218 Make_Integer_Literal (Loc, 219 Intval => Expr_Rep_Value (Val)))); 220 end if; 221 222 Analyze_And_Resolve (N, T); 223 Set_Is_Static_Expression (N, False); 224 end if; 225 end Expand_Current_Value; 226 227 ------------------------- 228 -- Expand_Discriminant -- 229 ------------------------- 230 231 procedure Expand_Discriminant (N : Node_Id) is 232 Scop : constant Entity_Id := Scope (Entity (N)); 233 P : Node_Id := N; 234 Parent_P : Node_Id := Parent (P); 235 In_Entry : Boolean := False; 236 237 begin 238 -- The Incomplete_Or_Private_Kind happens while resolving the 239 -- discriminant constraint involved in a derived full type, 240 -- such as: 241 242 -- type D is private; 243 -- type D(C : ...) is new T(C); 244 245 if Ekind (Scop) = E_Record_Type 246 or Ekind (Scop) in Incomplete_Or_Private_Kind 247 then 248 -- Find the origin by walking up the tree till the component 249 -- declaration 250 251 while Present (Parent_P) 252 and then Nkind (Parent_P) /= N_Component_Declaration 253 loop 254 P := Parent_P; 255 Parent_P := Parent (P); 256 end loop; 257 258 -- If the discriminant reference was part of the default expression 259 -- it has to be "discriminalized" 260 261 if Present (Parent_P) and then P = Expression (Parent_P) then 262 Set_Entity (N, Discriminal (Entity (N))); 263 end if; 264 265 elsif Is_Concurrent_Type (Scop) then 266 while Present (Parent_P) 267 and then Nkind (Parent_P) /= N_Subprogram_Body 268 loop 269 P := Parent_P; 270 271 if Nkind (P) = N_Entry_Declaration then 272 In_Entry := True; 273 end if; 274 275 Parent_P := Parent (Parent_P); 276 end loop; 277 278 -- If the discriminant occurs within the default expression for a 279 -- formal of an entry or protected operation, replace it with a 280 -- reference to the discriminant of the formal of the enclosing 281 -- operation. 282 283 if Present (Parent_P) 284 and then Present (Corresponding_Spec (Parent_P)) 285 then 286 declare 287 Loc : constant Source_Ptr := Sloc (N); 288 D_Fun : constant Entity_Id := Corresponding_Spec (Parent_P); 289 Formal : constant Entity_Id := First_Formal (D_Fun); 290 New_N : Node_Id; 291 Disc : Entity_Id; 292 293 begin 294 -- Verify that we are within the body of an entry or protected 295 -- operation. Its first formal parameter is the synchronized 296 -- type itself. 297 298 if Present (Formal) 299 and then Etype (Formal) = Scope (Entity (N)) 300 then 301 Disc := CR_Discriminant (Entity (N)); 302 303 New_N := 304 Make_Selected_Component (Loc, 305 Prefix => New_Occurrence_Of (Formal, Loc), 306 Selector_Name => New_Occurrence_Of (Disc, Loc)); 307 308 Set_Etype (New_N, Etype (N)); 309 Rewrite (N, New_N); 310 311 else 312 Set_Entity (N, Discriminal (Entity (N))); 313 end if; 314 end; 315 316 elsif Nkind (Parent (N)) = N_Range 317 and then In_Entry 318 then 319 Set_Entity (N, CR_Discriminant (Entity (N))); 320 321 -- Finally, if the entity is the discriminant of the original 322 -- type declaration, and we are within the initialization 323 -- procedure for a task, the designated entity is the 324 -- discriminal of the task body. This can happen when the 325 -- argument of pragma Task_Name mentions a discriminant, 326 -- because the pragma is analyzed in the task declaration 327 -- but is expanded in the call to Create_Task in the init_proc. 328 329 elsif Within_Init_Proc then 330 Set_Entity (N, Discriminal (CR_Discriminant (Entity (N)))); 331 else 332 Set_Entity (N, Discriminal (Entity (N))); 333 end if; 334 335 else 336 Set_Entity (N, Discriminal (Entity (N))); 337 end if; 338 end Expand_Discriminant; 339 340 ----------------------------- 341 -- Expand_Entity_Reference -- 342 ----------------------------- 343 344 procedure Expand_Entity_Reference (N : Node_Id) is 345 346 function Is_Object_Renaming_Name (N : Node_Id) return Boolean; 347 -- Indicates that N occurs (after accounting for qualified expressions 348 -- and type conversions) as the name of an object renaming declaration. 349 -- We don't want to fold values in that case. 350 351 ----------------------------- 352 -- Is_Object_Renaming_Name -- 353 ----------------------------- 354 355 function Is_Object_Renaming_Name (N : Node_Id) return Boolean is 356 Trailer : Node_Id := N; 357 Rover : Node_Id; 358 begin 359 loop 360 Rover := Parent (Trailer); 361 case Nkind (Rover) is 362 when N_Qualified_Expression | N_Type_Conversion => 363 -- Conservative for type conversions; only necessary if 364 -- conversion does not introduce a new object (as opposed 365 -- to a new view of an existing object). 366 null; 367 when N_Object_Renaming_Declaration => 368 return Trailer = Name (Rover); 369 when others => 370 return False; -- the usual case 371 end case; 372 Trailer := Rover; 373 end loop; 374 end Is_Object_Renaming_Name; 375 376 -- Local variables 377 378 E : constant Entity_Id := Entity (N); 379 380 -- Start of processing for Expand_Entity_Reference 381 382 begin 383 -- Defend against errors 384 385 if No (E) then 386 Check_Error_Detected; 387 return; 388 end if; 389 390 if Ekind (E) = E_Discriminant then 391 Expand_Discriminant (N); 392 393 elsif Is_Entry_Formal (E) then 394 Expand_Entry_Parameter (N); 395 396 elsif Is_Protected_Component (E) then 397 if No_Run_Time_Mode then 398 return; 399 else 400 Expand_Protected_Component (N); 401 end if; 402 403 elsif Ekind (E) = E_Entry_Index_Parameter then 404 Expand_Entry_Index_Parameter (N); 405 406 elsif Is_Formal (E) then 407 Expand_Formal (N); 408 409 elsif Is_Renaming_Of_Object (E) then 410 Expand_Renaming (N); 411 412 elsif Ekind (E) = E_Variable 413 and then Is_Shared_Passive (E) 414 then 415 Expand_Shared_Passive_Variable (N); 416 end if; 417 418 -- Test code for implementing the pragma Reviewable requirement of 419 -- classifying reads of scalars as referencing potentially uninitialized 420 -- objects or not. 421 422 if Debug_Flag_XX 423 and then Is_Scalar_Type (Etype (N)) 424 and then (Is_Assignable (E) or else Is_Constant_Object (E)) 425 and then Comes_From_Source (N) 426 and then Is_LHS (N) = No 427 and then not Is_Actual_Out_Parameter (N) 428 and then (Nkind (Parent (N)) /= N_Attribute_Reference 429 or else Attribute_Name (Parent (N)) /= Name_Valid) 430 then 431 Write_Location (Sloc (N)); 432 Write_Str (": Read from scalar """); 433 Write_Name (Chars (N)); 434 Write_Str (""""); 435 436 if Is_Known_Valid (E) then 437 Write_Str (", Is_Known_Valid"); 438 end if; 439 440 Write_Eol; 441 end if; 442 443 -- Set Atomic_Sync_Required if necessary for atomic variable. Note that 444 -- this processing does NOT apply to Volatile_Full_Access variables. 445 446 if Nkind (N) in N_Identifier | N_Expanded_Name 447 and then Ekind (E) = E_Variable 448 and then (Is_Atomic (E) or else Is_Atomic (Etype (E))) 449 then 450 declare 451 Set : Boolean; 452 453 begin 454 -- If variable is atomic, but type is not, setting depends on 455 -- disable/enable state for the variable. 456 457 if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then 458 Set := not Atomic_Synchronization_Disabled (E); 459 460 -- If variable is not atomic, but its type is atomic, setting 461 -- depends on disable/enable state for the type. 462 463 elsif not Is_Atomic (E) and then Is_Atomic (Etype (E)) then 464 Set := not Atomic_Synchronization_Disabled (Etype (E)); 465 466 -- Else both variable and type are atomic (see outer if), and we 467 -- disable if either variable or its type have sync disabled. 468 469 else 470 Set := (not Atomic_Synchronization_Disabled (E)) 471 and then 472 (not Atomic_Synchronization_Disabled (Etype (E))); 473 end if; 474 475 -- Set flag if required 476 477 if Set then 478 Activate_Atomic_Synchronization (N); 479 end if; 480 end; 481 end if; 482 483 -- Interpret possible Current_Value for variable case. The 484 -- Is_Object_Renaming_Name test is needed for cases such as 485 -- X : Integer := 1; 486 -- Y : Integer renames Integer'(X); 487 -- where the value of Y is changed by any subsequent assignments to X. 488 -- In cases like this, we do not want to use Current_Value even though 489 -- it is available. 490 491 if Is_Assignable (E) 492 and then Present (Current_Value (E)) 493 and then not Is_Object_Renaming_Name (N) 494 then 495 Expand_Current_Value (N); 496 497 -- We do want to warn for the case of a boolean variable (not a 498 -- boolean constant) whose value is known at compile time. 499 500 if Is_Boolean_Type (Etype (N)) then 501 Warn_On_Known_Condition (N); 502 end if; 503 504 -- Don't mess with Current_Value for compile time known values. Not 505 -- only is it unnecessary, but we could disturb an indication of a 506 -- static value, which could cause semantic trouble. 507 508 elsif Compile_Time_Known_Value (N) then 509 null; 510 511 -- Interpret possible Current_Value for constant case 512 513 elsif Is_Constant_Object (E) 514 and then Present (Current_Value (E)) 515 then 516 Expand_Current_Value (N); 517 end if; 518 end Expand_Entity_Reference; 519 520 ---------------------------------- 521 -- Expand_Entry_Index_Parameter -- 522 ---------------------------------- 523 524 procedure Expand_Entry_Index_Parameter (N : Node_Id) is 525 Index_Con : constant Entity_Id := Entry_Index_Constant (Entity (N)); 526 begin 527 Set_Entity (N, Index_Con); 528 Set_Etype (N, Etype (Index_Con)); 529 end Expand_Entry_Index_Parameter; 530 531 ---------------------------- 532 -- Expand_Entry_Parameter -- 533 ---------------------------- 534 535 procedure Expand_Entry_Parameter (N : Node_Id) is 536 Loc : constant Source_Ptr := Sloc (N); 537 Ent_Formal : constant Entity_Id := Entity (N); 538 Ent_Spec : constant Entity_Id := Scope (Ent_Formal); 539 Parm_Type : constant Entity_Id := Entry_Parameters_Type (Ent_Spec); 540 Acc_Stack : constant Elist_Id := Accept_Address (Ent_Spec); 541 Addr_Ent : constant Entity_Id := Node (Last_Elmt (Acc_Stack)); 542 P_Comp_Ref : Entity_Id; 543 544 function In_Assignment_Context (N : Node_Id) return Boolean; 545 -- Check whether this is a context in which the entry formal may be 546 -- assigned to. 547 548 --------------------------- 549 -- In_Assignment_Context -- 550 --------------------------- 551 552 function In_Assignment_Context (N : Node_Id) return Boolean is 553 begin 554 -- Case of use in a call 555 556 -- ??? passing a formal as actual for a mode IN formal is 557 -- considered as an assignment? 558 559 if Nkind (Parent (N)) in 560 N_Procedure_Call_Statement | N_Entry_Call_Statement 561 or else (Nkind (Parent (N)) = N_Assignment_Statement 562 and then N = Name (Parent (N))) 563 then 564 return True; 565 566 -- Case of a parameter association: climb up to enclosing call 567 568 elsif Nkind (Parent (N)) = N_Parameter_Association then 569 return In_Assignment_Context (Parent (N)); 570 571 -- Case of a selected component, indexed component or slice prefix: 572 -- climb up the tree, unless the prefix is of an access type (in 573 -- which case there is an implicit dereference, and the formal itself 574 -- is not being assigned to). 575 576 elsif Nkind (Parent (N)) in 577 N_Selected_Component | N_Indexed_Component | N_Slice 578 and then N = Prefix (Parent (N)) 579 and then not Is_Access_Type (Etype (N)) 580 and then In_Assignment_Context (Parent (N)) 581 then 582 return True; 583 584 else 585 return False; 586 end if; 587 end In_Assignment_Context; 588 589 -- Start of processing for Expand_Entry_Parameter 590 591 begin 592 if Is_Task_Type (Scope (Ent_Spec)) 593 and then Comes_From_Source (Ent_Formal) 594 then 595 -- Before replacing the formal with the local renaming that is used 596 -- in the accept block, note if this is an assignment context, and 597 -- note the modification to avoid spurious warnings, because the 598 -- original entity is not used further. If formal is unconstrained, 599 -- we also generate an extra parameter to hold the Constrained 600 -- attribute of the actual. No renaming is generated for this flag. 601 602 -- Calling Note_Possible_Modification in the expander is dubious, 603 -- because this generates a cross-reference entry, and should be 604 -- done during semantic processing so it is called in -gnatc mode??? 605 606 if Ekind (Entity (N)) /= E_In_Parameter 607 and then In_Assignment_Context (N) 608 then 609 Note_Possible_Modification (N, Sure => True); 610 end if; 611 end if; 612 613 -- What we need is a reference to the corresponding component of the 614 -- parameter record object. The Accept_Address field of the entry entity 615 -- references the address variable that contains the address of the 616 -- accept parameters record. We first have to do an unchecked conversion 617 -- to turn this into a pointer to the parameter record and then we 618 -- select the required parameter field. 619 620 -- The same processing applies to protected entries, where the Accept_ 621 -- Address is also the address of the Parameters record. 622 623 P_Comp_Ref := 624 Make_Selected_Component (Loc, 625 Prefix => 626 Make_Explicit_Dereference (Loc, 627 Unchecked_Convert_To (Parm_Type, 628 New_Occurrence_Of (Addr_Ent, Loc))), 629 Selector_Name => 630 New_Occurrence_Of (Entry_Component (Ent_Formal), Loc)); 631 632 -- For all types of parameters, the constructed parameter record object 633 -- contains a pointer to the parameter. Thus we must dereference them to 634 -- access them (this will often be redundant, since the dereference is 635 -- implicit, but no harm is done by making it explicit). 636 637 Rewrite (N, 638 Make_Explicit_Dereference (Loc, P_Comp_Ref)); 639 640 Analyze (N); 641 end Expand_Entry_Parameter; 642 643 ------------------- 644 -- Expand_Formal -- 645 ------------------- 646 647 procedure Expand_Formal (N : Node_Id) is 648 E : constant Entity_Id := Entity (N); 649 Scop : constant Entity_Id := Scope (E); 650 651 begin 652 -- Check whether the subprogram of which this is a formal is 653 -- a protected operation. The initialization procedure for 654 -- the corresponding record type is not itself a protected operation. 655 656 if Is_Protected_Type (Scope (Scop)) 657 and then not Is_Init_Proc (Scop) 658 and then Present (Protected_Formal (E)) 659 then 660 Set_Entity (N, Protected_Formal (E)); 661 end if; 662 end Expand_Formal; 663 664 ---------------------------- 665 -- Expand_N_Expanded_Name -- 666 ---------------------------- 667 668 procedure Expand_N_Expanded_Name (N : Node_Id) is 669 begin 670 Expand_Entity_Reference (N); 671 end Expand_N_Expanded_Name; 672 673 ------------------------- 674 -- Expand_N_Identifier -- 675 ------------------------- 676 677 procedure Expand_N_Identifier (N : Node_Id) is 678 begin 679 Expand_Entity_Reference (N); 680 end Expand_N_Identifier; 681 682 --------------------------- 683 -- Expand_N_Real_Literal -- 684 --------------------------- 685 686 procedure Expand_N_Real_Literal (N : Node_Id) is 687 pragma Unreferenced (N); 688 689 begin 690 -- Historically, this routine existed because there were expansion 691 -- requirements for Vax real literals, but now Vax real literals 692 -- are now handled by gigi, so this routine no longer does anything. 693 694 null; 695 end Expand_N_Real_Literal; 696 697 -------------------------------- 698 -- Expand_Protected_Component -- 699 -------------------------------- 700 701 procedure Expand_Protected_Component (N : Node_Id) is 702 703 function Inside_Eliminated_Body return Boolean; 704 -- Determine whether the current entity is inside a subprogram or an 705 -- entry which has been marked as eliminated. 706 707 ---------------------------- 708 -- Inside_Eliminated_Body -- 709 ---------------------------- 710 711 function Inside_Eliminated_Body return Boolean is 712 S : Entity_Id := Current_Scope; 713 714 begin 715 while Present (S) loop 716 if (Ekind (S) = E_Entry 717 or else Ekind (S) = E_Entry_Family 718 or else Ekind (S) = E_Function 719 or else Ekind (S) = E_Procedure) 720 and then Is_Eliminated (S) 721 then 722 return True; 723 end if; 724 725 S := Scope (S); 726 end loop; 727 728 return False; 729 end Inside_Eliminated_Body; 730 731 -- Start of processing for Expand_Protected_Component 732 733 begin 734 -- Eliminated bodies are not expanded and thus do not need privals 735 736 if not Inside_Eliminated_Body then 737 declare 738 Priv : constant Entity_Id := Prival (Entity (N)); 739 begin 740 Set_Entity (N, Priv); 741 Set_Etype (N, Etype (Priv)); 742 end; 743 end if; 744 end Expand_Protected_Component; 745 746 --------------------- 747 -- Expand_Renaming -- 748 --------------------- 749 750 procedure Expand_Renaming (N : Node_Id) is 751 E : constant Entity_Id := Entity (N); 752 T : constant Entity_Id := Etype (N); 753 754 begin 755 Rewrite (N, New_Copy_Tree (Renamed_Object (E))); 756 757 -- We mark the copy as unanalyzed, so that it is sure to be reanalyzed 758 -- at the top level. This is needed in the packed case since we 759 -- specifically avoided expanding packed array references when the 760 -- renaming declaration was analyzed. 761 762 Reset_Analyzed_Flags (N); 763 Analyze_And_Resolve (N, T); 764 end Expand_Renaming; 765 766end Exp_Ch2; 767