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