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