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