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