gcc/ada/exp_ch2.adb

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