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-2019, 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 -- Start of processing for Expand_Current_Value 126 127 begin 128 if True 129 130 -- No replacement if value raises constraint error 131 132 and then Nkind (CV) /= N_Raise_Constraint_Error 133 134 -- Do this only for discrete types 135 136 and then Is_Discrete_Type (T) 137 138 -- Do not replace biased types, since it is problematic to 139 -- consistently generate a sensible constant value in this case. 140 141 and then not Has_Biased_Representation (T) 142 143 -- Do not replace lvalues 144 145 and then not May_Be_Lvalue (N) 146 147 -- Check that entity is suitable for replacement 148 149 and then OK_To_Do_Constant_Replacement (E) 150 151 -- Do not replace occurrences in pragmas (where names typically 152 -- appear not as values, but as simply names. If there are cases 153 -- where values are required, it is only a very minor efficiency 154 -- issue that they do not get replaced when they could be). 155 156 and then Nkind (Parent (N)) /= N_Pragma_Argument_Association 157 158 -- Do not replace the prefixes of attribute references, since this 159 -- causes trouble with cases like 4'Size. Also for Name_Asm_Input and 160 -- Name_Asm_Output, don't do replacement anywhere, since we can have 161 -- lvalue references in the arguments. 162 163 and then not (Nkind (Parent (N)) = N_Attribute_Reference 164 and then 165 (Nam_In (Attribute_Name (Parent (N)), 166 Name_Asm_Input, 167 Name_Asm_Output) 168 or else Prefix (Parent (N)) = N)) 169 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 E : constant Entity_Id := Entity (N); 346 347 begin 348 -- Defend against errors 349 350 if No (E) then 351 Check_Error_Detected; 352 return; 353 end if; 354 355 if Ekind (E) = E_Discriminant then 356 Expand_Discriminant (N); 357 358 elsif Is_Entry_Formal (E) then 359 Expand_Entry_Parameter (N); 360 361 elsif Is_Protected_Component (E) then 362 if No_Run_Time_Mode then 363 return; 364 else 365 Expand_Protected_Component (N); 366 end if; 367 368 elsif Ekind (E) = E_Entry_Index_Parameter then 369 Expand_Entry_Index_Parameter (N); 370 371 elsif Is_Formal (E) then 372 Expand_Formal (N); 373 374 elsif Is_Renaming_Of_Object (E) then 375 Expand_Renaming (N); 376 377 elsif Ekind (E) = E_Variable 378 and then Is_Shared_Passive (E) 379 then 380 Expand_Shared_Passive_Variable (N); 381 end if; 382 383 -- Test code for implementing the pragma Reviewable requirement of 384 -- classifying reads of scalars as referencing potentially uninitialized 385 -- objects or not. 386 387 if Debug_Flag_XX 388 and then Is_Scalar_Type (Etype (N)) 389 and then (Is_Assignable (E) or else Is_Constant_Object (E)) 390 and then Comes_From_Source (N) 391 and then Is_LHS (N) = No 392 and then not Is_Actual_Out_Parameter (N) 393 and then (Nkind (Parent (N)) /= N_Attribute_Reference 394 or else Attribute_Name (Parent (N)) /= Name_Valid) 395 then 396 Write_Location (Sloc (N)); 397 Write_Str (": Read from scalar """); 398 Write_Name (Chars (N)); 399 Write_Str (""""); 400 401 if Is_Known_Valid (E) then 402 Write_Str (", Is_Known_Valid"); 403 end if; 404 405 Write_Eol; 406 end if; 407 408 -- Set Atomic_Sync_Required if necessary for atomic variable. Note that 409 -- this processing does NOT apply to Volatile_Full_Access variables. 410 411 if Nkind_In (N, N_Identifier, N_Expanded_Name) 412 and then Ekind (E) = E_Variable 413 and then (Is_Atomic (E) or else Is_Atomic (Etype (E))) 414 then 415 declare 416 Set : Boolean; 417 418 begin 419 -- If variable is atomic, but type is not, setting depends on 420 -- disable/enable state for the variable. 421 422 if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then 423 Set := not Atomic_Synchronization_Disabled (E); 424 425 -- If variable is not atomic, but its type is atomic, setting 426 -- depends on disable/enable state for the type. 427 428 elsif not Is_Atomic (E) and then Is_Atomic (Etype (E)) then 429 Set := not Atomic_Synchronization_Disabled (Etype (E)); 430 431 -- Else both variable and type are atomic (see outer if), and we 432 -- disable if either variable or its type have sync disabled. 433 434 else 435 Set := (not Atomic_Synchronization_Disabled (E)) 436 and then 437 (not Atomic_Synchronization_Disabled (Etype (E))); 438 end if; 439 440 -- Set flag if required 441 442 if Set then 443 Activate_Atomic_Synchronization (N); 444 end if; 445 end; 446 end if; 447 448 -- Interpret possible Current_Value for variable case 449 450 if Is_Assignable (E) 451 and then Present (Current_Value (E)) 452 then 453 Expand_Current_Value (N); 454 455 -- We do want to warn for the case of a boolean variable (not a 456 -- boolean constant) whose value is known at compile time. 457 458 if Is_Boolean_Type (Etype (N)) then 459 Warn_On_Known_Condition (N); 460 end if; 461 462 -- Don't mess with Current_Value for compile time known values. Not 463 -- only is it unnecessary, but we could disturb an indication of a 464 -- static value, which could cause semantic trouble. 465 466 elsif Compile_Time_Known_Value (N) then 467 null; 468 469 -- Interpret possible Current_Value for constant case 470 471 elsif Is_Constant_Object (E) 472 and then Present (Current_Value (E)) 473 then 474 Expand_Current_Value (N); 475 end if; 476 end Expand_Entity_Reference; 477 478 ---------------------------------- 479 -- Expand_Entry_Index_Parameter -- 480 ---------------------------------- 481 482 procedure Expand_Entry_Index_Parameter (N : Node_Id) is 483 Index_Con : constant Entity_Id := Entry_Index_Constant (Entity (N)); 484 begin 485 Set_Entity (N, Index_Con); 486 Set_Etype (N, Etype (Index_Con)); 487 end Expand_Entry_Index_Parameter; 488 489 ---------------------------- 490 -- Expand_Entry_Parameter -- 491 ---------------------------- 492 493 procedure Expand_Entry_Parameter (N : Node_Id) is 494 Loc : constant Source_Ptr := Sloc (N); 495 Ent_Formal : constant Entity_Id := Entity (N); 496 Ent_Spec : constant Entity_Id := Scope (Ent_Formal); 497 Parm_Type : constant Entity_Id := Entry_Parameters_Type (Ent_Spec); 498 Acc_Stack : constant Elist_Id := Accept_Address (Ent_Spec); 499 Addr_Ent : constant Entity_Id := Node (Last_Elmt (Acc_Stack)); 500 P_Comp_Ref : Entity_Id; 501 502 function In_Assignment_Context (N : Node_Id) return Boolean; 503 -- Check whether this is a context in which the entry formal may be 504 -- assigned to. 505 506 --------------------------- 507 -- In_Assignment_Context -- 508 --------------------------- 509 510 function In_Assignment_Context (N : Node_Id) return Boolean is 511 begin 512 -- Case of use in a call 513 514 -- ??? passing a formal as actual for a mode IN formal is 515 -- considered as an assignment? 516 517 if Nkind_In (Parent (N), N_Procedure_Call_Statement, 518 N_Entry_Call_Statement) 519 or else (Nkind (Parent (N)) = N_Assignment_Statement 520 and then N = Name (Parent (N))) 521 then 522 return True; 523 524 -- Case of a parameter association: climb up to enclosing call 525 526 elsif Nkind (Parent (N)) = N_Parameter_Association then 527 return In_Assignment_Context (Parent (N)); 528 529 -- Case of a selected component, indexed component or slice prefix: 530 -- climb up the tree, unless the prefix is of an access type (in 531 -- which case there is an implicit dereference, and the formal itself 532 -- is not being assigned to). 533 534 elsif Nkind_In (Parent (N), N_Selected_Component, 535 N_Indexed_Component, 536 N_Slice) 537 and then N = Prefix (Parent (N)) 538 and then not Is_Access_Type (Etype (N)) 539 and then In_Assignment_Context (Parent (N)) 540 then 541 return True; 542 543 else 544 return False; 545 end if; 546 end In_Assignment_Context; 547 548 -- Start of processing for Expand_Entry_Parameter 549 550 begin 551 if Is_Task_Type (Scope (Ent_Spec)) 552 and then Comes_From_Source (Ent_Formal) 553 then 554 -- Before replacing the formal with the local renaming that is used 555 -- in the accept block, note if this is an assignment context, and 556 -- note the modification to avoid spurious warnings, because the 557 -- original entity is not used further. If formal is unconstrained, 558 -- we also generate an extra parameter to hold the Constrained 559 -- attribute of the actual. No renaming is generated for this flag. 560 561 -- Calling Note_Possible_Modification in the expander is dubious, 562 -- because this generates a cross-reference entry, and should be 563 -- done during semantic processing so it is called in -gnatc mode??? 564 565 if Ekind (Entity (N)) /= E_In_Parameter 566 and then In_Assignment_Context (N) 567 then 568 Note_Possible_Modification (N, Sure => True); 569 end if; 570 end if; 571 572 -- What we need is a reference to the corresponding component of the 573 -- parameter record object. The Accept_Address field of the entry entity 574 -- references the address variable that contains the address of the 575 -- accept parameters record. We first have to do an unchecked conversion 576 -- to turn this into a pointer to the parameter record and then we 577 -- select the required parameter field. 578 579 -- The same processing applies to protected entries, where the Accept_ 580 -- Address is also the address of the Parameters record. 581 582 P_Comp_Ref := 583 Make_Selected_Component (Loc, 584 Prefix => 585 Make_Explicit_Dereference (Loc, 586 Unchecked_Convert_To (Parm_Type, 587 New_Occurrence_Of (Addr_Ent, Loc))), 588 Selector_Name => 589 New_Occurrence_Of (Entry_Component (Ent_Formal), Loc)); 590 591 -- For all types of parameters, the constructed parameter record object 592 -- contains a pointer to the parameter. Thus we must dereference them to 593 -- access them (this will often be redundant, since the dereference is 594 -- implicit, but no harm is done by making it explicit). 595 596 Rewrite (N, 597 Make_Explicit_Dereference (Loc, P_Comp_Ref)); 598 599 Analyze (N); 600 end Expand_Entry_Parameter; 601 602 ------------------- 603 -- Expand_Formal -- 604 ------------------- 605 606 procedure Expand_Formal (N : Node_Id) is 607 E : constant Entity_Id := Entity (N); 608 Scop : constant Entity_Id := Scope (E); 609 610 begin 611 -- Check whether the subprogram of which this is a formal is 612 -- a protected operation. The initialization procedure for 613 -- the corresponding record type is not itself a protected operation. 614 615 if Is_Protected_Type (Scope (Scop)) 616 and then not Is_Init_Proc (Scop) 617 and then Present (Protected_Formal (E)) 618 then 619 Set_Entity (N, Protected_Formal (E)); 620 end if; 621 end Expand_Formal; 622 623 ---------------------------- 624 -- Expand_N_Expanded_Name -- 625 ---------------------------- 626 627 procedure Expand_N_Expanded_Name (N : Node_Id) is 628 begin 629 Expand_Entity_Reference (N); 630 end Expand_N_Expanded_Name; 631 632 ------------------------- 633 -- Expand_N_Identifier -- 634 ------------------------- 635 636 procedure Expand_N_Identifier (N : Node_Id) is 637 begin 638 Expand_Entity_Reference (N); 639 end Expand_N_Identifier; 640 641 --------------------------- 642 -- Expand_N_Real_Literal -- 643 --------------------------- 644 645 procedure Expand_N_Real_Literal (N : Node_Id) is 646 pragma Unreferenced (N); 647 648 begin 649 -- Historically, this routine existed because there were expansion 650 -- requirements for Vax real literals, but now Vax real literals 651 -- are now handled by gigi, so this routine no longer does anything. 652 653 null; 654 end Expand_N_Real_Literal; 655 656 -------------------------------- 657 -- Expand_Protected_Component -- 658 -------------------------------- 659 660 procedure Expand_Protected_Component (N : Node_Id) is 661 662 function Inside_Eliminated_Body return Boolean; 663 -- Determine whether the current entity is inside a subprogram or an 664 -- entry which has been marked as eliminated. 665 666 ---------------------------- 667 -- Inside_Eliminated_Body -- 668 ---------------------------- 669 670 function Inside_Eliminated_Body return Boolean is 671 S : Entity_Id := Current_Scope; 672 673 begin 674 while Present (S) loop 675 if (Ekind (S) = E_Entry 676 or else Ekind (S) = E_Entry_Family 677 or else Ekind (S) = E_Function 678 or else Ekind (S) = E_Procedure) 679 and then Is_Eliminated (S) 680 then 681 return True; 682 end if; 683 684 S := Scope (S); 685 end loop; 686 687 return False; 688 end Inside_Eliminated_Body; 689 690 -- Start of processing for Expand_Protected_Component 691 692 begin 693 -- Eliminated bodies are not expanded and thus do not need privals 694 695 if not Inside_Eliminated_Body then 696 declare 697 Priv : constant Entity_Id := Prival (Entity (N)); 698 begin 699 Set_Entity (N, Priv); 700 Set_Etype (N, Etype (Priv)); 701 end; 702 end if; 703 end Expand_Protected_Component; 704 705 --------------------- 706 -- Expand_Renaming -- 707 --------------------- 708 709 procedure Expand_Renaming (N : Node_Id) is 710 E : constant Entity_Id := Entity (N); 711 T : constant Entity_Id := Etype (N); 712 713 begin 714 Rewrite (N, New_Copy_Tree (Renamed_Object (E))); 715 716 -- We mark the copy as unanalyzed, so that it is sure to be reanalyzed 717 -- at the top level. This is needed in the packed case since we 718 -- specifically avoided expanding packed array references when the 719 -- renaming declaration was analyzed. 720 721 Reset_Analyzed_Flags (N); 722 Analyze_And_Resolve (N, T); 723 end Expand_Renaming; 724 725 ------------------ 726 -- Param_Entity -- 727 ------------------ 728 729 -- This would be trivial, simply a test for an identifier that was a 730 -- reference to a formal, if it were not for the fact that a previous call 731 -- to Expand_Entry_Parameter will have modified the reference to the 732 -- identifier. A formal of a protected entity is rewritten as 733 734 -- typ!(recobj).rec.all'Constrained 735 736 -- where rec is a selector whose Entry_Formal link points to the formal 737 738 -- If the type of the entry parameter has a representation clause, then an 739 -- extra temp is involved (see below). 740 741 -- For a formal of a task entity, the formal is rewritten as a local 742 -- renaming. 743 744 -- In addition, a formal that is marked volatile because it is aliased 745 -- through an address clause is rewritten as dereference as well. 746 747 function Param_Entity (N : Node_Id) return Entity_Id is 748 Renamed_Obj : Node_Id; 749 750 begin 751 -- Simple reference case 752 753 if Nkind_In (N, N_Identifier, N_Expanded_Name) then 754 if Is_Formal (Entity (N)) then 755 return Entity (N); 756 757 -- Handle renamings of formal parameters and formals of tasks that 758 -- are rewritten as renamings. 759 760 elsif Nkind (Parent (Entity (N))) = N_Object_Renaming_Declaration then 761 Renamed_Obj := Get_Referenced_Object (Renamed_Object (Entity (N))); 762 763 if Is_Entity_Name (Renamed_Obj) 764 and then Is_Formal (Entity (Renamed_Obj)) 765 then 766 return Entity (Renamed_Obj); 767 768 elsif 769 Nkind (Parent (Parent (Entity (N)))) = N_Accept_Statement 770 then 771 return Entity (N); 772 end if; 773 end if; 774 775 else 776 if Nkind (N) = N_Explicit_Dereference then 777 declare 778 P : Node_Id := Prefix (N); 779 S : Node_Id; 780 E : Entity_Id; 781 Decl : Node_Id; 782 783 begin 784 -- If the type of an entry parameter has a representation 785 -- clause, then the prefix is not a selected component, but 786 -- instead a reference to a temp pointing at the selected 787 -- component. In this case, set P to be the initial value of 788 -- that temp. 789 790 if Nkind (P) = N_Identifier then 791 E := Entity (P); 792 793 if Ekind (E) = E_Constant then 794 Decl := Parent (E); 795 796 if Nkind (Decl) = N_Object_Declaration then 797 P := Expression (Decl); 798 end if; 799 end if; 800 end if; 801 802 if Nkind (P) = N_Selected_Component then 803 S := Selector_Name (P); 804 805 if Present (Entry_Formal (Entity (S))) then 806 return Entry_Formal (Entity (S)); 807 end if; 808 809 elsif Nkind (Original_Node (N)) = N_Identifier then 810 return Param_Entity (Original_Node (N)); 811 end if; 812 end; 813 end if; 814 end if; 815 816 return (Empty); 817 end Param_Entity; 818 819end Exp_Ch2; 820