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-2008, 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
  26 with Atree;    use Atree;
  27 with Einfo;    use Einfo;
  28 with Elists;   use Elists;
  29 with Errout;   use Errout;
  30 with Exp_Smem; use Exp_Smem;
  31 with Exp_Tss;  use Exp_Tss;
  32 with Exp_Util; use Exp_Util;
  33 with Exp_VFpt; use Exp_VFpt;
  34 with Namet;    use Namet;
  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    --  Dispatches to specific expansion procedures.
  81
  82    procedure Expand_Entry_Index_Parameter (N : Node_Id);
  83    --  A reference to the identifier in the entry index specification of an
  84    --  entry body is modified to a reference to a constant definition equal to
  85    --  the index of the entry family member being called. This constant is
  86    --  calculated as part of the elaboration of the expanded code for the body,
  87    --  and is calculated from the object-wide entry index returned by Next_
  88    --  Entry_Call.
  89
  90    procedure Expand_Entry_Parameter (N : Node_Id);
  91    --  A reference to an entry parameter is modified to be a reference to the
  92    --  corresponding component of the entry parameter record that is passed by
  93    --  the runtime to the accept body procedure.
  94
  95    procedure Expand_Formal (N : Node_Id);
  96    --  A reference to a formal parameter of a protected subprogram is expanded
  97    --  into the corresponding formal of the unprotected procedure used to
  98    --  represent the operation within the protected object. In other cases
  99    --  Expand_Formal is a no-op.
 100
 101    procedure Expand_Protected_Component (N : Node_Id);
 102    --  A reference to a private component of a protected type is expanded into
 103    --  a reference to the corresponding prival in the current protected entry
 104    --  or subprogram.
 105
 106    procedure Expand_Renaming (N : Node_Id);
 107    --  For renamings, just replace the identifier by the corresponding
 108    --  named 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 May_Be_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          --  Do not replace the prefixes of attribute references, since this
 158          --  causes trouble with cases like 4'Size. Also for Name_Asm_Input and
 159          --  Name_Asm_Output, don't do replacement anywhere, since we can have
 160          --  lvalue references in the arguments.
 161
 162          and then not (Nkind (Parent (N)) = N_Attribute_Reference
 163                          and then
 164                            (Attribute_Name (Parent (N)) = Name_Asm_Input
 165                               or else
 166                             Attribute_Name (Parent (N)) = Name_Asm_Output
 167                               or else
 168                             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 a conditional 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 occurence 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          --  Otherwise get the value, and convert to appropriate type
 197
 198          else
 199             Rewrite (N,
 200               Unchecked_Convert_To (T,
 201                 Make_Integer_Literal (Loc,
 202                   Intval => Expr_Rep_Value (Val))));
 203          end if;
 204
 205          Analyze_And_Resolve (N, T);
 206          Set_Is_Static_Expression (N, False);
 207       end if;
 208    end Expand_Current_Value;
 209
 210    -------------------------
 211    -- Expand_Discriminant --
 212    -------------------------
 213
 214    procedure Expand_Discriminant (N : Node_Id) is
 215       Scop     : constant Entity_Id := Scope (Entity (N));
 216       P        : Node_Id := N;
 217       Parent_P : Node_Id := Parent (P);
 218       In_Entry : Boolean := False;
 219
 220    begin
 221       --  The Incomplete_Or_Private_Kind happens while resolving the
 222       --  discriminant constraint involved in a derived full type,
 223       --  such as:
 224
 225       --    type D is private;
 226       --    type D(C : ...) is new T(C);
 227
 228       if Ekind (Scop) = E_Record_Type
 229         or Ekind (Scop) in Incomplete_Or_Private_Kind
 230       then
 231          --  Find the origin by walking up the tree till the component
 232          --  declaration
 233
 234          while Present (Parent_P)
 235            and then Nkind (Parent_P) /= N_Component_Declaration
 236          loop
 237             P := Parent_P;
 238             Parent_P := Parent (P);
 239          end loop;
 240
 241          --  If the discriminant reference was part of the default expression
 242          --  it has to be "discriminalized"
 243
 244          if Present (Parent_P) and then P = Expression (Parent_P) then
 245             Set_Entity (N, Discriminal (Entity (N)));
 246          end if;
 247
 248       elsif Is_Concurrent_Type (Scop) then
 249          while Present (Parent_P)
 250            and then Nkind (Parent_P) /= N_Subprogram_Body
 251          loop
 252             P := Parent_P;
 253
 254             if Nkind (P) = N_Entry_Declaration then
 255                In_Entry := True;
 256             end if;
 257
 258             Parent_P := Parent (Parent_P);
 259          end loop;
 260
 261          --  If the discriminant occurs within the default expression for a
 262          --  formal of an entry or protected operation, create a default
 263          --  function for it, and replace the discriminant with a reference to
 264          --  the discriminant of the formal of the default function. The
 265          --  discriminant entity is the one defined in the corresponding
 266          --  record.
 267
 268          if Present (Parent_P)
 269            and then Present (Corresponding_Spec (Parent_P))
 270          then
 271             declare
 272                Loc    : constant Source_Ptr := Sloc (N);
 273                D_Fun  : constant Entity_Id := Corresponding_Spec  (Parent_P);
 274                Formal : constant Entity_Id := First_Formal (D_Fun);
 275                New_N  : Node_Id;
 276                Disc   : Entity_Id;
 277
 278             begin
 279                --  Verify that we are within a default function: the type of
 280                --  its formal parameter is the same task or protected type.
 281
 282                if Present (Formal)
 283                  and then Etype (Formal) = Scope (Entity (N))
 284                then
 285                   Disc := CR_Discriminant (Entity (N));
 286
 287                   New_N :=
 288                     Make_Selected_Component (Loc,
 289                       Prefix => New_Occurrence_Of (Formal, Loc),
 290                       Selector_Name => New_Occurrence_Of (Disc, Loc));
 291
 292                   Set_Etype (New_N, Etype (N));
 293                   Rewrite (N, New_N);
 294
 295                else
 296                   Set_Entity (N, Discriminal (Entity (N)));
 297                end if;
 298             end;
 299
 300          elsif Nkind (Parent (N)) = N_Range
 301            and then In_Entry
 302          then
 303             Set_Entity (N, CR_Discriminant (Entity (N)));
 304          else
 305             Set_Entity (N, Discriminal (Entity (N)));
 306          end if;
 307
 308       else
 309          Set_Entity (N, Discriminal (Entity (N)));
 310       end if;
 311    end Expand_Discriminant;
 312
 313    -----------------------------
 314    -- Expand_Entity_Reference --
 315    -----------------------------
 316
 317    procedure Expand_Entity_Reference (N : Node_Id) is
 318       E : constant Entity_Id := Entity (N);
 319
 320    begin
 321       --  Defend against errors
 322
 323       if No (E) and then Total_Errors_Detected /= 0 then
 324          return;
 325       end if;
 326
 327       if Ekind (E) = E_Discriminant then
 328          Expand_Discriminant (N);
 329
 330       elsif Is_Entry_Formal (E) then
 331          Expand_Entry_Parameter (N);
 332
 333       elsif Is_Protected_Component (E) then
 334          if No_Run_Time_Mode then
 335             return;
 336          end if;
 337
 338          Expand_Protected_Component (N);
 339
 340       elsif Ekind (E) = E_Entry_Index_Parameter then
 341          Expand_Entry_Index_Parameter (N);
 342
 343       elsif Is_Formal (E) then
 344          Expand_Formal (N);
 345
 346       elsif Is_Renaming_Of_Object (E) then
 347          Expand_Renaming (N);
 348
 349       elsif Ekind (E) = E_Variable
 350         and then Is_Shared_Passive (E)
 351       then
 352          Expand_Shared_Passive_Variable (N);
 353       end if;
 354
 355       --  Interpret possible Current_Value for variable case
 356
 357       if (Ekind (E) = E_Variable
 358             or else
 359           Ekind (E) = E_In_Out_Parameter
 360             or else
 361           Ekind (E) = E_Out_Parameter)
 362         and then Present (Current_Value (E))
 363       then
 364          Expand_Current_Value (N);
 365
 366          --  We do want to warn for the case of a boolean variable (not a
 367          --  boolean constant) whose value is known at compile time.
 368
 369          if Is_Boolean_Type (Etype (N)) then
 370             Warn_On_Known_Condition (N);
 371          end if;
 372
 373       --  Don't mess with Current_Value for compile time known values. Not
 374       --  only is it unnecessary, but we could disturb an indication of a
 375       --  static value, which could cause semantic trouble.
 376
 377       elsif Compile_Time_Known_Value (N) then
 378          null;
 379
 380       --  Interpret possible Current_Value for constant case
 381
 382       elsif Is_Constant_Object (E)
 383         and then Present (Current_Value (E))
 384       then
 385          Expand_Current_Value (N);
 386       end if;
 387    end Expand_Entity_Reference;
 388
 389    ----------------------------------
 390    -- Expand_Entry_Index_Parameter --
 391    ----------------------------------
 392
 393    procedure Expand_Entry_Index_Parameter (N : Node_Id) is
 394       Index_Con : constant Entity_Id := Entry_Index_Constant (Entity (N));
 395    begin
 396       Set_Entity (N, Index_Con);
 397       Set_Etype  (N, Etype (Index_Con));
 398    end Expand_Entry_Index_Parameter;
 399
 400    ----------------------------
 401    -- Expand_Entry_Parameter --
 402    ----------------------------
 403
 404    procedure Expand_Entry_Parameter (N : Node_Id) is
 405       Loc        : constant Source_Ptr := Sloc (N);
 406       Ent_Formal : constant Entity_Id  := Entity (N);
 407       Ent_Spec   : constant Entity_Id  := Scope (Ent_Formal);
 408       Parm_Type  : constant Entity_Id  := Entry_Parameters_Type (Ent_Spec);
 409       Acc_Stack  : constant Elist_Id   := Accept_Address (Ent_Spec);
 410       Addr_Ent   : constant Entity_Id  := Node (Last_Elmt (Acc_Stack));
 411       P_Comp_Ref : Entity_Id;
 412
 413       function In_Assignment_Context (N : Node_Id) return Boolean;
 414       --  Check whether this is a context in which the entry formal may be
 415       --  assigned to.
 416
 417       ---------------------------
 418       -- In_Assignment_Context --
 419       ---------------------------
 420
 421       function In_Assignment_Context (N : Node_Id) return Boolean is
 422       begin
 423          --  Case of use in a call
 424
 425          --  ??? passing a formal as actual for a mode IN formal is
 426          --  considered as an assignment?
 427
 428          if Nkind_In (Parent (N), N_Procedure_Call_Statement,
 429                                   N_Entry_Call_Statement)
 430            or else (Nkind (Parent (N)) = N_Assignment_Statement
 431                       and then N = Name (Parent (N)))
 432          then
 433             return True;
 434
 435          --  Case of a parameter association: climb up to enclosing call
 436
 437          elsif Nkind (Parent (N)) = N_Parameter_Association then
 438             return In_Assignment_Context (Parent (N));
 439
 440          --  Case of a selected component, indexed component or slice prefix:
 441          --  climb up the tree, unless the prefix is of an access type (in
 442          --  which case there is an implicit dereference, and the formal itself
 443          --  is not being assigned to).
 444
 445          elsif Nkind_In (Parent (N), N_Selected_Component,
 446                                      N_Indexed_Component,
 447                                      N_Slice)
 448            and then N = Prefix (Parent (N))
 449            and then not Is_Access_Type (Etype (N))
 450            and then In_Assignment_Context (Parent (N))
 451          then
 452             return True;
 453
 454          else
 455             return False;
 456          end if;
 457       end In_Assignment_Context;
 458
 459    --  Start of processing for Expand_Entry_Parameter
 460
 461    begin
 462       if Is_Task_Type (Scope (Ent_Spec))
 463         and then Comes_From_Source (Ent_Formal)
 464       then
 465          --  Before replacing the formal with the local renaming that is used
 466          --  in the accept block, note if this is an assignment context, and
 467          --  note the modification to avoid spurious warnings, because the
 468          --  original entity is not used further. If formal is unconstrained,
 469          --  we also generate an extra parameter to hold the Constrained
 470          --  attribute of the actual. No renaming is generated for this flag.
 471
 472          --  Calling Node_Posssible_Modifications in the expander is dubious,
 473          --  because this generates a cross-reference entry, and should be
 474          --  done during semantic processing so it is called in -gnatc mode???
 475
 476          if Ekind (Entity (N)) /= E_In_Parameter
 477            and then In_Assignment_Context (N)
 478          then
 479             Note_Possible_Modification (N, Sure => True);
 480          end if;
 481
 482          Rewrite (N, New_Occurrence_Of (Renamed_Object (Entity (N)), Loc));
 483          return;
 484       end if;
 485
 486       --  What we need is a reference to the corresponding component of the
 487       --  parameter record object. The Accept_Address field of the entry entity
 488       --  references the address variable that contains the address of the
 489       --  accept parameters record. We first have to do an unchecked conversion
 490       --  to turn this into a pointer to the parameter record and then we
 491       --  select the required parameter field.
 492
 493       P_Comp_Ref :=
 494         Make_Selected_Component (Loc,
 495           Prefix =>
 496             Make_Explicit_Dereference (Loc,
 497               Unchecked_Convert_To (Parm_Type,
 498                 New_Reference_To (Addr_Ent, Loc))),
 499           Selector_Name =>
 500             New_Reference_To (Entry_Component (Ent_Formal), Loc));
 501
 502       --  For all types of parameters, the constructed parameter record object
 503       --  contains a pointer to the parameter. Thus we must dereference them to
 504       --  access them (this will often be redundant, since the needed deference
 505       --  is implicit, but no harm is done by making it explicit).
 506
 507       Rewrite (N,
 508         Make_Explicit_Dereference (Loc, P_Comp_Ref));
 509
 510       Analyze (N);
 511    end Expand_Entry_Parameter;
 512
 513    -------------------
 514    -- Expand_Formal --
 515    -------------------
 516
 517    procedure Expand_Formal (N : Node_Id) is
 518       E    : constant Entity_Id  := Entity (N);
 519       Scop : constant Entity_Id  := Scope (E);
 520
 521    begin
 522       --  Check whether the subprogram of which this is a formal is
 523       --  a protected operation. The initialization procedure for
 524       --  the corresponding record type is not itself a protected operation.
 525
 526       if Is_Protected_Type (Scope (Scop))
 527         and then not Is_Init_Proc (Scop)
 528         and then Present (Protected_Formal (E))
 529       then
 530          Set_Entity (N, Protected_Formal (E));
 531       end if;
 532    end Expand_Formal;
 533
 534    ----------------------------
 535    -- Expand_N_Expanded_Name --
 536    ----------------------------
 537
 538    procedure Expand_N_Expanded_Name (N : Node_Id) is
 539    begin
 540       Expand_Entity_Reference (N);
 541    end Expand_N_Expanded_Name;
 542
 543    -------------------------
 544    -- Expand_N_Identifier --
 545    -------------------------
 546
 547    procedure Expand_N_Identifier (N : Node_Id) is
 548    begin
 549       Expand_Entity_Reference (N);
 550    end Expand_N_Identifier;
 551
 552    ---------------------------
 553    -- Expand_N_Real_Literal --
 554    ---------------------------
 555
 556    procedure Expand_N_Real_Literal (N : Node_Id) is
 557    begin
 558       if Vax_Float (Etype (N)) then
 559          Expand_Vax_Real_Literal (N);
 560       end if;
 561    end Expand_N_Real_Literal;
 562
 563    --------------------------------
 564    -- Expand_Protected_Component --
 565    --------------------------------
 566
 567    procedure Expand_Protected_Component (N : Node_Id) is
 568
 569       function Inside_Eliminated_Body return Boolean;
 570       --  Determine whether the current entity is inside a subprogram or an
 571       --  entry which has been marked as eliminated.
 572
 573       ----------------------------
 574       -- Inside_Eliminated_Body --
 575       ----------------------------
 576
 577       function Inside_Eliminated_Body return Boolean is
 578          S : Entity_Id := Current_Scope;
 579
 580       begin
 581          while Present (S) loop
 582             if (Ekind (S) = E_Entry
 583                   or else Ekind (S) = E_Entry_Family
 584                   or else Ekind (S) = E_Function
 585                   or else Ekind (S) = E_Procedure)
 586               and then Is_Eliminated (S)
 587             then
 588                return True;
 589             end if;
 590
 591             S := Scope (S);
 592          end loop;
 593
 594          return False;
 595       end Inside_Eliminated_Body;
 596
 597    --  Start of processing for Expand_Protected_Component
 598
 599    begin
 600       --  Eliminated bodies are not expanded and thus do not need privals
 601
 602       if not Inside_Eliminated_Body then
 603          declare
 604             Priv : constant Entity_Id := Prival (Entity (N));
 605          begin
 606             Set_Entity (N, Priv);
 607             Set_Etype  (N, Etype (Priv));
 608          end;
 609       end if;
 610    end Expand_Protected_Component;
 611
 612    ---------------------
 613    -- Expand_Renaming --
 614    ---------------------
 615
 616    procedure Expand_Renaming (N : Node_Id) is
 617       E : constant Entity_Id := Entity (N);
 618       T : constant Entity_Id := Etype (N);
 619
 620    begin
 621       Rewrite (N, New_Copy_Tree (Renamed_Object (E)));
 622
 623       --  We mark the copy as unanalyzed, so that it is sure to be reanalyzed
 624       --  at the top level. This is needed in the packed case since we
 625       --  specifically avoided expanding packed array references when the
 626       --  renaming declaration was analyzed.
 627
 628       Reset_Analyzed_Flags (N);
 629       Analyze_And_Resolve (N, T);
 630    end Expand_Renaming;
 631
 632    ------------------
 633    -- Param_Entity --
 634    ------------------
 635
 636    --  This would be trivial, simply a test for an identifier that was a
 637    --  reference to a formal, if it were not for the fact that a previous call
 638    --  to Expand_Entry_Parameter will have modified the reference to the
 639    --  identifier. A formal of a protected entity is rewritten as
 640
 641    --    typ!(recobj).rec.all'Constrained
 642
 643    --  where rec is a selector whose Entry_Formal link points to the formal
 644    --  For a formal of a task entity, the formal is rewritten as a local
 645    --  renaming.
 646
 647    --  In addition, a formal that is marked volatile because it is aliased
 648    --  through an address clause is rewritten as dereference as well.
 649
 650    function Param_Entity (N : Node_Id) return Entity_Id is
 651       Renamed_Obj : Node_Id;
 652
 653    begin
 654       --  Simple reference case
 655
 656       if Nkind_In (N, N_Identifier, N_Expanded_Name) then
 657          if Is_Formal (Entity (N)) then
 658             return Entity (N);
 659
 660          --  Handle renamings of formal parameters and formals of tasks that
 661          --  are rewritten as renamings.
 662
 663          elsif Nkind (Parent (Entity (N))) = N_Object_Renaming_Declaration then
 664             Renamed_Obj := Get_Referenced_Object (Renamed_Object (Entity (N)));
 665
 666             if Is_Entity_Name (Renamed_Obj)
 667               and then Is_Formal (Entity (Renamed_Obj))
 668             then
 669                return Entity (Renamed_Obj);
 670
 671             elsif
 672               Nkind (Parent (Parent (Entity (N)))) = N_Accept_Statement
 673             then
 674                return Entity (N);
 675             end if;
 676          end if;
 677
 678       else
 679          if Nkind (N) = N_Explicit_Dereference then
 680             declare
 681                P : constant Node_Id := Prefix (N);
 682                S : Node_Id;
 683
 684             begin
 685                if Nkind (P) = N_Selected_Component then
 686                   S := Selector_Name (P);
 687
 688                   if Present (Entry_Formal (Entity (S))) then
 689                      return Entry_Formal (Entity (S));
 690                   end if;
 691
 692                elsif Nkind (Original_Node (N)) = N_Identifier then
 693                   return Param_Entity (Original_Node (N));
 694                end if;
 695             end;
 696          end if;
 697       end if;
 698
 699       return (Empty);
 700    end Param_Entity;
 701
 702 end Exp_Ch2;