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