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