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-2003 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Atree; use Atree; 28with Debug; use Debug; 29with Einfo; use Einfo; 30with Elists; use Elists; 31with Errout; use Errout; 32with Exp_Smem; use Exp_Smem; 33with Exp_Tss; use Exp_Tss; 34with Exp_Util; use Exp_Util; 35with Exp_VFpt; use Exp_VFpt; 36with Nmake; use Nmake; 37with Opt; use Opt; 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 Stand; use Stand; 45with Tbuild; use Tbuild; 46with Uintp; use Uintp; 47 48package body Exp_Ch2 is 49 50 ----------------------- 51 -- Local Subprograms -- 52 ----------------------- 53 54 procedure Expand_Current_Value (N : Node_Id); 55 -- Given a node N for a variable whose Current_Value field is set. 56 -- If the node is for a discrete type, replaces the node with a 57 -- copy of the referenced value. This provides a limited form of 58 -- value propagation for variables which are initialized and have 59 -- not been modified at the time of reference. The call has no 60 -- effect if the Current_Value refers to a conditional with a 61 -- condition other than equality. 62 63 procedure Expand_Discriminant (N : Node_Id); 64 -- An occurrence of a discriminant within a discriminated type is replaced 65 -- with the corresponding discriminal, that is to say the formal parameter 66 -- of the initialization procedure for the type that is associated with 67 -- that particular discriminant. This replacement is not performed for 68 -- discriminants of records that appear in constraints of component of the 69 -- record, because Gigi uses the discriminant name to retrieve its value. 70 -- In the other hand, it has to be performed for default expressions of 71 -- components because they are used in the record init procedure. See 72 -- Einfo for more details, and Exp_Ch3, Exp_Ch9 for examples of use. 73 -- For discriminants of tasks and protected types, the transformation is 74 -- more complex when it occurs within a default expression for an entry 75 -- or protected operation. The corresponding default_expression_function 76 -- has an additional parameter which is the target of an entry call, and 77 -- the discriminant of the task must be replaced with a reference to the 78 -- discriminant of that formal parameter. 79 80 procedure Expand_Entity_Reference (N : Node_Id); 81 -- Common processing for expansion of identifiers and expanded names 82 83 procedure Expand_Entry_Index_Parameter (N : Node_Id); 84 -- A reference to the identifier in the entry index specification 85 -- of a protected entry body is modified to a reference to a constant 86 -- definintion equal to the index of the entry family member being 87 -- called. This constant is calculated as part of the elaboration 88 -- of the expanded code for the body, and is calculated from the 89 -- object-wide entry index returned by Next_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 93 -- the corresponding component of the entry parameter record that is 94 -- passed by 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 98 -- expanded to the corresponding formal of the unprotected procedure 99 -- used to represent the protected subprogram within the protected object. 100 101 procedure Expand_Protected_Private (N : Node_Id); 102 -- A reference to a private object of a protected type is expanded 103 -- to a component selected from the record used to implement 104 -- the protected object. Such a record is passed to all operations 105 -- on a protected object in a parameter named _object. Such an object 106 -- is a constant within a function, and a variable otherwise. 107 108 procedure Expand_Renaming (N : Node_Id); 109 -- For renamings, just replace the identifier by the corresponding 110 -- name expression. Note that this has been evaluated (see routine 111 -- Exp_Ch8.Expand_N_Object_Renaming.Evaluate_Name) so this gives 112 -- the correct renaming semantics. 113 114 -------------------------- 115 -- Expand_Current_Value -- 116 -------------------------- 117 118 procedure Expand_Current_Value (N : Node_Id) is 119 Loc : constant Source_Ptr := Sloc (N); 120 E : constant Entity_Id := Entity (N); 121 CV : constant Node_Id := Current_Value (E); 122 T : constant Entity_Id := Etype (N); 123 Val : Node_Id; 124 Op : Node_Kind; 125 126 function In_Appropriate_Scope return Boolean; 127 -- Returns true if the current scope is the scope of E, or is a nested 128 -- (to any level) package declaration, package body, or block of this 129 -- scope. The idea is that such references are in the sequential 130 -- execution sequence of statements executed after E is elaborated. 131 132 -------------------------- 133 -- In_Appropriate_Scope -- 134 -------------------------- 135 136 function In_Appropriate_Scope return Boolean is 137 ES : constant Entity_Id := Scope (E); 138 CS : Entity_Id; 139 140 begin 141 CS := Current_Scope; 142 143 loop 144 -- If we are in right scope, replacement is safe 145 146 if CS = ES then 147 return True; 148 149 -- Packages do not affect the determination of safety 150 151 elsif Ekind (CS) = E_Package then 152 CS := Scope (CS); 153 exit when CS = Standard_Standard; 154 155 -- Blocks do not affect the determination of safety 156 157 elsif Ekind (CS) = E_Block then 158 CS := Scope (CS); 159 160 -- Otherwise, the reference is dubious, and we cannot be 161 -- sure that it is safe to do the replacement. Note in 162 -- particular, in a loop (except for the special case 163 -- tested above), we cannot safely do a replacement since 164 -- there may be an assignment at the bottom of the loop 165 -- that will affect a reference at the top of the loop. 166 167 else 168 exit; 169 end if; 170 end loop; 171 172 return False; 173 end In_Appropriate_Scope; 174 175 -- Start of processing for Expand_Current_Value 176 177 begin 178 if True 179 180 -- Do this only for discrete types 181 182 and then Is_Discrete_Type (T) 183 184 -- Do not replace biased types, since it is problematic to 185 -- consistently generate a sensible constant value in this case. 186 187 and then not Has_Biased_Representation (T) 188 189 -- Do not replace lvalues 190 191 and then not Is_Lvalue (N) 192 193 -- Do not replace occurrences that are not in the current scope, 194 -- because in a nested subprogram we know absolutely nothing about 195 -- the sequence of execution. 196 197 and then In_Appropriate_Scope 198 199 -- Do not replace statically allocated objects, because they may 200 -- be modified outside the current scope. 201 202 and then not Is_Statically_Allocated (E) 203 204 -- Do not replace aliased or volatile objects, since we don't know 205 -- what else might change the value 206 207 and then not Is_Aliased (E) and then not Treat_As_Volatile (E) 208 209 -- Debug flag -gnatdM disconnects this optimization 210 211 and then not Debug_Flag_MM 212 213 -- Do not replace occurrences in pragmas (where names typically 214 -- appear not as values, but as simply names. If there are cases 215 -- where values are required, it is only a very minor efficiency 216 -- issue that they do not get replaced when they could be). 217 218 and then Nkind (Parent (N)) /= N_Pragma_Argument_Association 219 then 220 -- Case of Current_Value is a compile time known value 221 222 if Nkind (CV) in N_Subexpr then 223 Val := CV; 224 225 -- Case of Current_Value is a conditional expression reference 226 227 else 228 Get_Current_Value_Condition (N, Op, Val); 229 230 if Op /= N_Op_Eq then 231 return; 232 end if; 233 end if; 234 235 -- If constant value is an occurrence of an enumeration literal, 236 -- then we just make another occurence of the same literal. 237 238 if Is_Entity_Name (Val) 239 and then Ekind (Entity (Val)) = E_Enumeration_Literal 240 then 241 Rewrite (N, 242 Unchecked_Convert_To (T, 243 New_Occurrence_Of (Entity (Val), Loc))); 244 245 -- Otherwise get the value, and convert to appropriate type 246 247 else 248 Rewrite (N, 249 Unchecked_Convert_To (T, 250 Make_Integer_Literal (Loc, 251 Intval => Expr_Rep_Value (Val)))); 252 end if; 253 254 Analyze_And_Resolve (N, T); 255 Set_Is_Static_Expression (N, False); 256 end if; 257 end Expand_Current_Value; 258 259 ------------------------- 260 -- Expand_Discriminant -- 261 ------------------------- 262 263 procedure Expand_Discriminant (N : Node_Id) is 264 Scop : constant Entity_Id := Scope (Entity (N)); 265 P : Node_Id := N; 266 Parent_P : Node_Id := Parent (P); 267 In_Entry : Boolean := False; 268 269 begin 270 -- The Incomplete_Or_Private_Kind happens while resolving the 271 -- discriminant constraint involved in a derived full type, 272 -- such as: 273 274 -- type D is private; 275 -- type D(C : ...) is new T(C); 276 277 if Ekind (Scop) = E_Record_Type 278 or Ekind (Scop) in Incomplete_Or_Private_Kind 279 then 280 -- Find the origin by walking up the tree till the component 281 -- declaration 282 283 while Present (Parent_P) 284 and then Nkind (Parent_P) /= N_Component_Declaration 285 loop 286 P := Parent_P; 287 Parent_P := Parent (P); 288 end loop; 289 290 -- If the discriminant reference was part of the default expression 291 -- it has to be "discriminalized" 292 293 if Present (Parent_P) and then P = Expression (Parent_P) then 294 Set_Entity (N, Discriminal (Entity (N))); 295 end if; 296 297 elsif Is_Concurrent_Type (Scop) then 298 while Present (Parent_P) 299 and then Nkind (Parent_P) /= N_Subprogram_Body 300 loop 301 P := Parent_P; 302 303 if Nkind (P) = N_Entry_Declaration then 304 In_Entry := True; 305 end if; 306 307 Parent_P := Parent (Parent_P); 308 end loop; 309 310 -- If the discriminant occurs within the default expression for 311 -- a formal of an entry or protected operation, create a default 312 -- function for it, and replace the discriminant with a reference 313 -- to the discriminant of the formal of the default function. 314 -- The discriminant entity is the one defined in the corresponding 315 -- record. 316 317 if Present (Parent_P) 318 and then Present (Corresponding_Spec (Parent_P)) 319 then 320 declare 321 Loc : constant Source_Ptr := Sloc (N); 322 D_Fun : constant Entity_Id := Corresponding_Spec (Parent_P); 323 Formal : constant Entity_Id := First_Formal (D_Fun); 324 New_N : Node_Id; 325 Disc : Entity_Id; 326 327 begin 328 -- Verify that we are within a default function: the type of 329 -- its formal parameter is the same task or protected type. 330 331 if Present (Formal) 332 and then Etype (Formal) = Scope (Entity (N)) 333 then 334 Disc := CR_Discriminant (Entity (N)); 335 336 New_N := 337 Make_Selected_Component (Loc, 338 Prefix => New_Occurrence_Of (Formal, Loc), 339 Selector_Name => New_Occurrence_Of (Disc, Loc)); 340 341 Set_Etype (New_N, Etype (N)); 342 Rewrite (N, New_N); 343 344 else 345 Set_Entity (N, Discriminal (Entity (N))); 346 end if; 347 end; 348 349 elsif Nkind (Parent (N)) = N_Range 350 and then In_Entry 351 then 352 Set_Entity (N, CR_Discriminant (Entity (N))); 353 else 354 Set_Entity (N, Discriminal (Entity (N))); 355 end if; 356 357 else 358 Set_Entity (N, Discriminal (Entity (N))); 359 end if; 360 end Expand_Discriminant; 361 362 ----------------------------- 363 -- Expand_Entity_Reference -- 364 ----------------------------- 365 366 procedure Expand_Entity_Reference (N : Node_Id) is 367 E : constant Entity_Id := Entity (N); 368 369 begin 370 -- Defend against errors 371 372 if No (E) and then Total_Errors_Detected /= 0 then 373 return; 374 end if; 375 376 if Ekind (E) = E_Discriminant then 377 Expand_Discriminant (N); 378 379 elsif Is_Entry_Formal (E) then 380 Expand_Entry_Parameter (N); 381 382 elsif Ekind (E) = E_Component 383 and then Is_Protected_Private (E) 384 then 385 -- Protect against junk use of tasking in no run time mode 386 387 if No_Run_Time_Mode then 388 return; 389 end if; 390 391 Expand_Protected_Private (N); 392 393 elsif Ekind (E) = E_Entry_Index_Parameter then 394 Expand_Entry_Index_Parameter (N); 395 396 elsif Is_Formal (E) then 397 Expand_Formal (N); 398 399 elsif Is_Renaming_Of_Object (E) then 400 Expand_Renaming (N); 401 402 elsif Ekind (E) = E_Variable 403 and then Is_Shared_Passive (E) 404 then 405 Expand_Shared_Passive_Variable (N); 406 407 elsif (Ekind (E) = E_Variable 408 or else 409 Ekind (E) = E_In_Out_Parameter 410 or else 411 Ekind (E) = E_Out_Parameter) 412 and then Present (Current_Value (E)) 413 and then Nkind (Current_Value (E)) /= N_Raise_Constraint_Error 414 then 415 Expand_Current_Value (N); 416 417 -- We do want to warn for the case of a boolean variable (not 418 -- a boolean constant) whose value is known at compile time. 419 420 if Is_Boolean_Type (Etype (N)) then 421 Warn_On_Known_Condition (N); 422 end if; 423 end if; 424 end Expand_Entity_Reference; 425 426 ---------------------------------- 427 -- Expand_Entry_Index_Parameter -- 428 ---------------------------------- 429 430 procedure Expand_Entry_Index_Parameter (N : Node_Id) is 431 begin 432 Set_Entity (N, Entry_Index_Constant (Entity (N))); 433 end Expand_Entry_Index_Parameter; 434 435 ---------------------------- 436 -- Expand_Entry_Parameter -- 437 ---------------------------- 438 439 procedure Expand_Entry_Parameter (N : Node_Id) is 440 Loc : constant Source_Ptr := Sloc (N); 441 Ent_Formal : constant Entity_Id := Entity (N); 442 Ent_Spec : constant Entity_Id := Scope (Ent_Formal); 443 Parm_Type : constant Entity_Id := Entry_Parameters_Type (Ent_Spec); 444 Acc_Stack : constant Elist_Id := Accept_Address (Ent_Spec); 445 Addr_Ent : constant Entity_Id := Node (Last_Elmt (Acc_Stack)); 446 P_Comp_Ref : Entity_Id; 447 448 function In_Assignment_Context (N : Node_Id) return Boolean; 449 -- Check whether this is a context in which the entry formal may 450 -- be assigned to. 451 452 --------------------------- 453 -- In_Assignment_Context -- 454 --------------------------- 455 456 function In_Assignment_Context (N : Node_Id) return Boolean is 457 begin 458 if Nkind (Parent (N)) = N_Procedure_Call_Statement 459 or else Nkind (Parent (N)) = N_Entry_Call_Statement 460 or else 461 (Nkind (Parent (N)) = N_Assignment_Statement 462 and then N = Name (Parent (N))) 463 then 464 return True; 465 466 elsif Nkind (Parent (N)) = N_Parameter_Association then 467 return In_Assignment_Context (Parent (N)); 468 469 elsif (Nkind (Parent (N)) = N_Selected_Component 470 or else Nkind (Parent (N)) = N_Indexed_Component) 471 and then In_Assignment_Context (Parent (N)) 472 then 473 return True; 474 else 475 return False; 476 end if; 477 end In_Assignment_Context; 478 479 -- Start of processing for Expand_Entry_Parameter 480 481 begin 482 if Is_Task_Type (Scope (Ent_Spec)) 483 and then Comes_From_Source (Ent_Formal) 484 then 485 -- Before replacing the formal with the local renaming that is 486 -- used in the accept block, note if this is an assignment 487 -- context, and note the modification to avoid spurious warnings, 488 -- because the original entity is not used further. 489 -- If the formal is unconstrained, we also generate an extra 490 -- parameter to hold the Constrained attribute of the actual. No 491 -- renaming is generated for this flag. 492 493 if Ekind (Entity (N)) /= E_In_Parameter 494 and then In_Assignment_Context (N) 495 then 496 Note_Possible_Modification (N); 497 end if; 498 499 Rewrite (N, New_Occurrence_Of (Renamed_Object (Entity (N)), Loc)); 500 return; 501 end if; 502 503 -- What we need is a reference to the corresponding component of the 504 -- parameter record object. The Accept_Address field of the entry 505 -- entity references the address variable that contains the address 506 -- of the accept parameters record. We first have to do an unchecked 507 -- conversion to turn this into a pointer to the parameter record and 508 -- then we select the required parameter field. 509 510 P_Comp_Ref := 511 Make_Selected_Component (Loc, 512 Prefix => 513 Unchecked_Convert_To (Parm_Type, 514 New_Reference_To (Addr_Ent, Loc)), 515 Selector_Name => 516 New_Reference_To (Entry_Component (Ent_Formal), Loc)); 517 518 -- For all types of parameters, the constructed parameter record 519 -- object contains a pointer to the parameter. Thus we must 520 -- dereference them to access them (this will often be redundant, 521 -- since the needed deference is implicit, but no harm is done by 522 -- making it explicit). 523 524 Rewrite (N, 525 Make_Explicit_Dereference (Loc, P_Comp_Ref)); 526 527 Analyze (N); 528 end Expand_Entry_Parameter; 529 530 ------------------- 531 -- Expand_Formal -- 532 ------------------- 533 534 procedure Expand_Formal (N : Node_Id) is 535 E : constant Entity_Id := Entity (N); 536 Subp : constant Entity_Id := Scope (E); 537 538 begin 539 if Is_Protected_Type (Scope (Subp)) 540 and then not Is_Init_Proc (Subp) 541 and then Present (Protected_Formal (E)) 542 then 543 Set_Entity (N, Protected_Formal (E)); 544 end if; 545 end Expand_Formal; 546 547 ---------------------------- 548 -- Expand_N_Expanded_Name -- 549 ---------------------------- 550 551 procedure Expand_N_Expanded_Name (N : Node_Id) is 552 begin 553 Expand_Entity_Reference (N); 554 end Expand_N_Expanded_Name; 555 556 ------------------------- 557 -- Expand_N_Identifier -- 558 ------------------------- 559 560 procedure Expand_N_Identifier (N : Node_Id) is 561 begin 562 Expand_Entity_Reference (N); 563 end Expand_N_Identifier; 564 565 --------------------------- 566 -- Expand_N_Real_Literal -- 567 --------------------------- 568 569 procedure Expand_N_Real_Literal (N : Node_Id) is 570 begin 571 if Vax_Float (Etype (N)) then 572 Expand_Vax_Real_Literal (N); 573 end if; 574 end Expand_N_Real_Literal; 575 576 ------------------------------ 577 -- Expand_Protected_Private -- 578 ------------------------------ 579 580 procedure Expand_Protected_Private (N : Node_Id) is 581 Loc : constant Source_Ptr := Sloc (N); 582 E : constant Entity_Id := Entity (N); 583 Op : constant Node_Id := Protected_Operation (E); 584 Scop : Entity_Id; 585 Lo : Node_Id; 586 Hi : Node_Id; 587 D_Range : Node_Id; 588 589 begin 590 if Nkind (Op) /= N_Subprogram_Body 591 or else Nkind (Specification (Op)) /= N_Function_Specification 592 then 593 Set_Ekind (Prival (E), E_Variable); 594 else 595 Set_Ekind (Prival (E), E_Constant); 596 end if; 597 598 -- If the private component appears in an assignment (either lhs or 599 -- rhs) and is a one-dimensional array constrained by a discriminant, 600 -- rewrite as P (Lo .. Hi) with an explicit range, so that discriminal 601 -- is directly visible. This solves delicate visibility problems. 602 603 if Comes_From_Source (N) 604 and then Is_Array_Type (Etype (E)) 605 and then Number_Dimensions (Etype (E)) = 1 606 and then not Within_Init_Proc 607 then 608 Lo := Type_Low_Bound (Etype (First_Index (Etype (E)))); 609 Hi := Type_High_Bound (Etype (First_Index (Etype (E)))); 610 611 if Nkind (Parent (N)) = N_Assignment_Statement 612 and then ((Is_Entity_Name (Lo) 613 and then Ekind (Entity (Lo)) = E_In_Parameter) 614 or else (Is_Entity_Name (Hi) 615 and then 616 Ekind (Entity (Hi)) = E_In_Parameter)) 617 then 618 D_Range := New_Node (N_Range, Loc); 619 620 if Is_Entity_Name (Lo) 621 and then Ekind (Entity (Lo)) = E_In_Parameter 622 then 623 Set_Low_Bound (D_Range, 624 Make_Identifier (Loc, Chars (Entity (Lo)))); 625 else 626 Set_Low_Bound (D_Range, Duplicate_Subexpr (Lo)); 627 end if; 628 629 if Is_Entity_Name (Hi) 630 and then Ekind (Entity (Hi)) = E_In_Parameter 631 then 632 Set_High_Bound (D_Range, 633 Make_Identifier (Loc, Chars (Entity (Hi)))); 634 else 635 Set_High_Bound (D_Range, Duplicate_Subexpr (Hi)); 636 end if; 637 638 Rewrite (N, 639 Make_Slice (Loc, 640 Prefix => New_Occurrence_Of (E, Loc), 641 Discrete_Range => D_Range)); 642 643 Analyze_And_Resolve (N, Etype (E)); 644 return; 645 end if; 646 end if; 647 648 -- The type of the reference is the type of the prival, which may 649 -- differ from that of the original component if it is an itype. 650 651 Set_Entity (N, Prival (E)); 652 Set_Etype (N, Etype (Prival (E))); 653 Scop := Current_Scope; 654 655 -- Find entity for protected operation, which must be on scope stack. 656 657 while not Is_Protected_Type (Scope (Scop)) loop 658 Scop := Scope (Scop); 659 end loop; 660 661 Append_Elmt (N, Privals_Chain (Scop)); 662 end Expand_Protected_Private; 663 664 --------------------- 665 -- Expand_Renaming -- 666 --------------------- 667 668 procedure Expand_Renaming (N : Node_Id) is 669 E : constant Entity_Id := Entity (N); 670 T : constant Entity_Id := Etype (N); 671 672 begin 673 Rewrite (N, New_Copy_Tree (Renamed_Object (E))); 674 675 -- We mark the copy as unanalyzed, so that it is sure to be 676 -- reanalyzed at the top level. This is needed in the packed 677 -- case since we specifically avoided expanding packed array 678 -- references when the renaming declaration was analyzed. 679 680 Reset_Analyzed_Flags (N); 681 Analyze_And_Resolve (N, T); 682 end Expand_Renaming; 683 684 ------------------ 685 -- Param_Entity -- 686 ------------------ 687 688 -- This would be trivial, simply a test for an identifier that was a 689 -- reference to a formal, if it were not for the fact that a previous 690 -- call to Expand_Entry_Parameter will have modified the reference 691 -- to the identifier. A formal of a protected entity is rewritten as 692 693 -- typ!(recobj).rec.all'Constrained 694 695 -- where rec is a selector whose Entry_Formal link points to the formal 696 -- For a formal of a task entity, the formal is rewritten as a local 697 -- renaming. 698 699 function Param_Entity (N : Node_Id) return Entity_Id is 700 begin 701 -- Simple reference case 702 703 if Nkind (N) = N_Identifier then 704 if Is_Formal (Entity (N)) then 705 return Entity (N); 706 707 elsif Nkind (Parent (Entity (N))) = N_Object_Renaming_Declaration 708 and then Nkind (Parent (Parent (Entity (N)))) = N_Accept_Statement 709 then 710 return Entity (N); 711 end if; 712 713 else 714 if Nkind (N) = N_Explicit_Dereference then 715 declare 716 P : constant Node_Id := Prefix (N); 717 S : Node_Id; 718 719 begin 720 if Nkind (P) = N_Selected_Component then 721 S := Selector_Name (P); 722 723 if Present (Entry_Formal (Entity (S))) then 724 return Entry_Formal (Entity (S)); 725 end if; 726 end if; 727 end; 728 end if; 729 end if; 730 731 return (Empty); 732 end Param_Entity; 733 734end Exp_Ch2; 735