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