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