aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/exp_ch2.adb
blob: 291d172a42ea005edd407da8013cda8d3133f8a3 (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
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              E X P _ C H 2                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2006, 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 2,  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 COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- 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 Einfo;    use Einfo;
with Elists;   use Elists;
with Errout;   use Errout;
with Exp_Smem; use Exp_Smem;
with Exp_Tss;  use Exp_Tss;
with Exp_Util; use Exp_Util;
with Exp_VFpt; use Exp_VFpt;
with Nmake;    use Nmake;
with Opt;      use Opt;
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 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
   --  protected 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 noop.

   procedure Expand_Protected_Private (N : Node_Id);
   --  A reference to a private component of a protected type is expanded to a
   --  component selected from the record used to implement the protected
   --  object. Such a record is passed to all operations on a protected object
   --  in a parameter named _object. This object is a constant in the body of a
   --  function, and a variable within a procedure or entry body.

   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

         --  Same for Asm_Input and Asm_Output attribute references

         and then not (Nkind (Parent (N)) = N_Attribute_Reference
                         and then
                           (Attribute_Name (Parent (N)) = Name_Asm_Input
                              or else
                            Attribute_Name (Parent (N)) = Name_Asm_Output))
      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 a conditional 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 occurence 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)));

         --  Otherwise get the value, and convert to appropriate 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, create a default
         --  function for it, and replace the discriminant with a reference to
         --  the discriminant of the formal of the default function. The
         --  discriminant entity is the one defined in the corresponding
         --  record.

         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 a default function: the type of
               --  its formal parameter is the same task or protected type.

               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)));
         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) and then Total_Errors_Detected /= 0 then
         return;
      end if;

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

      elsif Is_Entry_Formal (E) then
         Expand_Entry_Parameter (N);

      elsif Ekind (E) = E_Component
        and then Is_Protected_Private (E)
      then
         --  Protect against junk use of tasking in no run time mode

         if No_Run_Time_Mode then
            return;
         end if;

         Expand_Protected_Private (N);

      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;

      --  Interpret possible Current_Value for variable case

      if (Ekind (E) = E_Variable
            or else
          Ekind (E) = E_In_Out_Parameter
            or else
          Ekind (E) = E_Out_Parameter)
        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 (Ekind (E) = E_Constant
               or else
             Ekind (E) = E_In_Parameter
               or else
             Ekind (E) = E_Loop_Parameter)
        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
   begin
      Set_Entity (N, Entry_Index_Constant (Entity (N)));
   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
         if Nkind (Parent (N)) = N_Procedure_Call_Statement
           or else Nkind (Parent (N)) = N_Entry_Call_Statement
           or else
             (Nkind (Parent (N)) = N_Assignment_Statement
                 and then N = Name (Parent (N)))
         then
            return True;

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

         elsif (Nkind (Parent (N)) = N_Selected_Component
                 or else Nkind (Parent (N)) = N_Indexed_Component
                 or else Nkind (Parent (N)) = N_Slice)
           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.

         if Ekind (Entity (N)) /= E_In_Parameter
           and then In_Assignment_Context (N)
         then
            Note_Possible_Modification (N);
         end if;

         Rewrite (N, New_Occurrence_Of (Renamed_Object (Entity (N)), Loc));
         return;
      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.

      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 needed deference
      --  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
   begin
      if Vax_Float (Etype (N)) then
         Expand_Vax_Real_Literal (N);
      end if;
   end Expand_N_Real_Literal;

   ------------------------------
   -- Expand_Protected_Private --
   ------------------------------

   procedure Expand_Protected_Private (N : Node_Id) is
      Loc      : constant Source_Ptr := Sloc (N);
      E        : constant Entity_Id  := Entity (N);
      Op       : constant Node_Id    := Protected_Operation (E);
      Scop     : Entity_Id;
      Lo       : Node_Id;
      Hi       : Node_Id;
      D_Range  : Node_Id;

   begin
      if Nkind (Op) /= N_Subprogram_Body
        or else Nkind (Specification (Op)) /= N_Function_Specification
      then
         Set_Ekind (Prival (E), E_Variable);
      else
         Set_Ekind (Prival (E), E_Constant);
      end if;

      --  If the private component appears in an assignment (either lhs or
      --  rhs) and is a one-dimensional array constrained by a discriminant,
      --  rewrite as  P (Lo .. Hi) with an explicit range, so that discriminal
      --  is directly visible. This solves delicate visibility problems.

      if Comes_From_Source (N)
        and then Is_Array_Type (Etype (E))
        and then Number_Dimensions (Etype (E)) = 1
        and then not Within_Init_Proc
      then
         Lo := Type_Low_Bound  (Etype (First_Index (Etype (E))));
         Hi := Type_High_Bound (Etype (First_Index (Etype (E))));

         if Nkind (Parent (N)) = N_Assignment_Statement
           and then ((Is_Entity_Name (Lo)
                          and then Ekind (Entity (Lo)) = E_In_Parameter)
                       or else (Is_Entity_Name (Hi)
                                  and then
                                    Ekind (Entity (Hi)) = E_In_Parameter))
         then
            D_Range := New_Node (N_Range, Loc);

            if Is_Entity_Name (Lo)
              and then Ekind (Entity (Lo)) = E_In_Parameter
            then
               Set_Low_Bound (D_Range,
                 Make_Identifier (Loc, Chars (Entity (Lo))));
            else
               Set_Low_Bound (D_Range, Duplicate_Subexpr (Lo));
            end if;

            if Is_Entity_Name (Hi)
              and then Ekind (Entity (Hi)) = E_In_Parameter
            then
               Set_High_Bound (D_Range,
                 Make_Identifier (Loc, Chars (Entity (Hi))));
            else
               Set_High_Bound (D_Range, Duplicate_Subexpr (Hi));
            end if;

            Rewrite (N,
              Make_Slice (Loc,
                Prefix => New_Occurrence_Of (E, Loc),
                Discrete_Range => D_Range));

            Analyze_And_Resolve (N, Etype (E));
            return;
         end if;
      end if;

      --  The type of the reference is the type of the prival, which may differ
      --  from that of the original component if it is an itype.

      Set_Entity (N, Prival (E));
      Set_Etype  (N, Etype (Prival (E)));
      Scop := Current_Scope;

      --  Find entity for protected operation, which must be on scope stack

      while not Is_Protected_Type (Scope (Scop)) loop
         Scop := Scope (Scop);
      end loop;

      Append_Elmt (N, Privals_Chain (Scop));
   end Expand_Protected_Private;

   ---------------------
   -- 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
   --  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
   begin
      --  Simple reference case

      if Nkind (N) = N_Identifier or else Nkind (N) = N_Expanded_Name then
         if Is_Formal (Entity (N)) then
            return Entity (N);

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

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

            begin
               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;