summaryrefslogtreecommitdiff
path: root/gcc/ada/exp_ch2.adb
blob: af35113b7b95c8319b15cdd48de73b53b98617e2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              E X P _ C H 2                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Atree;    use Atree;
with Checks;   use Checks;
with Debug;    use Debug;
with Einfo;    use Einfo;
with Elists;   use Elists;
with Exp_Smem; use Exp_Smem;
with Exp_Tss;  use Exp_Tss;
with Exp_Util; use Exp_Util;
with Namet;    use Namet;
with Nmake;    use Nmake;
with Opt;      use Opt;
with Output;   use Output;
with Sem;      use Sem;
with Sem_Eval; use Sem_Eval;
with Sem_Res;  use Sem_Res;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
with Sinfo;    use Sinfo;
with Sinput;   use Sinput;
with Snames;   use Snames;
with Tbuild;   use Tbuild;
with Uintp;    use Uintp;

package body Exp_Ch2 is

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Expand_Current_Value (N : Node_Id);
   --  N is a node for a variable whose Current_Value field is set. If N is
   --  node is for a discrete type, replaces node with a copy of the referenced
   --  value. This provides a limited form of value propagation for variables
   --  which are initialized or assigned not been further modified at the time
   --  of reference. The call has no effect if the Current_Value refers to a
   --  conditional with condition other than equality.

   procedure Expand_Discriminant (N : Node_Id);
   --  An occurrence of a discriminant within a discriminated type is replaced
   --  with the corresponding discriminal, that is to say the formal parameter
   --  of the initialization procedure for the type that is associated with
   --  that particular discriminant. This replacement is not performed for
   --  discriminants of records that appear in constraints of component of the
   --  record, because Gigi uses the discriminant name to retrieve its value.
   --  In the other hand, it has to be performed for default expressions of
   --  components because they are used in the record init procedure. See Einfo
   --  for more details, and Exp_Ch3, Exp_Ch9 for examples of use. For
   --  discriminants of tasks and protected types, the transformation is more
   --  complex when it occurs within a default expression for an entry or
   --  protected operation. The corresponding default_expression_function has
   --  an additional parameter which is the target of an entry call, and the
   --  discriminant of the task must be replaced with a reference to the
   --  discriminant of that formal parameter.

   procedure Expand_Entity_Reference (N : Node_Id);
   --  Common processing for expansion of identifiers and expanded names
   --  Dispatches to specific expansion procedures.

   procedure Expand_Entry_Index_Parameter (N : Node_Id);
   --  A reference to the identifier in the entry index specification of an
   --  entry body is modified to a reference to a constant definition equal to
   --  the index of the entry family member being called. This constant is
   --  calculated as part of the elaboration of the expanded code for the body,
   --  and is calculated from the object-wide entry index returned by Next_
   --  Entry_Call.

   procedure Expand_Entry_Parameter (N : Node_Id);
   --  A reference to an entry parameter is modified to be a reference to the
   --  corresponding component of the entry parameter record that is passed by
   --  the runtime to the accept body procedure.

   procedure Expand_Formal (N : Node_Id);
   --  A reference to a formal parameter of a protected subprogram is expanded
   --  into the corresponding formal of the unprotected procedure used to
   --  represent the operation within the protected object. In other cases
   --  Expand_Formal is a no-op.

   procedure Expand_Protected_Component (N : Node_Id);
   --  A reference to a private component of a protected type is expanded into
   --  a reference to the corresponding prival in the current protected entry
   --  or subprogram.

   procedure Expand_Renaming (N : Node_Id);
   --  For renamings, just replace the identifier by the corresponding
   --  named expression. Note that this has been evaluated (see routine
   --  Exp_Ch8.Expand_N_Object_Renaming.Evaluate_Name) so this gives
   --  the correct renaming semantics.

   --------------------------
   -- Expand_Current_Value --
   --------------------------

   procedure Expand_Current_Value (N : Node_Id) is
      Loc : constant Source_Ptr := Sloc (N);
      E   : constant Entity_Id  := Entity (N);
      CV  : constant Node_Id    := Current_Value (E);
      T   : constant Entity_Id  := Etype (N);
      Val : Node_Id;
      Op  : Node_Kind;

   --  Start of processing for Expand_Current_Value

   begin
      if True

         --  No replacement if value raises constraint error

         and then Nkind (CV) /= N_Raise_Constraint_Error

         --  Do this only for discrete types

         and then Is_Discrete_Type (T)

         --  Do not replace biased types, since it is problematic to
         --  consistently generate a sensible constant value in this case.

         and then not Has_Biased_Representation (T)

         --  Do not replace lvalues

         and then not May_Be_Lvalue (N)

         --  Check that entity is suitable for replacement

         and then OK_To_Do_Constant_Replacement (E)

         --  Do not replace occurrences in pragmas (where names typically
         --  appear not as values, but as simply names. If there are cases
         --  where values are required, it is only a very minor efficiency
         --  issue that they do not get replaced when they could be).

         and then Nkind (Parent (N)) /= N_Pragma_Argument_Association

         --  Do not replace the prefixes of attribute references, since this
         --  causes trouble with cases like 4'Size. Also for Name_Asm_Input and
         --  Name_Asm_Output, don't do replacement anywhere, since we can have
         --  lvalue references in the arguments.

         and then not (Nkind (Parent (N)) = N_Attribute_Reference
                        and then
                          (Nam_In (Attribute_Name (Parent (N)),
                                   Name_Asm_Input,
                                   Name_Asm_Output)
                            or else Prefix (Parent (N)) = N))

      then
         --  Case of Current_Value is a compile time known value

         if Nkind (CV) in N_Subexpr then
            Val := CV;

         --  Case of Current_Value is an if expression reference

         else
            Get_Current_Value_Condition (N, Op, Val);

            if Op /= N_Op_Eq then
               return;
            end if;
         end if;

         --  If constant value is an occurrence of an enumeration literal,
         --  then we just make another occurrence of the same literal.

         if Is_Entity_Name (Val)
           and then Ekind (Entity (Val)) = E_Enumeration_Literal
         then
            Rewrite (N,
              Unchecked_Convert_To (T,
                New_Occurrence_Of (Entity (Val), Loc)));

         --  If constant is of an integer type, just make an appropriately
         --  integer literal, which will get the proper type.

         elsif Is_Integer_Type (T) then
            Rewrite (N,
              Make_Integer_Literal (Loc,
                Intval => Expr_Rep_Value (Val)));

         --  Otherwise do unchecked conversion of value to right type

         else
            Rewrite (N,
              Unchecked_Convert_To (T,
                 Make_Integer_Literal (Loc,
                   Intval => Expr_Rep_Value (Val))));
         end if;

         Analyze_And_Resolve (N, T);
         Set_Is_Static_Expression (N, False);
      end if;
   end Expand_Current_Value;

   -------------------------
   -- Expand_Discriminant --
   -------------------------

   procedure Expand_Discriminant (N : Node_Id) is
      Scop     : constant Entity_Id := Scope (Entity (N));
      P        : Node_Id := N;
      Parent_P : Node_Id := Parent (P);
      In_Entry : Boolean := False;

   begin
      --  The Incomplete_Or_Private_Kind happens while resolving the
      --  discriminant constraint involved in a derived full type,
      --  such as:

      --    type D is private;
      --    type D(C : ...) is new T(C);

      if Ekind (Scop) = E_Record_Type
        or Ekind (Scop) in Incomplete_Or_Private_Kind
      then
         --  Find the origin by walking up the tree till the component
         --  declaration

         while Present (Parent_P)
           and then Nkind (Parent_P) /= N_Component_Declaration
         loop
            P := Parent_P;
            Parent_P := Parent (P);
         end loop;

         --  If the discriminant reference was part of the default expression
         --  it has to be "discriminalized"

         if Present (Parent_P) and then P = Expression (Parent_P) then
            Set_Entity (N, Discriminal (Entity (N)));
         end if;

      elsif Is_Concurrent_Type (Scop) then
         while Present (Parent_P)
           and then Nkind (Parent_P) /= N_Subprogram_Body
         loop
            P := Parent_P;

            if Nkind (P) = N_Entry_Declaration then
               In_Entry := True;
            end if;

            Parent_P := Parent (Parent_P);
         end loop;

         --  If the discriminant occurs within the default expression for a
         --  formal of an entry or protected operation, replace it with a
         --  reference to the discriminant of the formal of the enclosing
         --  operation.

         if Present (Parent_P)
           and then Present (Corresponding_Spec (Parent_P))
         then
            declare
               Loc    : constant Source_Ptr := Sloc (N);
               D_Fun  : constant Entity_Id := Corresponding_Spec  (Parent_P);
               Formal : constant Entity_Id := First_Formal (D_Fun);
               New_N  : Node_Id;
               Disc   : Entity_Id;

            begin
               --  Verify that we are within the body of an entry or protected
               --  operation. Its first formal parameter is the synchronized
               --  type itself.

               if Present (Formal)
                 and then Etype (Formal) = Scope (Entity (N))
               then
                  Disc := CR_Discriminant (Entity (N));

                  New_N :=
                    Make_Selected_Component (Loc,
                      Prefix => New_Occurrence_Of (Formal, Loc),
                      Selector_Name => New_Occurrence_Of (Disc, Loc));

                  Set_Etype (New_N, Etype (N));
                  Rewrite (N, New_N);

               else
                  Set_Entity (N, Discriminal (Entity (N)));
               end if;
            end;

         elsif Nkind (Parent (N)) = N_Range
           and then In_Entry
         then
            Set_Entity (N, CR_Discriminant (Entity (N)));

            --  Finally, if the entity is the discriminant of the original
            --  type declaration, and we are within the initialization
            --  procedure for a task, the designated entity is the
            --  discriminal of the task body. This can happen when the
            --  argument of pragma Task_Name mentions a discriminant,
            --  because the pragma is analyzed in the task declaration
            --  but is expanded in the call to Create_Task in the init_proc.

         elsif Within_Init_Proc then
            Set_Entity (N, Discriminal (CR_Discriminant (Entity (N))));
         else
            Set_Entity (N, Discriminal (Entity (N)));
         end if;

      else
         Set_Entity (N, Discriminal (Entity (N)));
      end if;
   end Expand_Discriminant;

   -----------------------------
   -- Expand_Entity_Reference --
   -----------------------------

   procedure Expand_Entity_Reference (N : Node_Id) is
      E : constant Entity_Id := Entity (N);

   begin
      --  Defend against errors

      if No (E) then
         Check_Error_Detected;
         return;
      end if;

      if Ekind (E) = E_Discriminant then
         Expand_Discriminant (N);

      elsif Is_Entry_Formal (E) then
         Expand_Entry_Parameter (N);

      elsif Is_Protected_Component (E) then
         if No_Run_Time_Mode then
            return;
         else
            Expand_Protected_Component (N);
         end if;

      elsif Ekind (E) = E_Entry_Index_Parameter then
         Expand_Entry_Index_Parameter (N);

      elsif Is_Formal (E) then
         Expand_Formal (N);

      elsif Is_Renaming_Of_Object (E) then
         Expand_Renaming (N);

      elsif Ekind (E) = E_Variable
        and then Is_Shared_Passive (E)
      then
         Expand_Shared_Passive_Variable (N);
      end if;

      --  Test code for implementing the pragma Reviewable requirement of
      --  classifying reads of scalars as referencing potentially uninitialized
      --  objects or not.

      if Debug_Flag_XX
        and then Is_Scalar_Type (Etype (N))
        and then (Is_Assignable (E) or else Is_Constant_Object (E))
        and then Comes_From_Source (N)
        and then not Is_LHS (N)
        and then not Is_Actual_Out_Parameter (N)
        and then (Nkind (Parent (N)) /= N_Attribute_Reference
                   or else Attribute_Name (Parent (N)) /= Name_Valid)
      then
         Write_Location (Sloc (N));
         Write_Str (": Read from scalar """);
         Write_Name (Chars (N));
         Write_Str ("""");

         if Is_Known_Valid (E) then
            Write_Str (", Is_Known_Valid");
         end if;

         Write_Eol;
      end if;

      --  Set Atomic_Sync_Required if necessary for atomic variable

      if Nkind_In (N, N_Identifier, N_Expanded_Name)
        and then Ekind (E) = E_Variable
        and then (Is_Atomic (E) or else Is_Atomic (Etype (E)))
      then
         declare
            Set  : Boolean;

         begin
            --  If variable is atomic, but type is not, setting depends on
            --  disable/enable state for the variable.

            if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then
               Set := not Atomic_Synchronization_Disabled (E);

            --  If variable is not atomic, but its type is atomic, setting
            --  depends on disable/enable state for the type.

            elsif not Is_Atomic (E) and then Is_Atomic (Etype (E)) then
               Set := not Atomic_Synchronization_Disabled (Etype (E));

            --  Else both variable and type are atomic (see outer if), and we
            --  disable if either variable or its type have sync disabled.

            else
               Set := (not Atomic_Synchronization_Disabled (E))
                        and then
                      (not Atomic_Synchronization_Disabled (Etype (E)));
            end if;

            --  Set flag if required

            if Set then
               Activate_Atomic_Synchronization (N);
            end if;
         end;
      end if;

      --  Interpret possible Current_Value for variable case

      if Is_Assignable (E)
        and then Present (Current_Value (E))
      then
         Expand_Current_Value (N);

         --  We do want to warn for the case of a boolean variable (not a
         --  boolean constant) whose value is known at compile time.

         if Is_Boolean_Type (Etype (N)) then
            Warn_On_Known_Condition (N);
         end if;

      --  Don't mess with Current_Value for compile time known values. Not
      --  only is it unnecessary, but we could disturb an indication of a
      --  static value, which could cause semantic trouble.

      elsif Compile_Time_Known_Value (N) then
         null;

      --  Interpret possible Current_Value for constant case

      elsif Is_Constant_Object (E)
        and then Present (Current_Value (E))
      then
         Expand_Current_Value (N);
      end if;
   end Expand_Entity_Reference;

   ----------------------------------
   -- Expand_Entry_Index_Parameter --
   ----------------------------------

   procedure Expand_Entry_Index_Parameter (N : Node_Id) is
      Index_Con : constant Entity_Id := Entry_Index_Constant (Entity (N));
   begin
      Set_Entity (N, Index_Con);
      Set_Etype  (N, Etype (Index_Con));
   end Expand_Entry_Index_Parameter;

   ----------------------------
   -- Expand_Entry_Parameter --
   ----------------------------

   procedure Expand_Entry_Parameter (N : Node_Id) is
      Loc        : constant Source_Ptr := Sloc (N);
      Ent_Formal : constant Entity_Id  := Entity (N);
      Ent_Spec   : constant Entity_Id  := Scope (Ent_Formal);
      Parm_Type  : constant Entity_Id  := Entry_Parameters_Type (Ent_Spec);
      Acc_Stack  : constant Elist_Id   := Accept_Address (Ent_Spec);
      Addr_Ent   : constant Entity_Id  := Node (Last_Elmt (Acc_Stack));
      P_Comp_Ref : Entity_Id;

      function In_Assignment_Context (N : Node_Id) return Boolean;
      --  Check whether this is a context in which the entry formal may be
      --  assigned to.

      ---------------------------
      -- In_Assignment_Context --
      ---------------------------

      function In_Assignment_Context (N : Node_Id) return Boolean is
      begin
         --  Case of use in a call

         --  ??? passing a formal as actual for a mode IN formal is
         --  considered as an assignment?

         if Nkind_In (Parent (N), N_Procedure_Call_Statement,
                                  N_Entry_Call_Statement)
           or else (Nkind (Parent (N)) = N_Assignment_Statement
                      and then N = Name (Parent (N)))
         then
            return True;

         --  Case of a parameter association: climb up to enclosing call

         elsif Nkind (Parent (N)) = N_Parameter_Association then
            return In_Assignment_Context (Parent (N));

         --  Case of a selected component, indexed component or slice prefix:
         --  climb up the tree, unless the prefix is of an access type (in
         --  which case there is an implicit dereference, and the formal itself
         --  is not being assigned to).

         elsif Nkind_In (Parent (N), N_Selected_Component,
                                     N_Indexed_Component,
                                     N_Slice)
           and then N = Prefix (Parent (N))
           and then not Is_Access_Type (Etype (N))
           and then In_Assignment_Context (Parent (N))
         then
            return True;

         else
            return False;
         end if;
      end In_Assignment_Context;

   --  Start of processing for Expand_Entry_Parameter

   begin
      if Is_Task_Type (Scope (Ent_Spec))
        and then Comes_From_Source (Ent_Formal)
      then
         --  Before replacing the formal with the local renaming that is used
         --  in the accept block, note if this is an assignment context, and
         --  note the modification to avoid spurious warnings, because the
         --  original entity is not used further. If formal is unconstrained,
         --  we also generate an extra parameter to hold the Constrained
         --  attribute of the actual. No renaming is generated for this flag.

         --  Calling Note_Possible_Modification in the expander is dubious,
         --  because this generates a cross-reference entry, and should be
         --  done during semantic processing so it is called in -gnatc mode???

         if Ekind (Entity (N)) /= E_In_Parameter
           and then In_Assignment_Context (N)
         then
            Note_Possible_Modification (N, Sure => True);
         end if;
      end if;

      --  What we need is a reference to the corresponding component of the
      --  parameter record object. The Accept_Address field of the entry entity
      --  references the address variable that contains the address of the
      --  accept parameters record. We first have to do an unchecked conversion
      --  to turn this into a pointer to the parameter record and then we
      --  select the required parameter field.

      --  The same processing applies to protected entries, where the Accept_
      --  Address is also the address of the Parameters record.

      P_Comp_Ref :=
        Make_Selected_Component (Loc,
          Prefix =>
            Make_Explicit_Dereference (Loc,
              Unchecked_Convert_To (Parm_Type,
                New_Reference_To (Addr_Ent, Loc))),
          Selector_Name =>
            New_Reference_To (Entry_Component (Ent_Formal), Loc));

      --  For all types of parameters, the constructed parameter record object
      --  contains a pointer to the parameter. Thus we must dereference them to
      --  access them (this will often be redundant, since the dereference is
      --  implicit, but no harm is done by making it explicit).

      Rewrite (N,
        Make_Explicit_Dereference (Loc, P_Comp_Ref));

      Analyze (N);
   end Expand_Entry_Parameter;

   -------------------
   -- Expand_Formal --
   -------------------

   procedure Expand_Formal (N : Node_Id) is
      E    : constant Entity_Id  := Entity (N);
      Scop : constant Entity_Id  := Scope (E);

   begin
      --  Check whether the subprogram of which this is a formal is
      --  a protected operation. The initialization procedure for
      --  the corresponding record type is not itself a protected operation.

      if Is_Protected_Type (Scope (Scop))
        and then not Is_Init_Proc (Scop)
        and then Present (Protected_Formal (E))
      then
         Set_Entity (N, Protected_Formal (E));
      end if;
   end Expand_Formal;

   ----------------------------
   -- Expand_N_Expanded_Name --
   ----------------------------

   procedure Expand_N_Expanded_Name (N : Node_Id) is
   begin
      Expand_Entity_Reference (N);
   end Expand_N_Expanded_Name;

   -------------------------
   -- Expand_N_Identifier --
   -------------------------

   procedure Expand_N_Identifier (N : Node_Id) is
   begin
      Expand_Entity_Reference (N);
   end Expand_N_Identifier;

   ---------------------------
   -- Expand_N_Real_Literal --
   ---------------------------

   procedure Expand_N_Real_Literal (N : Node_Id) is
      pragma Unreferenced (N);

   begin
      --  Historically, this routine existed because there were expansion
      --  requirements for Vax real literals, but now Vax real literals
      --  are now handled by gigi, so this routine no longer does anything.

      null;
   end Expand_N_Real_Literal;

   --------------------------------
   -- Expand_Protected_Component --
   --------------------------------

   procedure Expand_Protected_Component (N : Node_Id) is

      function Inside_Eliminated_Body return Boolean;
      --  Determine whether the current entity is inside a subprogram or an
      --  entry which has been marked as eliminated.

      ----------------------------
      -- Inside_Eliminated_Body --
      ----------------------------

      function Inside_Eliminated_Body return Boolean is
         S : Entity_Id := Current_Scope;

      begin
         while Present (S) loop
            if (Ekind (S) = E_Entry
                  or else Ekind (S) = E_Entry_Family
                  or else Ekind (S) = E_Function
                  or else Ekind (S) = E_Procedure)
              and then Is_Eliminated (S)
            then
               return True;
            end if;

            S := Scope (S);
         end loop;

         return False;
      end Inside_Eliminated_Body;

   --  Start of processing for Expand_Protected_Component

   begin
      --  Eliminated bodies are not expanded and thus do not need privals

      if not Inside_Eliminated_Body then
         declare
            Priv : constant Entity_Id := Prival (Entity (N));
         begin
            Set_Entity (N, Priv);
            Set_Etype  (N, Etype (Priv));
         end;
      end if;
   end Expand_Protected_Component;

   ---------------------
   -- Expand_Renaming --
   ---------------------

   procedure Expand_Renaming (N : Node_Id) is
      E : constant Entity_Id := Entity (N);
      T : constant Entity_Id := Etype (N);

   begin
      Rewrite (N, New_Copy_Tree (Renamed_Object (E)));

      --  We mark the copy as unanalyzed, so that it is sure to be reanalyzed
      --  at the top level. This is needed in the packed case since we
      --  specifically avoided expanding packed array references when the
      --  renaming declaration was analyzed.

      Reset_Analyzed_Flags (N);
      Analyze_And_Resolve (N, T);
   end Expand_Renaming;

   ------------------
   -- Param_Entity --
   ------------------

   --  This would be trivial, simply a test for an identifier that was a
   --  reference to a formal, if it were not for the fact that a previous call
   --  to Expand_Entry_Parameter will have modified the reference to the
   --  identifier. A formal of a protected entity is rewritten as

   --    typ!(recobj).rec.all'Constrained

   --  where rec is a selector whose Entry_Formal link points to the formal

   --  If the type of the entry parameter has a representation clause, then an
   --  extra temp is involved (see below).

   --  For a formal of a task entity, the formal is rewritten as a local
   --  renaming.

   --  In addition, a formal that is marked volatile because it is aliased
   --  through an address clause is rewritten as dereference as well.

   function Param_Entity (N : Node_Id) return Entity_Id is
      Renamed_Obj : Node_Id;

   begin
      --  Simple reference case

      if Nkind_In (N, N_Identifier, N_Expanded_Name) then
         if Is_Formal (Entity (N)) then
            return Entity (N);

         --  Handle renamings of formal parameters and formals of tasks that
         --  are rewritten as renamings.

         elsif Nkind (Parent (Entity (N))) = N_Object_Renaming_Declaration then
            Renamed_Obj := Get_Referenced_Object (Renamed_Object (Entity (N)));

            if Is_Entity_Name (Renamed_Obj)
              and then Is_Formal (Entity (Renamed_Obj))
            then
               return Entity (Renamed_Obj);

            elsif
              Nkind (Parent (Parent (Entity (N)))) = N_Accept_Statement
            then
               return Entity (N);
            end if;
         end if;

      else
         if Nkind (N) = N_Explicit_Dereference then
            declare
               P    : Node_Id := Prefix (N);
               S    : Node_Id;
               E    : Entity_Id;
               Decl : Node_Id;

            begin
               --  If the type of an entry parameter has a representation
               --  clause, then the prefix is not a selected component, but
               --  instead a reference to a temp pointing at the selected
               --  component. In this case, set P to be the initial value of
               --  that temp.

               if Nkind (P) = N_Identifier then
                  E := Entity (P);

                  if Ekind (E) = E_Constant then
                     Decl := Parent (E);

                     if Nkind (Decl) = N_Object_Declaration then
                        P := Expression (Decl);
                     end if;
                  end if;
               end if;

               if Nkind (P) = N_Selected_Component then
                  S := Selector_Name (P);

                  if Present (Entry_Formal (Entity (S))) then
                     return Entry_Formal (Entity (S));
                  end if;

               elsif Nkind (Original_Node (N)) = N_Identifier then
                  return Param_Entity (Original_Node (N));
               end if;
            end;
         end if;
      end if;

      return (Empty);
   end Param_Entity;

end Exp_Ch2;