OSDN Git Service

9a2372efe1a0838337e9026551d5a8b7d8852305
[pf3gnuchains/gcc-fork.git] / gcc / ada / freeze.adb
1 -----------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                               F R E E Z E                                --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --          Copyright (C) 1992-2008, 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 2,  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 COPYING.  If not, write --
19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
20 -- Boston, MA 02110-1301, USA.                                              --
21 --                                                                          --
22 -- GNAT was originally developed  by the GNAT team at  New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
24 --                                                                          --
25 ------------------------------------------------------------------------------
26
27 with Atree;    use Atree;
28 with Debug;    use Debug;
29 with Einfo;    use Einfo;
30 with Elists;   use Elists;
31 with Errout;   use Errout;
32 with Exp_Ch3;  use Exp_Ch3;
33 with Exp_Ch7;  use Exp_Ch7;
34 with Exp_Disp; use Exp_Disp;
35 with Exp_Pakd; use Exp_Pakd;
36 with Exp_Util; use Exp_Util;
37 with Exp_Tss;  use Exp_Tss;
38 with Layout;   use Layout;
39 with Lib.Xref; use Lib.Xref;
40 with Namet;    use Namet;
41 with Nlists;   use Nlists;
42 with Nmake;    use Nmake;
43 with Opt;      use Opt;
44 with Restrict; use Restrict;
45 with Rident;   use Rident;
46 with Sem;      use Sem;
47 with Sem_Cat;  use Sem_Cat;
48 with Sem_Ch6;  use Sem_Ch6;
49 with Sem_Ch7;  use Sem_Ch7;
50 with Sem_Ch8;  use Sem_Ch8;
51 with Sem_Ch13; use Sem_Ch13;
52 with Sem_Eval; use Sem_Eval;
53 with Sem_Mech; use Sem_Mech;
54 with Sem_Prag; use Sem_Prag;
55 with Sem_Res;  use Sem_Res;
56 with Sem_Util; use Sem_Util;
57 with Sinfo;    use Sinfo;
58 with Snames;   use Snames;
59 with Stand;    use Stand;
60 with Targparm; use Targparm;
61 with Tbuild;   use Tbuild;
62 with Ttypes;   use Ttypes;
63 with Uintp;    use Uintp;
64 with Urealp;   use Urealp;
65
66 package body Freeze is
67
68    -----------------------
69    -- Local Subprograms --
70    -----------------------
71
72    procedure Adjust_Esize_For_Alignment (Typ : Entity_Id);
73    --  Typ is a type that is being frozen. If no size clause is given,
74    --  but a default Esize has been computed, then this default Esize is
75    --  adjusted up if necessary to be consistent with a given alignment,
76    --  but never to a value greater than Long_Long_Integer'Size. This
77    --  is used for all discrete types and for fixed-point types.
78
79    procedure Build_And_Analyze_Renamed_Body
80      (Decl  : Node_Id;
81       New_S : Entity_Id;
82       After : in out Node_Id);
83    --  Build body for a renaming declaration, insert in tree and analyze
84
85    procedure Check_Address_Clause (E : Entity_Id);
86    --  Apply legality checks to address clauses for object declarations,
87    --  at the point the object is frozen.
88
89    procedure Check_Strict_Alignment (E : Entity_Id);
90    --  E is a base type. If E is tagged or has a component that is aliased
91    --  or tagged or contains something this is aliased or tagged, set
92    --  Strict_Alignment.
93
94    procedure Check_Unsigned_Type (E : Entity_Id);
95    pragma Inline (Check_Unsigned_Type);
96    --  If E is a fixed-point or discrete type, then all the necessary work
97    --  to freeze it is completed except for possible setting of the flag
98    --  Is_Unsigned_Type, which is done by this procedure. The call has no
99    --  effect if the entity E is not a discrete or fixed-point type.
100
101    procedure Freeze_And_Append
102      (Ent    : Entity_Id;
103       Loc    : Source_Ptr;
104       Result : in out List_Id);
105    --  Freezes Ent using Freeze_Entity, and appends the resulting list of
106    --  nodes to Result, modifying Result from No_List if necessary.
107
108    procedure Freeze_Enumeration_Type (Typ : Entity_Id);
109    --  Freeze enumeration type. The Esize field is set as processing
110    --  proceeds (i.e. set by default when the type is declared and then
111    --  adjusted by rep clauses. What this procedure does is to make sure
112    --  that if a foreign convention is specified, and no specific size
113    --  is given, then the size must be at least Integer'Size.
114
115    procedure Freeze_Static_Object (E : Entity_Id);
116    --  If an object is frozen which has Is_Statically_Allocated set, then
117    --  all referenced types must also be marked with this flag. This routine
118    --  is in charge of meeting this requirement for the object entity E.
119
120    procedure Freeze_Subprogram (E : Entity_Id);
121    --  Perform freezing actions for a subprogram (create extra formals,
122    --  and set proper default mechanism values). Note that this routine
123    --  is not called for internal subprograms, for which neither of these
124    --  actions is needed (or desirable, we do not want for example to have
125    --  these extra formals present in initialization procedures, where they
126    --  would serve no purpose). In this call E is either a subprogram or
127    --  a subprogram type (i.e. an access to a subprogram).
128
129    function Is_Fully_Defined (T : Entity_Id) return Boolean;
130    --  True if T is not private and has no private components, or has a full
131    --  view. Used to determine whether the designated type of an access type
132    --  should be frozen when the access type is frozen. This is done when an
133    --  allocator is frozen, or an expression that may involve attributes of
134    --  the designated type. Otherwise freezing the access type does not freeze
135    --  the designated type.
136
137    procedure Generate_Prim_Op_References (Typ : Entity_Id);
138    --  For a tagged type, generate implicit references to its primitive
139    --  operations, for source navigation.
140
141    procedure Process_Default_Expressions
142      (E     : Entity_Id;
143       After : in out Node_Id);
144    --  This procedure is called for each subprogram to complete processing
145    --  of default expressions at the point where all types are known to be
146    --  frozen. The expressions must be analyzed in full, to make sure that
147    --  all error processing is done (they have only been pre-analyzed). If
148    --  the expression is not an entity or literal, its analysis may generate
149    --  code which must not be executed. In that case we build a function
150    --  body to hold that code. This wrapper function serves no other purpose
151    --  (it used to be called to evaluate the default, but now the default is
152    --  inlined at each point of call).
153
154    procedure Set_Component_Alignment_If_Not_Set (Typ : Entity_Id);
155    --  Typ is a record or array type that is being frozen. This routine
156    --  sets the default component alignment from the scope stack values
157    --  if the alignment is otherwise not specified.
158
159    procedure Check_Debug_Info_Needed (T : Entity_Id);
160    --  As each entity is frozen, this routine is called to deal with the
161    --  setting of Debug_Info_Needed for the entity. This flag is set if
162    --  the entity comes from source, or if we are in Debug_Generated_Code
163    --  mode or if the -gnatdV debug flag is set. However, it never sets
164    --  the flag if Debug_Info_Off is set. This procedure also ensures that
165    --  subsidiary entities have the flag set as required.
166
167    procedure Undelay_Type (T : Entity_Id);
168    --  T is a type of a component that we know to be an Itype.
169    --  We don't want this to have a Freeze_Node, so ensure it doesn't.
170    --  Do the same for any Full_View or Corresponding_Record_Type.
171
172    procedure Warn_Overlay
173      (Expr : Node_Id;
174       Typ  : Entity_Id;
175       Nam  : Node_Id);
176    --  Expr is the expression for an address clause for entity Nam whose type
177    --  is Typ. If Typ has a default initialization, and there is no explicit
178    --  initialization in the source declaration, check whether the address
179    --  clause might cause overlaying of an entity, and emit a warning on the
180    --  side effect that the initialization will cause.
181
182    -------------------------------
183    -- Adjust_Esize_For_Alignment --
184    -------------------------------
185
186    procedure Adjust_Esize_For_Alignment (Typ : Entity_Id) is
187       Align : Uint;
188
189    begin
190       if Known_Esize (Typ) and then Known_Alignment (Typ) then
191          Align := Alignment_In_Bits (Typ);
192
193          if Align > Esize (Typ)
194            and then Align <= Standard_Long_Long_Integer_Size
195          then
196             Set_Esize (Typ, Align);
197          end if;
198       end if;
199    end Adjust_Esize_For_Alignment;
200
201    ------------------------------------
202    -- Build_And_Analyze_Renamed_Body --
203    ------------------------------------
204
205    procedure Build_And_Analyze_Renamed_Body
206      (Decl  : Node_Id;
207       New_S : Entity_Id;
208       After : in out Node_Id)
209    is
210       Body_Node : constant Node_Id := Build_Renamed_Body (Decl, New_S);
211    begin
212       Insert_After (After, Body_Node);
213       Mark_Rewrite_Insertion (Body_Node);
214       Analyze (Body_Node);
215       After := Body_Node;
216    end Build_And_Analyze_Renamed_Body;
217
218    ------------------------
219    -- Build_Renamed_Body --
220    ------------------------
221
222    function Build_Renamed_Body
223      (Decl  : Node_Id;
224       New_S : Entity_Id) return Node_Id
225    is
226       Loc : constant Source_Ptr := Sloc (New_S);
227       --  We use for the source location of the renamed body, the location
228       --  of the spec entity. It might seem more natural to use the location
229       --  of the renaming declaration itself, but that would be wrong, since
230       --  then the body we create would look as though it was created far
231       --  too late, and this could cause problems with elaboration order
232       --  analysis, particularly in connection with instantiations.
233
234       N          : constant Node_Id := Unit_Declaration_Node (New_S);
235       Nam        : constant Node_Id := Name (N);
236       Old_S      : Entity_Id;
237       Spec       : constant Node_Id := New_Copy_Tree (Specification (Decl));
238       Actuals    : List_Id := No_List;
239       Call_Node  : Node_Id;
240       Call_Name  : Node_Id;
241       Body_Node  : Node_Id;
242       Formal     : Entity_Id;
243       O_Formal   : Entity_Id;
244       Param_Spec : Node_Id;
245
246       Pref : Node_Id := Empty;
247       --  If the renamed entity is a primitive operation given in prefix form,
248       --  the prefix is the target object and it has to be added as the first
249       --  actual in the generated call.
250
251    begin
252       --  Determine the entity being renamed, which is the target of the call
253       --  statement. If the name is an explicit dereference, this is a renaming
254       --  of a subprogram type rather than a subprogram. The name itself is
255       --  fully analyzed.
256
257       if Nkind (Nam) = N_Selected_Component then
258          Old_S := Entity (Selector_Name (Nam));
259
260       elsif Nkind (Nam) = N_Explicit_Dereference then
261          Old_S := Etype (Nam);
262
263       elsif Nkind (Nam) = N_Indexed_Component then
264          if Is_Entity_Name (Prefix (Nam)) then
265             Old_S := Entity (Prefix (Nam));
266          else
267             Old_S := Entity (Selector_Name (Prefix (Nam)));
268          end if;
269
270       elsif Nkind (Nam) = N_Character_Literal then
271          Old_S := Etype (New_S);
272
273       else
274          Old_S := Entity (Nam);
275       end if;
276
277       if Is_Entity_Name (Nam) then
278
279          --  If the renamed entity is a predefined operator, retain full name
280          --  to ensure its visibility.
281
282          if Ekind (Old_S) = E_Operator
283            and then Nkind (Nam) = N_Expanded_Name
284          then
285             Call_Name := New_Copy (Name (N));
286          else
287             Call_Name := New_Reference_To (Old_S, Loc);
288          end if;
289
290       else
291          if Nkind (Nam) = N_Selected_Component
292            and then Present (First_Formal (Old_S))
293            and then
294              (Is_Controlling_Formal (First_Formal (Old_S))
295                 or else Is_Class_Wide_Type (Etype (First_Formal (Old_S))))
296          then
297
298             --  Retrieve the target object, to be added as a first actual
299             --  in the call.
300
301             Call_Name := New_Occurrence_Of (Old_S, Loc);
302             Pref := Prefix (Nam);
303
304          else
305             Call_Name := New_Copy (Name (N));
306          end if;
307
308          --  The original name may have been overloaded, but
309          --  is fully resolved now.
310
311          Set_Is_Overloaded (Call_Name, False);
312       end if;
313
314       --  For simple renamings, subsequent calls can be expanded directly as
315       --  called to the renamed entity. The body must be generated in any case
316       --  for calls they may appear elsewhere.
317
318       if (Ekind (Old_S) = E_Function
319            or else Ekind (Old_S) = E_Procedure)
320         and then Nkind (Decl) = N_Subprogram_Declaration
321       then
322          Set_Body_To_Inline (Decl, Old_S);
323       end if;
324
325       --  The body generated for this renaming is an internal artifact, and
326       --  does not  constitute a freeze point for the called entity.
327
328       Set_Must_Not_Freeze (Call_Name);
329
330       Formal := First_Formal (Defining_Entity (Decl));
331
332       if Present (Pref) then
333          declare
334             Pref_Type : constant Entity_Id := Etype (Pref);
335             Form_Type : constant Entity_Id := Etype (First_Formal (Old_S));
336
337          begin
338
339             --  The controlling formal may be an access parameter, or the
340             --  actual may be an access value, so adjust accordingly.
341
342             if Is_Access_Type (Pref_Type)
343               and then not Is_Access_Type (Form_Type)
344             then
345                Actuals := New_List
346                  (Make_Explicit_Dereference (Loc, Relocate_Node (Pref)));
347
348             elsif Is_Access_Type (Form_Type)
349               and then not Is_Access_Type (Pref)
350             then
351                Actuals := New_List
352                  (Make_Attribute_Reference (Loc,
353                    Attribute_Name => Name_Access,
354                    Prefix => Relocate_Node (Pref)));
355             else
356                Actuals := New_List (Pref);
357             end if;
358          end;
359
360       elsif Present (Formal) then
361          Actuals := New_List;
362
363       else
364          Actuals := No_List;
365       end if;
366
367       if Present (Formal) then
368          while Present (Formal) loop
369             Append (New_Reference_To (Formal, Loc), Actuals);
370             Next_Formal (Formal);
371          end loop;
372       end if;
373
374       --  If the renamed entity is an entry, inherit its profile. For other
375       --  renamings as bodies, both profiles must be subtype conformant, so it
376       --  is not necessary to replace the profile given in the declaration.
377       --  However, default values that are aggregates are rewritten when
378       --  partially analyzed, so we recover the original aggregate to insure
379       --  that subsequent conformity checking works. Similarly, if the default
380       --  expression was constant-folded, recover the original expression.
381
382       Formal := First_Formal (Defining_Entity (Decl));
383
384       if Present (Formal) then
385          O_Formal := First_Formal (Old_S);
386          Param_Spec := First (Parameter_Specifications (Spec));
387
388          while Present (Formal) loop
389             if Is_Entry (Old_S) then
390
391                if Nkind (Parameter_Type (Param_Spec)) /=
392                                                     N_Access_Definition
393                then
394                   Set_Etype (Formal, Etype (O_Formal));
395                   Set_Entity (Parameter_Type (Param_Spec), Etype (O_Formal));
396                end if;
397
398             elsif Nkind (Default_Value (O_Formal)) = N_Aggregate
399               or else Nkind (Original_Node (Default_Value (O_Formal))) /=
400                                            Nkind (Default_Value (O_Formal))
401             then
402                Set_Expression (Param_Spec,
403                  New_Copy_Tree (Original_Node (Default_Value (O_Formal))));
404             end if;
405
406             Next_Formal (Formal);
407             Next_Formal (O_Formal);
408             Next (Param_Spec);
409          end loop;
410       end if;
411
412       --  If the renamed entity is a function, the generated body contains a
413       --  return statement. Otherwise, build a procedure call. If the entity is
414       --  an entry, subsequent analysis of the call will transform it into the
415       --  proper entry or protected operation call. If the renamed entity is
416       --  a character literal, return it directly.
417
418       if Ekind (Old_S) = E_Function
419         or else Ekind (Old_S) = E_Operator
420         or else (Ekind (Old_S) = E_Subprogram_Type
421                   and then Etype (Old_S) /= Standard_Void_Type)
422       then
423          Call_Node :=
424            Make_Simple_Return_Statement (Loc,
425               Expression =>
426                 Make_Function_Call (Loc,
427                   Name => Call_Name,
428                   Parameter_Associations => Actuals));
429
430       elsif Ekind (Old_S) = E_Enumeration_Literal then
431          Call_Node :=
432            Make_Simple_Return_Statement (Loc,
433               Expression => New_Occurrence_Of (Old_S, Loc));
434
435       elsif Nkind (Nam) = N_Character_Literal then
436          Call_Node :=
437            Make_Simple_Return_Statement (Loc,
438              Expression => Call_Name);
439
440       else
441          Call_Node :=
442            Make_Procedure_Call_Statement (Loc,
443              Name => Call_Name,
444              Parameter_Associations => Actuals);
445       end if;
446
447       --  Create entities for subprogram body and formals
448
449       Set_Defining_Unit_Name (Spec,
450         Make_Defining_Identifier (Loc, Chars => Chars (New_S)));
451
452       Param_Spec := First (Parameter_Specifications (Spec));
453
454       while Present (Param_Spec) loop
455          Set_Defining_Identifier (Param_Spec,
456            Make_Defining_Identifier (Loc,
457              Chars => Chars (Defining_Identifier (Param_Spec))));
458          Next (Param_Spec);
459       end loop;
460
461       Body_Node :=
462         Make_Subprogram_Body (Loc,
463           Specification => Spec,
464           Declarations => New_List,
465           Handled_Statement_Sequence =>
466             Make_Handled_Sequence_Of_Statements (Loc,
467               Statements => New_List (Call_Node)));
468
469       if Nkind (Decl) /= N_Subprogram_Declaration then
470          Rewrite (N,
471            Make_Subprogram_Declaration (Loc,
472              Specification => Specification (N)));
473       end if;
474
475       --  Link the body to the entity whose declaration it completes. If
476       --  the body is analyzed when the renamed entity is frozen, it may
477       --  be necessary to restore the proper scope (see package Exp_Ch13).
478
479       if Nkind (N) =  N_Subprogram_Renaming_Declaration
480         and then Present (Corresponding_Spec (N))
481       then
482          Set_Corresponding_Spec (Body_Node, Corresponding_Spec (N));
483       else
484          Set_Corresponding_Spec (Body_Node, New_S);
485       end if;
486
487       return Body_Node;
488    end Build_Renamed_Body;
489
490    --------------------------
491    -- Check_Address_Clause --
492    --------------------------
493
494    procedure Check_Address_Clause (E : Entity_Id) is
495       Addr : constant Node_Id   := Address_Clause (E);
496       Expr : Node_Id;
497       Decl : constant Node_Id   := Declaration_Node (E);
498       Typ  : constant Entity_Id := Etype (E);
499
500    begin
501       if Present (Addr) then
502          Expr := Expression (Addr);
503
504          --  If we have no initialization of any kind, then we don't need to
505          --  place any restrictions on the address clause, because the object
506          --  will be elaborated after the address clause is evaluated. This
507          --  happens if the declaration has no initial expression, or the type
508          --  has no implicit initialization, or the object is imported.
509
510          --  The same holds for all initialized scalar types and all access
511          --  types. Packed bit arrays of size up to 64 are represented using a
512          --  modular type with an initialization (to zero) and can be processed
513          --  like other initialized scalar types.
514
515          --  If the type is controlled, code to attach the object to a
516          --  finalization chain is generated at the point of declaration,
517          --  and therefore the elaboration of the object cannot be delayed:
518          --  the address expression must be a constant.
519
520          if (No (Expression (Decl))
521               and then not Needs_Finalization (Typ)
522               and then
523                 (not Has_Non_Null_Base_Init_Proc (Typ)
524                   or else Is_Imported (E)))
525
526            or else
527              (Present (Expression (Decl))
528                and then Is_Scalar_Type (Typ))
529
530            or else
531              Is_Access_Type (Typ)
532
533            or else
534              (Is_Bit_Packed_Array (Typ)
535                and then
536                  Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
537          then
538             null;
539
540          --  Otherwise, we require the address clause to be constant because
541          --  the call to the initialization procedure (or the attach code) has
542          --  to happen at the point of the declaration.
543
544          else
545             Check_Constant_Address_Clause (Expr, E);
546             Set_Has_Delayed_Freeze (E, False);
547          end if;
548
549          if not Error_Posted (Expr)
550            and then not Needs_Finalization (Typ)
551          then
552             Warn_Overlay (Expr, Typ, Name (Addr));
553          end if;
554       end if;
555    end Check_Address_Clause;
556
557    -----------------------------
558    -- Check_Compile_Time_Size --
559    -----------------------------
560
561    procedure Check_Compile_Time_Size (T : Entity_Id) is
562
563       procedure Set_Small_Size (T : Entity_Id; S : Uint);
564       --  Sets the compile time known size (32 bits or less) in the Esize
565       --  field, of T checking for a size clause that was given which attempts
566       --  to give a smaller size.
567
568       function Size_Known (T : Entity_Id) return Boolean;
569       --  Recursive function that does all the work
570
571       function Static_Discriminated_Components (T : Entity_Id) return Boolean;
572       --  If T is a constrained subtype, its size is not known if any of its
573       --  discriminant constraints is not static and it is not a null record.
574       --  The test is conservative and doesn't check that the components are
575       --  in fact constrained by non-static discriminant values. Could be made
576       --  more precise ???
577
578       --------------------
579       -- Set_Small_Size --
580       --------------------
581
582       procedure Set_Small_Size (T : Entity_Id; S : Uint) is
583       begin
584          if S > 32 then
585             return;
586
587          elsif Has_Size_Clause (T) then
588             if RM_Size (T) < S then
589                Error_Msg_Uint_1 := S;
590                Error_Msg_NE
591                  ("size for & too small, minimum allowed is ^",
592                   Size_Clause (T), T);
593
594             elsif Unknown_Esize (T) then
595                Set_Esize (T, S);
596             end if;
597
598          --  Set sizes if not set already
599
600          else
601             if Unknown_Esize (T) then
602                Set_Esize (T, S);
603             end if;
604
605             if Unknown_RM_Size (T) then
606                Set_RM_Size (T, S);
607             end if;
608          end if;
609       end Set_Small_Size;
610
611       ----------------
612       -- Size_Known --
613       ----------------
614
615       function Size_Known (T : Entity_Id) return Boolean is
616          Index : Entity_Id;
617          Comp  : Entity_Id;
618          Ctyp  : Entity_Id;
619          Low   : Node_Id;
620          High  : Node_Id;
621
622       begin
623          if Size_Known_At_Compile_Time (T) then
624             return True;
625
626          --  Always True for scalar types. This is true even for generic formal
627          --  scalar types. We used to return False in the latter case, but the
628          --  size is known at compile time, even in the template, we just do
629          --  not know the exact size but that's not the point of this routine.
630
631          elsif Is_Scalar_Type (T)
632            or else Is_Task_Type (T)
633          then
634             return True;
635
636          --  Array types
637
638          elsif Is_Array_Type (T) then
639
640             --  String literals always have known size, and we can set it
641
642             if Ekind (T) = E_String_Literal_Subtype then
643                Set_Small_Size (T, Component_Size (T)
644                                * String_Literal_Length (T));
645                return True;
646
647             --  Unconstrained types never have known at compile time size
648
649             elsif not Is_Constrained (T) then
650                return False;
651
652             --  Don't do any recursion on type with error posted, since we may
653             --  have a malformed type that leads us into a loop.
654
655             elsif Error_Posted (T) then
656                return False;
657
658             --  Otherwise if component size unknown, then array size unknown
659
660             elsif not Size_Known (Component_Type (T)) then
661                return False;
662             end if;
663
664             --  Check for all indexes static, and also compute possible size
665             --  (in case it is less than 32 and may be packable).
666
667             declare
668                Esiz : Uint := Component_Size (T);
669                Dim  : Uint;
670
671             begin
672                Index := First_Index (T);
673                while Present (Index) loop
674                   if Nkind (Index) = N_Range then
675                      Get_Index_Bounds (Index, Low, High);
676
677                   elsif Error_Posted (Scalar_Range (Etype (Index))) then
678                      return False;
679
680                   else
681                      Low  := Type_Low_Bound (Etype (Index));
682                      High := Type_High_Bound (Etype (Index));
683                   end if;
684
685                   if not Compile_Time_Known_Value (Low)
686                     or else not Compile_Time_Known_Value (High)
687                     or else Etype (Index) = Any_Type
688                   then
689                      return False;
690
691                   else
692                      Dim := Expr_Value (High) - Expr_Value (Low) + 1;
693
694                      if Dim >= 0 then
695                         Esiz := Esiz * Dim;
696                      else
697                         Esiz := Uint_0;
698                      end if;
699                   end if;
700
701                   Next_Index (Index);
702                end loop;
703
704                Set_Small_Size (T, Esiz);
705                return True;
706             end;
707
708          --  Access types always have known at compile time sizes
709
710          elsif Is_Access_Type (T) then
711             return True;
712
713          --  For non-generic private types, go to underlying type if present
714
715          elsif Is_Private_Type (T)
716            and then not Is_Generic_Type (T)
717            and then Present (Underlying_Type (T))
718          then
719             --  Don't do any recursion on type with error posted, since we may
720             --  have a malformed type that leads us into a loop.
721
722             if Error_Posted (T) then
723                return False;
724             else
725                return Size_Known (Underlying_Type (T));
726             end if;
727
728          --  Record types
729
730          elsif Is_Record_Type (T) then
731
732             --  A class-wide type is never considered to have a known size
733
734             if Is_Class_Wide_Type (T) then
735                return False;
736
737             --  A subtype of a variant record must not have non-static
738             --  discriminanted components.
739
740             elsif T /= Base_Type (T)
741               and then not Static_Discriminated_Components (T)
742             then
743                return False;
744
745             --  Don't do any recursion on type with error posted, since we may
746             --  have a malformed type that leads us into a loop.
747
748             elsif Error_Posted (T) then
749                return False;
750             end if;
751
752             --  Now look at the components of the record
753
754             declare
755                --  The following two variables are used to keep track of the
756                --  size of packed records if we can tell the size of the packed
757                --  record in the front end. Packed_Size_Known is True if so far
758                --  we can figure out the size. It is initialized to True for a
759                --  packed record, unless the record has discriminants. The
760                --  reason we eliminate the discriminated case is that we don't
761                --  know the way the back end lays out discriminated packed
762                --  records. If Packed_Size_Known is True, then Packed_Size is
763                --  the size in bits so far.
764
765                Packed_Size_Known : Boolean :=
766                                      Is_Packed (T)
767                                        and then not Has_Discriminants (T);
768
769                Packed_Size : Uint := Uint_0;
770
771             begin
772                --  Test for variant part present
773
774                if Has_Discriminants (T)
775                  and then Present (Parent (T))
776                  and then Nkind (Parent (T)) = N_Full_Type_Declaration
777                  and then Nkind (Type_Definition (Parent (T))) =
778                             N_Record_Definition
779                  and then not Null_Present (Type_Definition (Parent (T)))
780                  and then Present (Variant_Part
781                             (Component_List (Type_Definition (Parent (T)))))
782                then
783                   --  If variant part is present, and type is unconstrained,
784                   --  then we must have defaulted discriminants, or a size
785                   --  clause must be present for the type, or else the size
786                   --  is definitely not known at compile time.
787
788                   if not Is_Constrained (T)
789                     and then
790                       No (Discriminant_Default_Value
791                            (First_Discriminant (T)))
792                     and then Unknown_Esize (T)
793                   then
794                      return False;
795                   end if;
796                end if;
797
798                --  Loop through components
799
800                Comp := First_Component_Or_Discriminant (T);
801                while Present (Comp) loop
802                   Ctyp := Etype (Comp);
803
804                   --  We do not know the packed size if there is a component
805                   --  clause present (we possibly could, but this would only
806                   --  help in the case of a record with partial rep clauses.
807                   --  That's because in the case of full rep clauses, the
808                   --  size gets figured out anyway by a different circuit).
809
810                   if Present (Component_Clause (Comp)) then
811                      Packed_Size_Known := False;
812                   end if;
813
814                   --  We need to identify a component that is an array where
815                   --  the index type is an enumeration type with non-standard
816                   --  representation, and some bound of the type depends on a
817                   --  discriminant.
818
819                   --  This is because gigi computes the size by doing a
820                   --  substitution of the appropriate discriminant value in
821                   --  the size expression for the base type, and gigi is not
822                   --  clever enough to evaluate the resulting expression (which
823                   --  involves a call to rep_to_pos) at compile time.
824
825                   --  It would be nice if gigi would either recognize that
826                   --  this expression can be computed at compile time, or
827                   --  alternatively figured out the size from the subtype
828                   --  directly, where all the information is at hand ???
829
830                   if Is_Array_Type (Etype (Comp))
831                     and then Present (Packed_Array_Type (Etype (Comp)))
832                   then
833                      declare
834                         Ocomp  : constant Entity_Id :=
835                                    Original_Record_Component (Comp);
836                         OCtyp  : constant Entity_Id := Etype (Ocomp);
837                         Ind    : Node_Id;
838                         Indtyp : Entity_Id;
839                         Lo, Hi : Node_Id;
840
841                      begin
842                         Ind := First_Index (OCtyp);
843                         while Present (Ind) loop
844                            Indtyp := Etype (Ind);
845
846                            if Is_Enumeration_Type (Indtyp)
847                              and then Has_Non_Standard_Rep (Indtyp)
848                            then
849                               Lo := Type_Low_Bound  (Indtyp);
850                               Hi := Type_High_Bound (Indtyp);
851
852                               if Is_Entity_Name (Lo)
853                                 and then Ekind (Entity (Lo)) = E_Discriminant
854                               then
855                                  return False;
856
857                               elsif Is_Entity_Name (Hi)
858                                 and then Ekind (Entity (Hi)) = E_Discriminant
859                               then
860                                  return False;
861                               end if;
862                            end if;
863
864                            Next_Index (Ind);
865                         end loop;
866                      end;
867                   end if;
868
869                   --  Clearly size of record is not known if the size of one of
870                   --  the components is not known.
871
872                   if not Size_Known (Ctyp) then
873                      return False;
874                   end if;
875
876                   --  Accumulate packed size if possible
877
878                   if Packed_Size_Known then
879
880                      --  We can only deal with elementary types, since for
881                      --  non-elementary components, alignment enters into the
882                      --  picture, and we don't know enough to handle proper
883                      --  alignment in this context. Packed arrays count as
884                      --  elementary if the representation is a modular type.
885
886                      if Is_Elementary_Type (Ctyp)
887                        or else (Is_Array_Type (Ctyp)
888                                 and then Present (Packed_Array_Type (Ctyp))
889                                 and then Is_Modular_Integer_Type
890                                            (Packed_Array_Type (Ctyp)))
891                      then
892                         --  If RM_Size is known and static, then we can
893                         --  keep accumulating the packed size.
894
895                         if Known_Static_RM_Size (Ctyp) then
896
897                            --  A little glitch, to be removed sometime ???
898                            --  gigi does not understand zero sizes yet.
899
900                            if RM_Size (Ctyp) = Uint_0 then
901                               Packed_Size_Known := False;
902
903                            --  Normal case where we can keep accumulating the
904                            --  packed array size.
905
906                            else
907                               Packed_Size := Packed_Size + RM_Size (Ctyp);
908                            end if;
909
910                         --  If we have a field whose RM_Size is not known then
911                         --  we can't figure out the packed size here.
912
913                         else
914                            Packed_Size_Known := False;
915                         end if;
916
917                      --  If we have a non-elementary type we can't figure out
918                      --  the packed array size (alignment issues).
919
920                      else
921                         Packed_Size_Known := False;
922                      end if;
923                   end if;
924
925                   Next_Component_Or_Discriminant (Comp);
926                end loop;
927
928                if Packed_Size_Known then
929                   Set_Small_Size (T, Packed_Size);
930                end if;
931
932                return True;
933             end;
934
935          --  All other cases, size not known at compile time
936
937          else
938             return False;
939          end if;
940       end Size_Known;
941
942       -------------------------------------
943       -- Static_Discriminated_Components --
944       -------------------------------------
945
946       function Static_Discriminated_Components
947         (T : Entity_Id) return Boolean
948       is
949          Constraint : Elmt_Id;
950
951       begin
952          if Has_Discriminants (T)
953            and then Present (Discriminant_Constraint (T))
954            and then Present (First_Component (T))
955          then
956             Constraint := First_Elmt (Discriminant_Constraint (T));
957             while Present (Constraint) loop
958                if not Compile_Time_Known_Value (Node (Constraint)) then
959                   return False;
960                end if;
961
962                Next_Elmt (Constraint);
963             end loop;
964          end if;
965
966          return True;
967       end Static_Discriminated_Components;
968
969    --  Start of processing for Check_Compile_Time_Size
970
971    begin
972       Set_Size_Known_At_Compile_Time (T, Size_Known (T));
973    end Check_Compile_Time_Size;
974
975    -----------------------------
976    -- Check_Debug_Info_Needed --
977    -----------------------------
978
979    procedure Check_Debug_Info_Needed (T : Entity_Id) is
980    begin
981       if Debug_Info_Off (T) then
982          return;
983
984       elsif Comes_From_Source (T)
985         or else Debug_Generated_Code
986         or else Debug_Flag_VV
987         or else Needs_Debug_Info (T)
988       then
989          Set_Debug_Info_Needed (T);
990       end if;
991    end Check_Debug_Info_Needed;
992
993    ----------------------------
994    -- Check_Strict_Alignment --
995    ----------------------------
996
997    procedure Check_Strict_Alignment (E : Entity_Id) is
998       Comp  : Entity_Id;
999
1000    begin
1001       if Is_Tagged_Type (E) or else Is_Concurrent_Type (E) then
1002          Set_Strict_Alignment (E);
1003
1004       elsif Is_Array_Type (E) then
1005          Set_Strict_Alignment (E, Strict_Alignment (Component_Type (E)));
1006
1007       elsif Is_Record_Type (E) then
1008          if Is_Limited_Record (E) then
1009             Set_Strict_Alignment (E);
1010             return;
1011          end if;
1012
1013          Comp := First_Component (E);
1014
1015          while Present (Comp) loop
1016             if not Is_Type (Comp)
1017               and then (Strict_Alignment (Etype (Comp))
1018                          or else Is_Aliased (Comp))
1019             then
1020                Set_Strict_Alignment (E);
1021                return;
1022             end if;
1023
1024             Next_Component (Comp);
1025          end loop;
1026       end if;
1027    end Check_Strict_Alignment;
1028
1029    -------------------------
1030    -- Check_Unsigned_Type --
1031    -------------------------
1032
1033    procedure Check_Unsigned_Type (E : Entity_Id) is
1034       Ancestor : Entity_Id;
1035       Lo_Bound : Node_Id;
1036       Btyp     : Entity_Id;
1037
1038    begin
1039       if not Is_Discrete_Or_Fixed_Point_Type (E) then
1040          return;
1041       end if;
1042
1043       --  Do not attempt to analyze case where range was in error
1044
1045       if Error_Posted (Scalar_Range (E)) then
1046          return;
1047       end if;
1048
1049       --  The situation that is non trivial is something like
1050
1051       --     subtype x1 is integer range -10 .. +10;
1052       --     subtype x2 is x1 range 0 .. V1;
1053       --     subtype x3 is x2 range V2 .. V3;
1054       --     subtype x4 is x3 range V4 .. V5;
1055
1056       --  where Vn are variables. Here the base type is signed, but we still
1057       --  know that x4 is unsigned because of the lower bound of x2.
1058
1059       --  The only way to deal with this is to look up the ancestor chain
1060
1061       Ancestor := E;
1062       loop
1063          if Ancestor = Any_Type or else Etype (Ancestor) = Any_Type then
1064             return;
1065          end if;
1066
1067          Lo_Bound := Type_Low_Bound (Ancestor);
1068
1069          if Compile_Time_Known_Value (Lo_Bound) then
1070
1071             if Expr_Rep_Value (Lo_Bound) >= 0 then
1072                Set_Is_Unsigned_Type (E, True);
1073             end if;
1074
1075             return;
1076
1077          else
1078             Ancestor := Ancestor_Subtype (Ancestor);
1079
1080             --  If no ancestor had a static lower bound, go to base type
1081
1082             if No (Ancestor) then
1083
1084                --  Note: the reason we still check for a compile time known
1085                --  value for the base type is that at least in the case of
1086                --  generic formals, we can have bounds that fail this test,
1087                --  and there may be other cases in error situations.
1088
1089                Btyp := Base_Type (E);
1090
1091                if Btyp = Any_Type or else Etype (Btyp) = Any_Type then
1092                   return;
1093                end if;
1094
1095                Lo_Bound := Type_Low_Bound (Base_Type (E));
1096
1097                if Compile_Time_Known_Value (Lo_Bound)
1098                  and then Expr_Rep_Value (Lo_Bound) >= 0
1099                then
1100                   Set_Is_Unsigned_Type (E, True);
1101                end if;
1102
1103                return;
1104             end if;
1105          end if;
1106       end loop;
1107    end Check_Unsigned_Type;
1108
1109    -----------------------------
1110    -- Expand_Atomic_Aggregate --
1111    -----------------------------
1112
1113    procedure Expand_Atomic_Aggregate (E : Entity_Id; Typ : Entity_Id) is
1114       Loc   : constant Source_Ptr := Sloc (E);
1115       New_N : Node_Id;
1116       Temp  : Entity_Id;
1117
1118    begin
1119       if (Nkind (Parent (E)) = N_Object_Declaration
1120             or else Nkind (Parent (E)) = N_Assignment_Statement)
1121         and then Comes_From_Source (Parent (E))
1122         and then Nkind (E) = N_Aggregate
1123       then
1124          Temp :=
1125            Make_Defining_Identifier (Loc,
1126              New_Internal_Name ('T'));
1127
1128          New_N :=
1129            Make_Object_Declaration (Loc,
1130              Defining_Identifier => Temp,
1131              Object_Definition   => New_Occurrence_Of (Typ, Loc),
1132              Expression          => Relocate_Node (E));
1133          Insert_Before (Parent (E), New_N);
1134          Analyze (New_N);
1135
1136          Set_Expression (Parent (E), New_Occurrence_Of (Temp, Loc));
1137
1138          --  To prevent the temporary from being constant-folded (which would
1139          --  lead to the same piecemeal assignment on the original target)
1140          --  indicate to the back-end that the temporary is a variable with
1141          --  real storage. See description of this flag in Einfo, and the notes
1142          --  on N_Assignment_Statement and N_Object_Declaration in Sinfo.
1143
1144          Set_Is_True_Constant (Temp, False);
1145       end if;
1146    end Expand_Atomic_Aggregate;
1147
1148    ----------------
1149    -- Freeze_All --
1150    ----------------
1151
1152    --  Note: the easy coding for this procedure would be to just build a
1153    --  single list of freeze nodes and then insert them and analyze them
1154    --  all at once. This won't work, because the analysis of earlier freeze
1155    --  nodes may recursively freeze types which would otherwise appear later
1156    --  on in the freeze list. So we must analyze and expand the freeze nodes
1157    --  as they are generated.
1158
1159    procedure Freeze_All (From : Entity_Id; After : in out Node_Id) is
1160       Loc   : constant Source_Ptr := Sloc (After);
1161       E     : Entity_Id;
1162       Decl  : Node_Id;
1163
1164       procedure Freeze_All_Ent (From : Entity_Id; After : in out Node_Id);
1165       --  This is the internal recursive routine that does freezing of entities
1166       --  (but NOT the analysis of default expressions, which should not be
1167       --  recursive, we don't want to analyze those till we are sure that ALL
1168       --  the types are frozen).
1169
1170       --------------------
1171       -- Freeze_All_Ent --
1172       --------------------
1173
1174       procedure Freeze_All_Ent
1175         (From  : Entity_Id;
1176          After : in out Node_Id)
1177       is
1178          E     : Entity_Id;
1179          Flist : List_Id;
1180          Lastn : Node_Id;
1181
1182          procedure Process_Flist;
1183          --  If freeze nodes are present, insert and analyze, and reset cursor
1184          --  for next insertion.
1185
1186          -------------------
1187          -- Process_Flist --
1188          -------------------
1189
1190          procedure Process_Flist is
1191          begin
1192             if Is_Non_Empty_List (Flist) then
1193                Lastn := Next (After);
1194                Insert_List_After_And_Analyze (After, Flist);
1195
1196                if Present (Lastn) then
1197                   After := Prev (Lastn);
1198                else
1199                   After := Last (List_Containing (After));
1200                end if;
1201             end if;
1202          end Process_Flist;
1203
1204       --  Start or processing for Freeze_All_Ent
1205
1206       begin
1207          E := From;
1208          while Present (E) loop
1209
1210             --  If the entity is an inner package which is not a package
1211             --  renaming, then its entities must be frozen at this point. Note
1212             --  that such entities do NOT get frozen at the end of the nested
1213             --  package itself (only library packages freeze).
1214
1215             --  Same is true for task declarations, where anonymous records
1216             --  created for entry parameters must be frozen.
1217
1218             if Ekind (E) = E_Package
1219               and then No (Renamed_Object (E))
1220               and then not Is_Child_Unit (E)
1221               and then not Is_Frozen (E)
1222             then
1223                Push_Scope (E);
1224                Install_Visible_Declarations (E);
1225                Install_Private_Declarations (E);
1226
1227                Freeze_All (First_Entity (E), After);
1228
1229                End_Package_Scope (E);
1230
1231             elsif Ekind (E) in Task_Kind
1232               and then
1233                 (Nkind (Parent (E)) = N_Task_Type_Declaration
1234                    or else
1235                  Nkind (Parent (E)) = N_Single_Task_Declaration)
1236             then
1237                Push_Scope (E);
1238                Freeze_All (First_Entity (E), After);
1239                End_Scope;
1240
1241             --  For a derived tagged type, we must ensure that all the
1242             --  primitive operations of the parent have been frozen, so that
1243             --  their addresses will be in the parent's dispatch table at the
1244             --  point it is inherited.
1245
1246             elsif Ekind (E) = E_Record_Type
1247               and then Is_Tagged_Type (E)
1248               and then Is_Tagged_Type (Etype (E))
1249               and then Is_Derived_Type (E)
1250             then
1251                declare
1252                   Prim_List : constant Elist_Id :=
1253                                Primitive_Operations (Etype (E));
1254
1255                   Prim : Elmt_Id;
1256                   Subp : Entity_Id;
1257
1258                begin
1259                   Prim  := First_Elmt (Prim_List);
1260
1261                   while Present (Prim) loop
1262                      Subp := Node (Prim);
1263
1264                      if Comes_From_Source (Subp)
1265                        and then not Is_Frozen (Subp)
1266                      then
1267                         Flist := Freeze_Entity (Subp, Loc);
1268                         Process_Flist;
1269                      end if;
1270
1271                      Next_Elmt (Prim);
1272                   end loop;
1273                end;
1274             end if;
1275
1276             if not Is_Frozen (E) then
1277                Flist := Freeze_Entity (E, Loc);
1278                Process_Flist;
1279             end if;
1280
1281             --  If an incomplete type is still not frozen, this may be a
1282             --  premature freezing because of a body declaration that follows.
1283             --  Indicate where the freezing took place.
1284
1285             --  If the freezing is caused by the end of the current declarative
1286             --  part, it is a Taft Amendment type, and there is no error.
1287
1288             if not Is_Frozen (E)
1289               and then Ekind (E) = E_Incomplete_Type
1290             then
1291                declare
1292                   Bod : constant Node_Id := Next (After);
1293
1294                begin
1295                   if (Nkind (Bod) = N_Subprogram_Body
1296                         or else Nkind (Bod) = N_Entry_Body
1297                         or else Nkind (Bod) = N_Package_Body
1298                         or else Nkind (Bod) = N_Protected_Body
1299                         or else Nkind (Bod) = N_Task_Body
1300                         or else Nkind (Bod) in N_Body_Stub)
1301                      and then
1302                        List_Containing (After) = List_Containing (Parent (E))
1303                   then
1304                      Error_Msg_Sloc := Sloc (Next (After));
1305                      Error_Msg_NE
1306                        ("type& is frozen# before its full declaration",
1307                          Parent (E), E);
1308                   end if;
1309                end;
1310             end if;
1311
1312             Next_Entity (E);
1313          end loop;
1314       end Freeze_All_Ent;
1315
1316    --  Start of processing for Freeze_All
1317
1318    begin
1319       Freeze_All_Ent (From, After);
1320
1321       --  Now that all types are frozen, we can deal with default expressions
1322       --  that require us to build a default expression functions. This is the
1323       --  point at which such functions are constructed (after all types that
1324       --  might be used in such expressions have been frozen).
1325
1326       --  We also add finalization chains to access types whose designated
1327       --  types are controlled. This is normally done when freezing the type,
1328       --  but this misses recursive type definitions where the later members
1329       --  of the recursion introduce controlled components.
1330
1331       --  Loop through entities
1332
1333       E := From;
1334       while Present (E) loop
1335          if Is_Subprogram (E) then
1336
1337             if not Default_Expressions_Processed (E) then
1338                Process_Default_Expressions (E, After);
1339             end if;
1340
1341             if not Has_Completion (E) then
1342                Decl := Unit_Declaration_Node (E);
1343
1344                if Nkind (Decl) = N_Subprogram_Renaming_Declaration then
1345                   Build_And_Analyze_Renamed_Body (Decl, E, After);
1346
1347                elsif Nkind (Decl) = N_Subprogram_Declaration
1348                  and then Present (Corresponding_Body (Decl))
1349                  and then
1350                    Nkind (Unit_Declaration_Node (Corresponding_Body (Decl)))
1351                                           = N_Subprogram_Renaming_Declaration
1352                then
1353                   Build_And_Analyze_Renamed_Body
1354                     (Decl, Corresponding_Body (Decl), After);
1355                end if;
1356             end if;
1357
1358          elsif Ekind (E) in Task_Kind
1359            and then
1360              (Nkind (Parent (E)) = N_Task_Type_Declaration
1361                 or else
1362               Nkind (Parent (E)) = N_Single_Task_Declaration)
1363          then
1364             declare
1365                Ent : Entity_Id;
1366             begin
1367                Ent := First_Entity (E);
1368
1369                while Present (Ent) loop
1370
1371                   if Is_Entry (Ent)
1372                     and then not Default_Expressions_Processed (Ent)
1373                   then
1374                      Process_Default_Expressions (Ent, After);
1375                   end if;
1376
1377                   Next_Entity (Ent);
1378                end loop;
1379             end;
1380
1381          elsif Is_Access_Type (E)
1382            and then Comes_From_Source (E)
1383            and then Ekind (Directly_Designated_Type (E)) = E_Incomplete_Type
1384            and then Needs_Finalization (Designated_Type (E))
1385            and then No (Associated_Final_Chain (E))
1386          then
1387             Build_Final_List (Parent (E), E);
1388          end if;
1389
1390          Next_Entity (E);
1391       end loop;
1392    end Freeze_All;
1393
1394    -----------------------
1395    -- Freeze_And_Append --
1396    -----------------------
1397
1398    procedure Freeze_And_Append
1399      (Ent    : Entity_Id;
1400       Loc    : Source_Ptr;
1401       Result : in out List_Id)
1402    is
1403       L : constant List_Id := Freeze_Entity (Ent, Loc);
1404    begin
1405       if Is_Non_Empty_List (L) then
1406          if Result = No_List then
1407             Result := L;
1408          else
1409             Append_List (L, Result);
1410          end if;
1411       end if;
1412    end Freeze_And_Append;
1413
1414    -------------------
1415    -- Freeze_Before --
1416    -------------------
1417
1418    procedure Freeze_Before (N : Node_Id; T : Entity_Id) is
1419       Freeze_Nodes : constant List_Id := Freeze_Entity (T, Sloc (N));
1420    begin
1421       if Is_Non_Empty_List (Freeze_Nodes) then
1422          Insert_Actions (N, Freeze_Nodes);
1423       end if;
1424    end Freeze_Before;
1425
1426    -------------------
1427    -- Freeze_Entity --
1428    -------------------
1429
1430    function Freeze_Entity (E : Entity_Id; Loc : Source_Ptr) return List_Id is
1431       Test_E : Entity_Id := E;
1432       Comp   : Entity_Id;
1433       F_Node : Node_Id;
1434       Result : List_Id;
1435       Indx   : Node_Id;
1436       Formal : Entity_Id;
1437       Atype  : Entity_Id;
1438
1439       procedure Check_Current_Instance (Comp_Decl : Node_Id);
1440       --  Check that an Access or Unchecked_Access attribute with a prefix
1441       --  which is the current instance type can only be applied when the type
1442       --  is limited.
1443
1444       function After_Last_Declaration return Boolean;
1445       --  If Loc is a freeze_entity that appears after the last declaration
1446       --  in the scope, inhibit error messages on late completion.
1447
1448       procedure Freeze_Record_Type (Rec : Entity_Id);
1449       --  Freeze each component, handle some representation clauses, and freeze
1450       --  primitive operations if this is a tagged type.
1451
1452       ----------------------------
1453       -- After_Last_Declaration --
1454       ----------------------------
1455
1456       function After_Last_Declaration return Boolean is
1457          Spec  : constant Node_Id := Parent (Current_Scope);
1458       begin
1459          if Nkind (Spec) = N_Package_Specification then
1460             if Present (Private_Declarations (Spec)) then
1461                return Loc >= Sloc (Last (Private_Declarations (Spec)));
1462             elsif Present (Visible_Declarations (Spec)) then
1463                return Loc >= Sloc (Last (Visible_Declarations (Spec)));
1464             else
1465                return False;
1466             end if;
1467          else
1468             return False;
1469          end if;
1470       end After_Last_Declaration;
1471
1472       ----------------------------
1473       -- Check_Current_Instance --
1474       ----------------------------
1475
1476       procedure Check_Current_Instance (Comp_Decl : Node_Id) is
1477
1478          Rec_Type : constant Entity_Id :=
1479                       Scope (Defining_Identifier (Comp_Decl));
1480
1481          Decl : constant Node_Id := Parent (Rec_Type);
1482
1483          function Process (N : Node_Id) return Traverse_Result;
1484          --  Process routine to apply check to given node
1485
1486          -------------
1487          -- Process --
1488          -------------
1489
1490          function Process (N : Node_Id) return Traverse_Result is
1491          begin
1492             case Nkind (N) is
1493                when N_Attribute_Reference =>
1494                   if (Attribute_Name (N) = Name_Access
1495                         or else
1496                       Attribute_Name (N) = Name_Unchecked_Access)
1497                     and then Is_Entity_Name (Prefix (N))
1498                     and then Is_Type (Entity (Prefix (N)))
1499                     and then Entity (Prefix (N)) = E
1500                   then
1501                      Error_Msg_N
1502                        ("current instance must be a limited type", Prefix (N));
1503                      return Abandon;
1504                   else
1505                      return OK;
1506                   end if;
1507
1508                when others => return OK;
1509             end case;
1510          end Process;
1511
1512          procedure Traverse is new Traverse_Proc (Process);
1513
1514       --  Start of processing for Check_Current_Instance
1515
1516       begin
1517          --  In Ada95, the (imprecise) rule is that the current instance of a
1518          --  limited type is aliased. In Ada2005, limitedness must be explicit:
1519          --  either a tagged type, or a limited record.
1520
1521          if Is_Limited_Type (Rec_Type)
1522            and then
1523              (Ada_Version < Ada_05
1524                or else Is_Tagged_Type (Rec_Type))
1525          then
1526             return;
1527
1528          elsif Nkind (Decl) = N_Full_Type_Declaration
1529            and then Limited_Present (Type_Definition (Decl))
1530          then
1531             return;
1532
1533          else
1534             Traverse (Comp_Decl);
1535          end if;
1536       end Check_Current_Instance;
1537
1538       ------------------------
1539       -- Freeze_Record_Type --
1540       ------------------------
1541
1542       procedure Freeze_Record_Type (Rec : Entity_Id) is
1543          Comp : Entity_Id;
1544          IR   : Node_Id;
1545          ADC  : Node_Id;
1546          Prev : Entity_Id;
1547
1548          Junk : Boolean;
1549          pragma Warnings (Off, Junk);
1550
1551          Unplaced_Component : Boolean := False;
1552          --  Set True if we find at least one component with no component
1553          --  clause (used to warn about useless Pack pragmas).
1554
1555          Placed_Component : Boolean := False;
1556          --  Set True if we find at least one component with a component
1557          --  clause (used to warn about useless Bit_Order pragmas).
1558
1559          function Check_Allocator (N : Node_Id) return Node_Id;
1560          --  If N is an allocator, possibly wrapped in one or more level of
1561          --  qualified expression(s), return the inner allocator node, else
1562          --  return Empty.
1563
1564          procedure Check_Itype (Typ : Entity_Id);
1565          --  If the component subtype is an access to a constrained subtype of
1566          --  an already frozen type, make the subtype frozen as well. It might
1567          --  otherwise be frozen in the wrong scope, and a freeze node on
1568          --  subtype has no effect. Similarly, if the component subtype is a
1569          --  regular (not protected) access to subprogram, set the anonymous
1570          --  subprogram type to frozen as well, to prevent an out-of-scope
1571          --  freeze node at some eventual point of call. Protected operations
1572          --  are handled elsewhere.
1573
1574          ---------------------
1575          -- Check_Allocator --
1576          ---------------------
1577
1578          function Check_Allocator (N : Node_Id) return Node_Id is
1579             Inner : Node_Id;
1580          begin
1581             Inner := N;
1582             loop
1583                if Nkind (Inner) = N_Allocator then
1584                   return Inner;
1585                elsif Nkind (Inner) = N_Qualified_Expression then
1586                   Inner := Expression (Inner);
1587                else
1588                   return Empty;
1589                end if;
1590             end loop;
1591          end Check_Allocator;
1592
1593          -----------------
1594          -- Check_Itype --
1595          -----------------
1596
1597          procedure Check_Itype (Typ : Entity_Id) is
1598             Desig : constant Entity_Id := Designated_Type (Typ);
1599
1600          begin
1601             if not Is_Frozen (Desig)
1602               and then Is_Frozen (Base_Type (Desig))
1603             then
1604                Set_Is_Frozen (Desig);
1605
1606                --  In addition, add an Itype_Reference to ensure that the
1607                --  access subtype is elaborated early enough. This cannot be
1608                --  done if the subtype may depend on discriminants.
1609
1610                if Ekind (Comp) = E_Component
1611                  and then Is_Itype (Etype (Comp))
1612                  and then not Has_Discriminants (Rec)
1613                then
1614                   IR := Make_Itype_Reference (Sloc (Comp));
1615                   Set_Itype (IR, Desig);
1616
1617                   if No (Result) then
1618                      Result := New_List (IR);
1619                   else
1620                      Append (IR, Result);
1621                   end if;
1622                end if;
1623
1624             elsif Ekind (Typ) = E_Anonymous_Access_Subprogram_Type
1625               and then Convention (Desig) /= Convention_Protected
1626             then
1627                Set_Is_Frozen (Desig);
1628             end if;
1629          end Check_Itype;
1630
1631       --  Start of processing for Freeze_Record_Type
1632
1633       begin
1634          --  If this is a subtype of a controlled type, declared without a
1635          --  constraint, the _controller may not appear in the component list
1636          --  if the parent was not frozen at the point of subtype declaration.
1637          --  Inherit the _controller component now.
1638
1639          if Rec /= Base_Type (Rec)
1640            and then Has_Controlled_Component (Rec)
1641          then
1642             if Nkind (Parent (Rec)) = N_Subtype_Declaration
1643               and then Is_Entity_Name (Subtype_Indication (Parent (Rec)))
1644             then
1645                Set_First_Entity (Rec, First_Entity (Base_Type (Rec)));
1646
1647             --  If this is an internal type without a declaration, as for
1648             --  record component, the base type may not yet be frozen, and its
1649             --  controller has not been created. Add an explicit freeze node
1650             --  for the itype, so it will be frozen after the base type. This
1651             --  freeze node is used to communicate with the expander, in order
1652             --  to create the controller for the enclosing record, and it is
1653             --  deleted afterwards (see exp_ch3). It must not be created when
1654             --  expansion is off, because it might appear in the wrong context
1655             --  for the back end.
1656
1657             elsif Is_Itype (Rec)
1658               and then Has_Delayed_Freeze (Base_Type (Rec))
1659               and then
1660                 Nkind (Associated_Node_For_Itype (Rec)) =
1661                                                      N_Component_Declaration
1662               and then Expander_Active
1663             then
1664                Ensure_Freeze_Node (Rec);
1665             end if;
1666          end if;
1667
1668          --  Freeze components and embedded subtypes
1669
1670          Comp := First_Entity (Rec);
1671          Prev := Empty;
1672          while Present (Comp) loop
1673
1674             --  First handle the (real) component case
1675
1676             if Ekind (Comp) = E_Component
1677               or else Ekind (Comp) = E_Discriminant
1678             then
1679                declare
1680                   CC : constant Node_Id := Component_Clause (Comp);
1681
1682                begin
1683                   --  Freezing a record type freezes the type of each of its
1684                   --  components. However, if the type of the component is
1685                   --  part of this record, we do not want or need a separate
1686                   --  Freeze_Node. Note that Is_Itype is wrong because that's
1687                   --  also set in private type cases. We also can't check for
1688                   --  the Scope being exactly Rec because of private types and
1689                   --  record extensions.
1690
1691                   if Is_Itype (Etype (Comp))
1692                     and then Is_Record_Type (Underlying_Type
1693                                              (Scope (Etype (Comp))))
1694                   then
1695                      Undelay_Type (Etype (Comp));
1696                   end if;
1697
1698                   Freeze_And_Append (Etype (Comp), Loc, Result);
1699
1700                   --  Check for error of component clause given for variable
1701                   --  sized type. We have to delay this test till this point,
1702                   --  since the component type has to be frozen for us to know
1703                   --  if it is variable length. We omit this test in a generic
1704                   --  context, it will be applied at instantiation time.
1705
1706                   if Present (CC) then
1707                      Placed_Component := True;
1708
1709                      if Inside_A_Generic then
1710                         null;
1711
1712                      elsif not
1713                        Size_Known_At_Compile_Time
1714                          (Underlying_Type (Etype (Comp)))
1715                      then
1716                         Error_Msg_N
1717                           ("component clause not allowed for variable " &
1718                            "length component", CC);
1719                      end if;
1720
1721                   else
1722                      Unplaced_Component := True;
1723                   end if;
1724
1725                   --  Case of component requires byte alignment
1726
1727                   if Must_Be_On_Byte_Boundary (Etype (Comp)) then
1728
1729                      --  Set the enclosing record to also require byte align
1730
1731                      Set_Must_Be_On_Byte_Boundary (Rec);
1732
1733                      --  Check for component clause that is inconsistent with
1734                      --  the required byte boundary alignment.
1735
1736                      if Present (CC)
1737                        and then Normalized_First_Bit (Comp) mod
1738                                   System_Storage_Unit /= 0
1739                      then
1740                         Error_Msg_N
1741                           ("component & must be byte aligned",
1742                            Component_Name (Component_Clause (Comp)));
1743                      end if;
1744                   end if;
1745
1746                   --  If component clause is present, then deal with the non-
1747                   --  default bit order case for Ada 95 mode. The required
1748                   --  processing for Ada 2005 mode is handled separately after
1749                   --  processing all components.
1750
1751                   --  We only do this processing for the base type, and in
1752                   --  fact that's important, since otherwise if there are
1753                   --  record subtypes, we could reverse the bits once for
1754                   --  each subtype, which would be incorrect.
1755
1756                   if Present (CC)
1757                     and then Reverse_Bit_Order (Rec)
1758                     and then Ekind (E) = E_Record_Type
1759                     and then Ada_Version <= Ada_95
1760                   then
1761                      declare
1762                         CFB : constant Uint    := Component_Bit_Offset (Comp);
1763                         CSZ : constant Uint    := Esize (Comp);
1764                         CLC : constant Node_Id := Component_Clause (Comp);
1765                         Pos : constant Node_Id := Position (CLC);
1766                         FB  : constant Node_Id := First_Bit (CLC);
1767
1768                         Storage_Unit_Offset : constant Uint :=
1769                                                 CFB / System_Storage_Unit;
1770
1771                         Start_Bit : constant Uint :=
1772                                       CFB mod System_Storage_Unit;
1773
1774                      begin
1775                         --  Cases where field goes over storage unit boundary
1776
1777                         if Start_Bit + CSZ > System_Storage_Unit then
1778
1779                            --  Allow multi-byte field but generate warning
1780
1781                            if Start_Bit mod System_Storage_Unit = 0
1782                              and then CSZ mod System_Storage_Unit = 0
1783                            then
1784                               Error_Msg_N
1785                                 ("multi-byte field specified with non-standard"
1786                                  & " Bit_Order?", CLC);
1787
1788                               if Bytes_Big_Endian then
1789                                  Error_Msg_N
1790                                    ("bytes are not reversed "
1791                                     & "(component is big-endian)?", CLC);
1792                               else
1793                                  Error_Msg_N
1794                                    ("bytes are not reversed "
1795                                     & "(component is little-endian)?", CLC);
1796                               end if;
1797
1798                            --  Do not allow non-contiguous field
1799
1800                            else
1801                               Error_Msg_N
1802                                 ("attempt to specify non-contiguous field "
1803                                  & "not permitted", CLC);
1804                               Error_Msg_N
1805                                 ("\caused by non-standard Bit_Order "
1806                                  & "specified", CLC);
1807                               Error_Msg_N
1808                                 ("\consider possibility of using "
1809                                  & "Ada 2005 mode here", CLC);
1810                            end if;
1811
1812                         --  Case where field fits in one storage unit
1813
1814                         else
1815                            --  Give warning if suspicious component clause
1816
1817                            if Intval (FB) >= System_Storage_Unit
1818                              and then Warn_On_Reverse_Bit_Order
1819                            then
1820                               Error_Msg_N
1821                                 ("?Bit_Order clause does not affect " &
1822                                  "byte ordering", Pos);
1823                               Error_Msg_Uint_1 :=
1824                                 Intval (Pos) + Intval (FB) /
1825                                   System_Storage_Unit;
1826                               Error_Msg_N
1827                                 ("?position normalized to ^ before bit " &
1828                                  "order interpreted", Pos);
1829                            end if;
1830
1831                            --  Here is where we fix up the Component_Bit_Offset
1832                            --  value to account for the reverse bit order.
1833                            --  Some examples of what needs to be done are:
1834
1835                            --    First_Bit .. Last_Bit     Component_Bit_Offset
1836                            --      old          new          old       new
1837
1838                            --     0 .. 0       7 .. 7         0         7
1839                            --     0 .. 1       6 .. 7         0         6
1840                            --     0 .. 2       5 .. 7         0         5
1841                            --     0 .. 7       0 .. 7         0         4
1842
1843                            --     1 .. 1       6 .. 6         1         6
1844                            --     1 .. 4       3 .. 6         1         3
1845                            --     4 .. 7       0 .. 3         4         0
1846
1847                            --  The general rule is that the first bit is
1848                            --  is obtained by subtracting the old ending bit
1849                            --  from storage_unit - 1.
1850
1851                            Set_Component_Bit_Offset
1852                              (Comp,
1853                               (Storage_Unit_Offset * System_Storage_Unit) +
1854                                 (System_Storage_Unit - 1) -
1855                                   (Start_Bit + CSZ - 1));
1856
1857                            Set_Normalized_First_Bit
1858                              (Comp,
1859                                 Component_Bit_Offset (Comp) mod
1860                                   System_Storage_Unit);
1861                         end if;
1862                      end;
1863                   end if;
1864                end;
1865             end if;
1866
1867             --  If the component is an Itype with Delayed_Freeze and is either
1868             --  a record or array subtype and its base type has not yet been
1869             --  frozen, we must remove this from the entity list of this
1870             --  record and put it on the entity list of the scope of its base
1871             --  type. Note that we know that this is not the type of a
1872             --  component since we cleared Has_Delayed_Freeze for it in the
1873             --  previous loop. Thus this must be the Designated_Type of an
1874             --  access type, which is the type of a component.
1875
1876             if Is_Itype (Comp)
1877               and then Is_Type (Scope (Comp))
1878               and then Is_Composite_Type (Comp)
1879               and then Base_Type (Comp) /= Comp
1880               and then Has_Delayed_Freeze (Comp)
1881               and then not Is_Frozen (Base_Type (Comp))
1882             then
1883                declare
1884                   Will_Be_Frozen : Boolean := False;
1885                   S              : Entity_Id;
1886
1887                begin
1888                   --  We have a pretty bad kludge here. Suppose Rec is subtype
1889                   --  being defined in a subprogram that's created as part of
1890                   --  the freezing of Rec'Base. In that case, we know that
1891                   --  Comp'Base must have already been frozen by the time we
1892                   --  get to elaborate this because Gigi doesn't elaborate any
1893                   --  bodies until it has elaborated all of the declarative
1894                   --  part. But Is_Frozen will not be set at this point because
1895                   --  we are processing code in lexical order.
1896
1897                   --  We detect this case by going up the Scope chain of Rec
1898                   --  and seeing if we have a subprogram scope before reaching
1899                   --  the top of the scope chain or that of Comp'Base. If we
1900                   --  do, then mark that Comp'Base will actually be frozen. If
1901                   --  so, we merely undelay it.
1902
1903                   S := Scope (Rec);
1904                   while Present (S) loop
1905                      if Is_Subprogram (S) then
1906                         Will_Be_Frozen := True;
1907                         exit;
1908                      elsif S = Scope (Base_Type (Comp)) then
1909                         exit;
1910                      end if;
1911
1912                      S := Scope (S);
1913                   end loop;
1914
1915                   if Will_Be_Frozen then
1916                      Undelay_Type (Comp);
1917                   else
1918                      if Present (Prev) then
1919                         Set_Next_Entity (Prev, Next_Entity (Comp));
1920                      else
1921                         Set_First_Entity (Rec, Next_Entity (Comp));
1922                      end if;
1923
1924                      --  Insert in entity list of scope of base type (which
1925                      --  must be an enclosing scope, because still unfrozen).
1926
1927                      Append_Entity (Comp, Scope (Base_Type (Comp)));
1928                   end if;
1929                end;
1930
1931             --  If the component is an access type with an allocator as default
1932             --  value, the designated type will be frozen by the corresponding
1933             --  expression in init_proc. In order to place the freeze node for
1934             --  the designated type before that for the current record type,
1935             --  freeze it now.
1936
1937             --  Same process if the component is an array of access types,
1938             --  initialized with an aggregate. If the designated type is
1939             --  private, it cannot contain allocators, and it is premature
1940             --  to freeze the type, so we check for this as well.
1941
1942             elsif Is_Access_Type (Etype (Comp))
1943               and then Present (Parent (Comp))
1944               and then Present (Expression (Parent (Comp)))
1945             then
1946                declare
1947                   Alloc : constant Node_Id :=
1948                             Check_Allocator (Expression (Parent (Comp)));
1949
1950                begin
1951                   if Present (Alloc) then
1952
1953                      --  If component is pointer to a classwide type, freeze
1954                      --  the specific type in the expression being allocated.
1955                      --  The expression may be a subtype indication, in which
1956                      --  case freeze the subtype mark.
1957
1958                      if Is_Class_Wide_Type
1959                           (Designated_Type (Etype (Comp)))
1960                      then
1961                         if Is_Entity_Name (Expression (Alloc)) then
1962                            Freeze_And_Append
1963                              (Entity (Expression (Alloc)), Loc, Result);
1964                         elsif
1965                           Nkind (Expression (Alloc)) = N_Subtype_Indication
1966                         then
1967                            Freeze_And_Append
1968                             (Entity (Subtype_Mark (Expression (Alloc))),
1969                               Loc, Result);
1970                         end if;
1971
1972                      elsif Is_Itype (Designated_Type (Etype (Comp))) then
1973                         Check_Itype (Etype (Comp));
1974
1975                      else
1976                         Freeze_And_Append
1977                           (Designated_Type (Etype (Comp)), Loc, Result);
1978                      end if;
1979                   end if;
1980                end;
1981
1982             elsif Is_Access_Type (Etype (Comp))
1983               and then Is_Itype (Designated_Type (Etype (Comp)))
1984             then
1985                Check_Itype (Etype (Comp));
1986
1987             elsif Is_Array_Type (Etype (Comp))
1988               and then Is_Access_Type (Component_Type (Etype (Comp)))
1989               and then Present (Parent (Comp))
1990               and then Nkind (Parent (Comp)) = N_Component_Declaration
1991               and then Present (Expression (Parent (Comp)))
1992               and then Nkind (Expression (Parent (Comp))) = N_Aggregate
1993               and then Is_Fully_Defined
1994                  (Designated_Type (Component_Type (Etype (Comp))))
1995             then
1996                Freeze_And_Append
1997                  (Designated_Type
1998                    (Component_Type (Etype (Comp))), Loc, Result);
1999             end if;
2000
2001             Prev := Comp;
2002             Next_Entity (Comp);
2003          end loop;
2004
2005          --  Deal with pragma Bit_Order
2006
2007          if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then
2008             if not Placed_Component then
2009                ADC :=
2010                  Get_Attribute_Definition_Clause (Rec, Attribute_Bit_Order);
2011                Error_Msg_N
2012                  ("?Bit_Order specification has no effect", ADC);
2013                Error_Msg_N
2014                  ("\?since no component clauses were specified", ADC);
2015
2016             --  Here is where we do Ada 2005 processing for bit order (the Ada
2017             --  95 case was already taken care of above).
2018
2019             elsif Ada_Version >= Ada_05 then
2020                Adjust_Record_For_Reverse_Bit_Order (Rec);
2021             end if;
2022          end if;
2023
2024          --  Set OK_To_Reorder_Components depending on debug flags
2025
2026          if Rec = Base_Type (Rec)
2027            and then Convention (Rec) = Convention_Ada
2028          then
2029             if (Has_Discriminants (Rec) and then Debug_Flag_Dot_V)
2030                   or else
2031                (not Has_Discriminants (Rec) and then Debug_Flag_Dot_R)
2032             then
2033                Set_OK_To_Reorder_Components (Rec);
2034             end if;
2035          end if;
2036
2037          --  Check for useless pragma Pack when all components placed. We only
2038          --  do this check for record types, not subtypes, since a subtype may
2039          --  have all its components placed, and it still makes perfectly good
2040          --  sense to pack other subtypes or the parent type. We do not give
2041          --  this warning if Optimize_Alignment is set to Space, since the
2042          --  pragma Pack does have an effect in this case (it always resets
2043          --  the alignment to one).
2044
2045          if Ekind (Rec) = E_Record_Type
2046            and then Is_Packed (Rec)
2047            and then not Unplaced_Component
2048            and then Optimize_Alignment /= 'S'
2049          then
2050             --  Reset packed status. Probably not necessary, but we do it so
2051             --  that there is no chance of the back end doing something strange
2052             --  with this redundant indication of packing.
2053
2054             Set_Is_Packed (Rec, False);
2055
2056             --  Give warning if redundant constructs warnings on
2057
2058             if Warn_On_Redundant_Constructs then
2059                Error_Msg_N
2060                  ("?pragma Pack has no effect, no unplaced components",
2061                   Get_Rep_Pragma (Rec, Name_Pack));
2062             end if;
2063          end if;
2064
2065          --  If this is the record corresponding to a remote type, freeze the
2066          --  remote type here since that is what we are semantically freezing.
2067          --  This prevents the freeze node for that type in an inner scope.
2068
2069          --  Also, Check for controlled components and unchecked unions.
2070          --  Finally, enforce the restriction that access attributes with a
2071          --  current instance prefix can only apply to limited types.
2072
2073          if  Ekind (Rec) = E_Record_Type then
2074             if Present (Corresponding_Remote_Type (Rec)) then
2075                Freeze_And_Append
2076                  (Corresponding_Remote_Type (Rec), Loc, Result);
2077             end if;
2078
2079             Comp := First_Component (Rec);
2080             while Present (Comp) loop
2081                if Has_Controlled_Component (Etype (Comp))
2082                  or else (Chars (Comp) /= Name_uParent
2083                            and then Is_Controlled (Etype (Comp)))
2084                  or else (Is_Protected_Type (Etype (Comp))
2085                            and then Present
2086                              (Corresponding_Record_Type (Etype (Comp)))
2087                            and then Has_Controlled_Component
2088                              (Corresponding_Record_Type (Etype (Comp))))
2089                then
2090                   Set_Has_Controlled_Component (Rec);
2091                   exit;
2092                end if;
2093
2094                if Has_Unchecked_Union (Etype (Comp)) then
2095                   Set_Has_Unchecked_Union (Rec);
2096                end if;
2097
2098                if Has_Per_Object_Constraint (Comp) then
2099
2100                   --  Scan component declaration for likely misuses of current
2101                   --  instance, either in a constraint or a default expression.
2102
2103                   Check_Current_Instance (Parent (Comp));
2104                end if;
2105
2106                Next_Component (Comp);
2107             end loop;
2108          end if;
2109
2110          Set_Component_Alignment_If_Not_Set (Rec);
2111
2112          --  For first subtypes, check if there are any fixed-point fields with
2113          --  component clauses, where we must check the size. This is not done
2114          --  till the freeze point, since for fixed-point types, we do not know
2115          --  the size until the type is frozen. Similar processing applies to
2116          --  bit packed arrays.
2117
2118          if Is_First_Subtype (Rec) then
2119             Comp := First_Component (Rec);
2120
2121             while Present (Comp) loop
2122                if Present (Component_Clause (Comp))
2123                  and then (Is_Fixed_Point_Type (Etype (Comp))
2124                              or else
2125                            Is_Bit_Packed_Array (Etype (Comp)))
2126                then
2127                   Check_Size
2128                     (Component_Name (Component_Clause (Comp)),
2129                      Etype (Comp),
2130                      Esize (Comp),
2131                      Junk);
2132                end if;
2133
2134                Next_Component (Comp);
2135             end loop;
2136          end if;
2137
2138          --  Generate warning for applying C or C++ convention to a record
2139          --  with discriminants. This is suppressed for the unchecked union
2140          --  case, since the whole point in this case is interface C. We also
2141          --  do not generate this within instantiations, since we will have
2142          --  generated a message on the template.
2143
2144          if Has_Discriminants (E)
2145            and then not Is_Unchecked_Union (E)
2146            and then (Convention (E) = Convention_C
2147                        or else
2148                      Convention (E) = Convention_CPP)
2149            and then Comes_From_Source (E)
2150            and then not In_Instance
2151            and then not Has_Warnings_Off (E)
2152            and then not Has_Warnings_Off (Base_Type (E))
2153          then
2154             declare
2155                Cprag : constant Node_Id := Get_Rep_Pragma (E, Name_Convention);
2156                A2    : Node_Id;
2157
2158             begin
2159                if Present (Cprag) then
2160                   A2 := Next (First (Pragma_Argument_Associations (Cprag)));
2161
2162                   if Convention (E) = Convention_C then
2163                      Error_Msg_N
2164                        ("?variant record has no direct equivalent in C", A2);
2165                   else
2166                      Error_Msg_N
2167                        ("?variant record has no direct equivalent in C++", A2);
2168                   end if;
2169
2170                   Error_Msg_NE
2171                     ("\?use of convention for type& is dubious", A2, E);
2172                end if;
2173             end;
2174          end if;
2175       end Freeze_Record_Type;
2176
2177    --  Start of processing for Freeze_Entity
2178
2179    begin
2180       --  We are going to test for various reasons why this entity need not be
2181       --  frozen here, but in the case of an Itype that's defined within a
2182       --  record, that test actually applies to the record.
2183
2184       if Is_Itype (E) and then Is_Record_Type (Scope (E)) then
2185          Test_E := Scope (E);
2186       elsif Is_Itype (E) and then Present (Underlying_Type (Scope (E)))
2187         and then Is_Record_Type (Underlying_Type (Scope (E)))
2188       then
2189          Test_E := Underlying_Type (Scope (E));
2190       end if;
2191
2192       --  Do not freeze if already frozen since we only need one freeze node
2193
2194       if Is_Frozen (E) then
2195          return No_List;
2196
2197       --  It is improper to freeze an external entity within a generic because
2198       --  its freeze node will appear in a non-valid context. The entity will
2199       --  be frozen in the proper scope after the current generic is analyzed.
2200
2201       elsif Inside_A_Generic and then External_Ref_In_Generic (Test_E) then
2202          return No_List;
2203
2204       --  Do not freeze a global entity within an inner scope created during
2205       --  expansion. A call to subprogram E within some internal procedure
2206       --  (a stream attribute for example) might require freezing E, but the
2207       --  freeze node must appear in the same declarative part as E itself.
2208       --  The two-pass elaboration mechanism in gigi guarantees that E will
2209       --  be frozen before the inner call is elaborated. We exclude constants
2210       --  from this test, because deferred constants may be frozen early, and
2211       --  must be diagnosed (e.g. in the case of a deferred constant being used
2212       --  in a default expression). If the enclosing subprogram comes from
2213       --  source, or is a generic instance, then the freeze point is the one
2214       --  mandated by the language, and we freeze the entity. A subprogram that
2215       --  is a child unit body that acts as a spec does not have a spec that
2216       --  comes from source, but can only come from source.
2217
2218       elsif In_Open_Scopes (Scope (Test_E))
2219         and then Scope (Test_E) /= Current_Scope
2220         and then Ekind (Test_E) /= E_Constant
2221       then
2222          declare
2223             S : Entity_Id := Current_Scope;
2224
2225          begin
2226             while Present (S) loop
2227                if Is_Overloadable (S) then
2228                   if Comes_From_Source (S)
2229                     or else Is_Generic_Instance (S)
2230                     or else Is_Child_Unit (S)
2231                   then
2232                      exit;
2233                   else
2234                      return No_List;
2235                   end if;
2236                end if;
2237
2238                S := Scope (S);
2239             end loop;
2240          end;
2241
2242       --  Similarly, an inlined instance body may make reference to global
2243       --  entities, but these references cannot be the proper freezing point
2244       --  for them, and in the absence of inlining freezing will take place in
2245       --  their own scope. Normally instance bodies are analyzed after the
2246       --  enclosing compilation, and everything has been frozen at the proper
2247       --  place, but with front-end inlining an instance body is compiled
2248       --  before the end of the enclosing scope, and as a result out-of-order
2249       --  freezing must be prevented.
2250
2251       elsif Front_End_Inlining
2252         and then In_Instance_Body
2253         and then Present (Scope (Test_E))
2254       then
2255          declare
2256             S : Entity_Id := Scope (Test_E);
2257
2258          begin
2259             while Present (S) loop
2260                if Is_Generic_Instance (S) then
2261                   exit;
2262                else
2263                   S := Scope (S);
2264                end if;
2265             end loop;
2266
2267             if No (S) then
2268                return No_List;
2269             end if;
2270          end;
2271       end if;
2272
2273       --  Here to freeze the entity
2274
2275       Result := No_List;
2276       Set_Is_Frozen (E);
2277
2278       --  Case of entity being frozen is other than a type
2279
2280       if not Is_Type (E) then
2281
2282          --  If entity is exported or imported and does not have an external
2283          --  name, now is the time to provide the appropriate default name.
2284          --  Skip this if the entity is stubbed, since we don't need a name
2285          --  for any stubbed routine.
2286
2287          if (Is_Imported (E) or else Is_Exported (E))
2288            and then No (Interface_Name (E))
2289            and then Convention (E) /= Convention_Stubbed
2290          then
2291             Set_Encoded_Interface_Name
2292               (E, Get_Default_External_Name (E));
2293
2294          --  Special processing for atomic objects appearing in object decls
2295
2296          elsif Is_Atomic (E)
2297            and then Nkind (Parent (E)) = N_Object_Declaration
2298            and then Present (Expression (Parent (E)))
2299          then
2300             declare
2301                Expr : constant Node_Id := Expression (Parent (E));
2302
2303             begin
2304                --  If expression is an aggregate, assign to a temporary to
2305                --  ensure that the actual assignment is done atomically rather
2306                --  than component-wise (the assignment to the temp may be done
2307                --  component-wise, but that is harmless).
2308
2309                if Nkind (Expr) = N_Aggregate then
2310                   Expand_Atomic_Aggregate (Expr, Etype (E));
2311
2312                --  If the expression is a reference to a record or array object
2313                --  entity, then reset Is_True_Constant to False so that the
2314                --  compiler will not optimize away the intermediate object,
2315                --  which we need in this case for the same reason (to ensure
2316                --  that the actual assignment is atomic, rather than
2317                --  component-wise).
2318
2319                elsif Is_Entity_Name (Expr)
2320                  and then (Is_Record_Type (Etype (Expr))
2321                              or else
2322                            Is_Array_Type (Etype (Expr)))
2323                then
2324                   Set_Is_True_Constant (Entity (Expr), False);
2325                end if;
2326             end;
2327          end if;
2328
2329          --  For a subprogram, freeze all parameter types and also the return
2330          --  type (RM 13.14(14)). However skip this for internal subprograms.
2331          --  This is also the point where any extra formal parameters are
2332          --  created since we now know whether the subprogram will use
2333          --  a foreign convention.
2334
2335          if Is_Subprogram (E) then
2336             if not Is_Internal (E) then
2337                declare
2338                   F_Type    : Entity_Id;
2339                   R_Type    : Entity_Id;
2340                   Warn_Node : Node_Id;
2341
2342                begin
2343                   --  Loop through formals
2344
2345                   Formal := First_Formal (E);
2346                   while Present (Formal) loop
2347                      F_Type := Etype (Formal);
2348                      Freeze_And_Append (F_Type, Loc, Result);
2349
2350                      if Is_Private_Type (F_Type)
2351                        and then Is_Private_Type (Base_Type (F_Type))
2352                        and then No (Full_View (Base_Type (F_Type)))
2353                        and then not Is_Generic_Type (F_Type)
2354                        and then not Is_Derived_Type (F_Type)
2355                      then
2356                         --  If the type of a formal is incomplete, subprogram
2357                         --  is being frozen prematurely. Within an instance
2358                         --  (but not within a wrapper package) this is an
2359                         --  an artifact of our need to regard the end of an
2360                         --  instantiation as a freeze point. Otherwise it is
2361                         --  a definite error.
2362
2363                         --  and then not Is_Wrapper_Package (Current_Scope) ???
2364
2365                         if In_Instance then
2366                            Set_Is_Frozen (E, False);
2367                            return No_List;
2368
2369                         elsif not After_Last_Declaration
2370                           and then not Freezing_Library_Level_Tagged_Type
2371                         then
2372                            Error_Msg_Node_1 := F_Type;
2373                            Error_Msg
2374                              ("type& must be fully defined before this point",
2375                                Loc);
2376                         end if;
2377                      end if;
2378
2379                      --  Check suspicious parameter for C function. These tests
2380                      --  apply only to exported/imported subprograms.
2381
2382                      if Warn_On_Export_Import
2383                        and then Comes_From_Source (E)
2384                        and then (Convention (E) = Convention_C
2385                                    or else
2386                                  Convention (E) = Convention_CPP)
2387                        and then (Is_Imported (E) or else Is_Exported (E))
2388                        and then Convention (E) /= Convention (Formal)
2389                        and then not Has_Warnings_Off (E)
2390                        and then not Has_Warnings_Off (F_Type)
2391                        and then not Has_Warnings_Off (Formal)
2392                      then
2393                         Error_Msg_Qual_Level := 1;
2394
2395                         --  Check suspicious use of fat C pointer
2396
2397                         if Is_Access_Type (F_Type)
2398                           and then Esize (F_Type) > Ttypes.System_Address_Size
2399                         then
2400                            Error_Msg_N
2401                              ("?type of & does not correspond "
2402                               & "to C pointer!", Formal);
2403
2404                         --  Check suspicious return of boolean
2405
2406                         elsif Root_Type (F_Type) = Standard_Boolean
2407                           and then Convention (F_Type) = Convention_Ada
2408                           and then not Has_Warnings_Off (F_Type)
2409                           and then not Has_Size_Clause (F_Type)
2410                         then
2411                            Error_Msg_N
2412                              ("?& is an 8-bit Ada Boolean, "
2413                               & "use char in C!", Formal);
2414
2415                         --  Check suspicious tagged type
2416
2417                         elsif (Is_Tagged_Type (F_Type)
2418                                 or else (Is_Access_Type (F_Type)
2419                                            and then
2420                                              Is_Tagged_Type
2421                                                (Designated_Type (F_Type))))
2422                           and then Convention (E) = Convention_C
2423                         then
2424                            Error_Msg_N
2425                              ("?& is a tagged type which does not "
2426                               & "correspond to any C type!", Formal);
2427
2428                         --  Check wrong convention subprogram pointer
2429
2430                         elsif Ekind (F_Type) = E_Access_Subprogram_Type
2431                           and then not Has_Foreign_Convention (F_Type)
2432                         then
2433                            Error_Msg_N
2434                              ("?subprogram pointer & should "
2435                               & "have foreign convention!", Formal);
2436                            Error_Msg_Sloc := Sloc (F_Type);
2437                            Error_Msg_NE
2438                              ("\?add Convention pragma to declaration of &#",
2439                               Formal, F_Type);
2440                         end if;
2441
2442                         Error_Msg_Qual_Level := 0;
2443                      end if;
2444
2445                      --  Check for unconstrained array in exported foreign
2446                      --  convention case.
2447
2448                      if Has_Foreign_Convention (E)
2449                        and then not Is_Imported (E)
2450                        and then Is_Array_Type (F_Type)
2451                        and then not Is_Constrained (F_Type)
2452                        and then Warn_On_Export_Import
2453                      then
2454                         Error_Msg_Qual_Level := 1;
2455
2456                         --  If this is an inherited operation, place the
2457                         --  warning on the derived type declaration, rather
2458                         --  than on the original subprogram.
2459
2460                         if Nkind (Original_Node (Parent (E))) =
2461                           N_Full_Type_Declaration
2462                         then
2463                            Warn_Node := Parent (E);
2464
2465                            if Formal = First_Formal (E) then
2466                               Error_Msg_NE
2467                                 ("?in inherited operation&", Warn_Node, E);
2468                            end if;
2469                         else
2470                            Warn_Node := Formal;
2471                         end if;
2472
2473                         Error_Msg_NE
2474                           ("?type of argument& is unconstrained array",
2475                            Warn_Node, Formal);
2476                         Error_Msg_NE
2477                           ("?foreign caller must pass bounds explicitly",
2478                            Warn_Node, Formal);
2479                         Error_Msg_Qual_Level := 0;
2480                      end if;
2481
2482                      --  Ada 2005 (AI-326): Check wrong use of tag incomplete
2483                      --  types with unknown discriminants. For example:
2484
2485                      --    type T (<>) is tagged;
2486                      --    procedure P (X : access T); -- ERROR
2487                      --    procedure P (X : T);        -- ERROR
2488
2489                      if not From_With_Type (F_Type) then
2490                         if Is_Access_Type (F_Type) then
2491                            F_Type := Designated_Type (F_Type);
2492                         end if;
2493
2494                         if Ekind (F_Type) = E_Incomplete_Type
2495                           and then Is_Tagged_Type (F_Type)
2496                           and then not Is_Class_Wide_Type (F_Type)
2497                           and then No (Full_View (F_Type))
2498                           and then Unknown_Discriminants_Present
2499                                      (Parent (F_Type))
2500                           and then No (Stored_Constraint (F_Type))
2501                         then
2502                            Error_Msg_N
2503                              ("(Ada 2005): invalid use of unconstrained tagged"
2504                               & " incomplete type", E);
2505
2506                         --  If the formal is an anonymous_access_to_subprogram
2507                         --  freeze the  subprogram type as well, to prevent
2508                         --  scope anomalies in gigi, because there is no other
2509                         --  clear point at which it could be frozen.
2510
2511                         elsif Is_Itype (Etype (Formal))
2512                           and then Ekind (F_Type) = E_Subprogram_Type
2513                         then
2514                            Freeze_And_Append (F_Type, Loc, Result);
2515                         end if;
2516                      end if;
2517
2518                      Next_Formal (Formal);
2519                   end loop;
2520
2521                   --  Case of function
2522
2523                   if Ekind (E) = E_Function then
2524
2525                      --  Freeze return type
2526
2527                      R_Type := Etype (E);
2528                      Freeze_And_Append (R_Type, Loc, Result);
2529
2530                      --  Check suspicious return type for C function
2531
2532                      if Warn_On_Export_Import
2533                        and then (Convention (E) = Convention_C
2534                                    or else
2535                                  Convention (E) = Convention_CPP)
2536                        and then (Is_Imported (E) or else Is_Exported (E))
2537                      then
2538                         --  Check suspicious return of fat C pointer
2539
2540                         if Is_Access_Type (R_Type)
2541                           and then Esize (R_Type) > Ttypes.System_Address_Size
2542                           and then not Has_Warnings_Off (E)
2543                           and then not Has_Warnings_Off (R_Type)
2544                         then
2545                            Error_Msg_N
2546                              ("?return type of& does not "
2547                               & "correspond to C pointer!", E);
2548
2549                         --  Check suspicious return of boolean
2550
2551                         elsif Root_Type (R_Type) = Standard_Boolean
2552                           and then Convention (R_Type) = Convention_Ada
2553                           and then not Has_Warnings_Off (E)
2554                           and then not Has_Warnings_Off (R_Type)
2555                           and then not Has_Size_Clause (R_Type)
2556                         then
2557                            Error_Msg_N
2558                              ("?return type of & is an 8-bit "
2559                               & "Ada Boolean, use char in C!", E);
2560
2561                         --  Check suspicious return tagged type
2562
2563                         elsif (Is_Tagged_Type (R_Type)
2564                                 or else (Is_Access_Type (R_Type)
2565                                            and then
2566                                              Is_Tagged_Type
2567                                                (Designated_Type (R_Type))))
2568                           and then Convention (E) = Convention_C
2569                           and then not Has_Warnings_Off (E)
2570                           and then not Has_Warnings_Off (R_Type)
2571                         then
2572                            Error_Msg_N
2573                              ("?return type of & does not "
2574                               & "correspond to C type!", E);
2575
2576                         --  Check return of wrong convention subprogram pointer
2577
2578                         elsif Ekind (R_Type) = E_Access_Subprogram_Type
2579                           and then not Has_Foreign_Convention (R_Type)
2580                           and then not Has_Warnings_Off (E)
2581                           and then not Has_Warnings_Off (R_Type)
2582                         then
2583                            Error_Msg_N
2584                              ("?& should return a foreign "
2585                               & "convention subprogram pointer", E);
2586                            Error_Msg_Sloc := Sloc (R_Type);
2587                            Error_Msg_NE
2588                              ("\?add Convention pragma to declaration of& #",
2589                               E, R_Type);
2590                         end if;
2591                      end if;
2592
2593                      if Is_Array_Type (Etype (E))
2594                        and then not Is_Constrained (Etype (E))
2595                        and then not Is_Imported (E)
2596                        and then Has_Foreign_Convention (E)
2597                        and then Warn_On_Export_Import
2598                        and then not Has_Warnings_Off (E)
2599                        and then not Has_Warnings_Off (Etype (E))
2600                      then
2601                         Error_Msg_N
2602                           ("?foreign convention function& should not " &
2603                            "return unconstrained array!", E);
2604
2605                      --  Ada 2005 (AI-326): Check wrong use of tagged
2606                      --  incomplete type
2607
2608                      --    type T is tagged;
2609                      --    function F (X : Boolean) return T; -- ERROR
2610
2611                      --  The type must be declared in the current scope for the
2612                      --  use to be legal, and the full view must be available
2613                      --  when the construct that mentions it is frozen.
2614
2615                      elsif Ekind (Etype (E)) = E_Incomplete_Type
2616                        and then Is_Tagged_Type (Etype (E))
2617                        and then No (Full_View (Etype (E)))
2618                        and then not Is_Value_Type (Etype (E))
2619                      then
2620                         Error_Msg_N
2621                           ("(Ada 2005): invalid use of tagged incomplete type",
2622                             E);
2623                      end if;
2624                   end if;
2625                end;
2626             end if;
2627
2628             --  Must freeze its parent first if it is a derived subprogram
2629
2630             if Present (Alias (E)) then
2631                Freeze_And_Append (Alias (E), Loc, Result);
2632             end if;
2633
2634             --  We don't freeze internal subprograms, because we don't normally
2635             --  want addition of extra formals or mechanism setting to happen
2636             --  for those. However we do pass through predefined dispatching
2637             --  cases, since extra formals may be needed in some cases, such as
2638             --  for the stream 'Input function (build-in-place formals).
2639
2640             if not Is_Internal (E)
2641               or else Is_Predefined_Dispatching_Operation (E)
2642             then
2643                Freeze_Subprogram (E);
2644             end if;
2645
2646          --  Here for other than a subprogram or type
2647
2648          else
2649             --  For a generic package, freeze types within, so that proper
2650             --  cross-reference information is generated for tagged types.
2651             --  This is the only freeze processing needed for generic packages.
2652
2653             if Ekind (E) = E_Generic_Package then
2654                declare
2655                   T : Entity_Id;
2656
2657                begin
2658                   T := First_Entity (E);
2659                   while Present (T) loop
2660                      if Is_Type (T) then
2661                         Generate_Prim_Op_References (T);
2662                      end if;
2663
2664                      Next_Entity (T);
2665                   end loop;
2666                end;
2667
2668             --  If entity has a type, and it is not a generic unit, then
2669             --  freeze it first (RM 13.14(10)).
2670
2671             elsif Present (Etype (E))
2672               and then Ekind (E) /= E_Generic_Function
2673             then
2674                Freeze_And_Append (Etype (E), Loc, Result);
2675             end if;
2676
2677             --  Special processing for objects created by object declaration
2678
2679             if Nkind (Declaration_Node (E)) = N_Object_Declaration then
2680
2681                --  For object created by object declaration, perform required
2682                --  categorization (preelaborate and pure) checks. Defer these
2683                --  checks to freeze time since pragma Import inhibits default
2684                --  initialization and thus pragma Import affects these checks.
2685
2686                Validate_Object_Declaration (Declaration_Node (E));
2687
2688                --  If there is an address clause, check that it is valid
2689
2690                Check_Address_Clause (E);
2691
2692                --  If the object needs any kind of default initialization, an
2693                --  error must be issued if No_Default_Initialization applies.
2694                --  The check doesn't apply to imported objects, which are not
2695                --  ever default initialized, and is why the check is deferred
2696                --  until freezing, at which point we know if Import applies.
2697                --  Deferred constants are also exempted from this test because
2698                --  their completion is explicit, or through an import pragma.
2699
2700                if Ekind (E) = E_Constant
2701                  and then Present (Full_View (E))
2702                then
2703                   null;
2704
2705                elsif Comes_From_Source (E)
2706                  and then not Is_Imported (E)
2707                  and then not Has_Init_Expression (Declaration_Node (E))
2708                  and then
2709                    ((Has_Non_Null_Base_Init_Proc (Etype (E))
2710                       and then not No_Initialization (Declaration_Node (E))
2711                       and then not Is_Value_Type (Etype (E))
2712                       and then not Suppress_Init_Proc (Etype (E)))
2713                     or else
2714                       (Needs_Simple_Initialization (Etype (E))
2715                         and then not Is_Internal (E)))
2716                then
2717                   Check_Restriction
2718                     (No_Default_Initialization, Declaration_Node (E));
2719                end if;
2720
2721                --  For imported objects, set Is_Public unless there is also an
2722                --  address clause, which means that there is no external symbol
2723                --  needed for the Import (Is_Public may still be set for other
2724                --  unrelated reasons). Note that we delayed this processing
2725                --  till freeze time so that we can be sure not to set the flag
2726                --  if there is an address clause. If there is such a clause,
2727                --  then the only purpose of the Import pragma is to suppress
2728                --  implicit initialization.
2729
2730                if Is_Imported (E)
2731                  and then No (Address_Clause (E))
2732                then
2733                   Set_Is_Public (E);
2734                end if;
2735
2736                --  For convention C objects of an enumeration type, warn if
2737                --  the size is not integer size and no explicit size given.
2738                --  Skip warning for Boolean, and Character, assume programmer
2739                --  expects 8-bit sizes for these cases.
2740
2741                if (Convention (E) = Convention_C
2742                     or else
2743                    Convention (E) = Convention_CPP)
2744                  and then Is_Enumeration_Type (Etype (E))
2745                  and then not Is_Character_Type (Etype (E))
2746                  and then not Is_Boolean_Type (Etype (E))
2747                  and then Esize (Etype (E)) < Standard_Integer_Size
2748                  and then not Has_Size_Clause (E)
2749                then
2750                   Error_Msg_Uint_1 := UI_From_Int (Standard_Integer_Size);
2751                   Error_Msg_N
2752                     ("?convention C enumeration object has size less than ^",
2753                      E);
2754                   Error_Msg_N ("\?use explicit size clause to set size", E);
2755                end if;
2756             end if;
2757
2758             --  Check that a constant which has a pragma Volatile[_Components]
2759             --  or Atomic[_Components] also has a pragma Import (RM C.6(13)).
2760
2761             --  Note: Atomic[_Components] also sets Volatile[_Components]
2762
2763             if Ekind (E) = E_Constant
2764               and then (Has_Volatile_Components (E) or else Is_Volatile (E))
2765               and then not Is_Imported (E)
2766             then
2767                --  Make sure we actually have a pragma, and have not merely
2768                --  inherited the indication from elsewhere (e.g. an address
2769                --  clause, which is not good enough in RM terms!)
2770
2771                if Has_Rep_Pragma (E, Name_Atomic)
2772                     or else
2773                   Has_Rep_Pragma (E, Name_Atomic_Components)
2774                then
2775                   Error_Msg_N
2776                     ("stand alone atomic constant must be " &
2777                      "imported (RM C.6(13))", E);
2778
2779                elsif Has_Rep_Pragma (E, Name_Volatile)
2780                        or else
2781                      Has_Rep_Pragma (E, Name_Volatile_Components)
2782                then
2783                   Error_Msg_N
2784                     ("stand alone volatile constant must be " &
2785                      "imported (RM C.6(13))", E);
2786                end if;
2787             end if;
2788
2789             --  Static objects require special handling
2790
2791             if (Ekind (E) = E_Constant or else Ekind (E) = E_Variable)
2792               and then Is_Statically_Allocated (E)
2793             then
2794                Freeze_Static_Object (E);
2795             end if;
2796
2797             --  Remaining step is to layout objects
2798
2799             if Ekind (E) = E_Variable
2800                  or else
2801                Ekind (E) = E_Constant
2802                  or else
2803                Ekind (E) = E_Loop_Parameter
2804                  or else
2805                Is_Formal (E)
2806             then
2807                Layout_Object (E);
2808             end if;
2809          end if;
2810
2811       --  Case of a type or subtype being frozen
2812
2813       else
2814          --  We used to check here that a full type must have preelaborable
2815          --  initialization if it completes a private type specified with
2816          --  pragma Preelaborable_Intialization, but that missed cases where
2817          --  the types occur within a generic package, since the freezing
2818          --  that occurs within a containing scope generally skips traversal
2819          --  of a generic unit's declarations (those will be frozen within
2820          --  instances). This check was moved to Analyze_Package_Specification.
2821
2822          --  The type may be defined in a generic unit. This can occur when
2823          --  freezing a generic function that returns the type (which is
2824          --  defined in a parent unit). It is clearly meaningless to freeze
2825          --  this type. However, if it is a subtype, its size may be determi-
2826          --  nable and used in subsequent checks, so might as well try to
2827          --  compute it.
2828
2829          if Present (Scope (E))
2830            and then Is_Generic_Unit (Scope (E))
2831          then
2832             Check_Compile_Time_Size (E);
2833             return No_List;
2834          end if;
2835
2836          --  Deal with special cases of freezing for subtype
2837
2838          if E /= Base_Type (E) then
2839
2840             --  Before we do anything else, a specialized test for the case of
2841             --  a size given for an array where the array needs to be packed,
2842             --  but was not so the size cannot be honored. This would of course
2843             --  be caught by the backend, and indeed we don't catch all cases.
2844             --  The point is that we can give a better error message in those
2845             --  cases that we do catch with the circuitry here. Also if pragma
2846             --  Implicit_Packing is set, this is where the packing occurs.
2847
2848             --  The reason we do this so early is that the processing in the
2849             --  automatic packing case affects the layout of the base type, so
2850             --  it must be done before we freeze the base type.
2851
2852             if Is_Array_Type (E) then
2853                declare
2854                   Lo, Hi : Node_Id;
2855                   Ctyp   : constant Entity_Id := Component_Type (E);
2856
2857                begin
2858                   --  Check enabling conditions. These are straightforward
2859                   --  except for the test for a limited composite type. This
2860                   --  eliminates the rare case of a array of limited components
2861                   --  where there are issues of whether or not we can go ahead
2862                   --  and pack the array (since we can't freely pack and unpack
2863                   --  arrays if they are limited).
2864
2865                   --  Note that we check the root type explicitly because the
2866                   --  whole point is we are doing this test before we have had
2867                   --  a chance to freeze the base type (and it is that freeze
2868                   --  action that causes stuff to be inherited).
2869
2870                   if Present (Size_Clause (E))
2871                     and then Known_Static_Esize (E)
2872                     and then not Is_Packed (E)
2873                     and then not Has_Pragma_Pack (E)
2874                     and then Number_Dimensions (E) = 1
2875                     and then not Has_Component_Size_Clause (E)
2876                     and then Known_Static_Esize (Ctyp)
2877                     and then not Is_Limited_Composite (E)
2878                     and then not Is_Packed (Root_Type (E))
2879                     and then not Has_Component_Size_Clause (Root_Type (E))
2880                   then
2881                      Get_Index_Bounds (First_Index (E), Lo, Hi);
2882
2883                      if Compile_Time_Known_Value (Lo)
2884                        and then Compile_Time_Known_Value (Hi)
2885                        and then Known_Static_RM_Size (Ctyp)
2886                        and then RM_Size (Ctyp) < 64
2887                      then
2888                         declare
2889                            Lov  : constant Uint      := Expr_Value (Lo);
2890                            Hiv  : constant Uint      := Expr_Value (Hi);
2891                            Len  : constant Uint      := UI_Max
2892                                                          (Uint_0,
2893                                                           Hiv - Lov + 1);
2894                            Rsiz : constant Uint      := RM_Size (Ctyp);
2895                            SZ   : constant Node_Id   := Size_Clause (E);
2896                            Btyp : constant Entity_Id := Base_Type (E);
2897
2898                         --  What we are looking for here is the situation where
2899                         --  the RM_Size given would be exactly right if there
2900                         --  was a pragma Pack (resulting in the component size
2901                         --  being the same as the RM_Size). Furthermore, the
2902                         --  component type size must be an odd size (not a
2903                         --  multiple of storage unit)
2904
2905                         begin
2906                            if RM_Size (E) = Len * Rsiz
2907                              and then Rsiz mod System_Storage_Unit /= 0
2908                            then
2909                               --  For implicit packing mode, just set the
2910                               --  component size silently
2911
2912                               if Implicit_Packing then
2913                                  Set_Component_Size       (Btyp, Rsiz);
2914                                  Set_Is_Bit_Packed_Array  (Btyp);
2915                                  Set_Is_Packed            (Btyp);
2916                                  Set_Has_Non_Standard_Rep (Btyp);
2917
2918                                  --  Otherwise give an error message
2919
2920                               else
2921                                  Error_Msg_NE
2922                                    ("size given for& too small", SZ, E);
2923                                  Error_Msg_N
2924                                    ("\use explicit pragma Pack "
2925                                     & "or use pragma Implicit_Packing", SZ);
2926                               end if;
2927                            end if;
2928                         end;
2929                      end if;
2930                   end if;
2931                end;
2932             end if;
2933
2934             --  If ancestor subtype present, freeze that first. Note that this
2935             --  will also get the base type frozen.
2936
2937             Atype := Ancestor_Subtype (E);
2938
2939             if Present (Atype) then
2940                Freeze_And_Append (Atype, Loc, Result);
2941
2942             --  Otherwise freeze the base type of the entity before freezing
2943             --  the entity itself (RM 13.14(15)).
2944
2945             elsif E /= Base_Type (E) then
2946                Freeze_And_Append (Base_Type (E), Loc, Result);
2947             end if;
2948
2949          --  For a derived type, freeze its parent type first (RM 13.14(15))
2950
2951          elsif Is_Derived_Type (E) then
2952             Freeze_And_Append (Etype (E), Loc, Result);
2953             Freeze_And_Append (First_Subtype (Etype (E)), Loc, Result);
2954          end if;
2955
2956          --  For array type, freeze index types and component type first
2957          --  before freezing the array (RM 13.14(15)).
2958
2959          if Is_Array_Type (E) then
2960             declare
2961                Ctyp : constant Entity_Id := Component_Type (E);
2962
2963                Non_Standard_Enum : Boolean := False;
2964                --  Set true if any of the index types is an enumeration type
2965                --  with a non-standard representation.
2966
2967             begin
2968                Freeze_And_Append (Ctyp, Loc, Result);
2969
2970                Indx := First_Index (E);
2971                while Present (Indx) loop
2972                   Freeze_And_Append (Etype (Indx), Loc, Result);
2973
2974                   if Is_Enumeration_Type (Etype (Indx))
2975                     and then Has_Non_Standard_Rep (Etype (Indx))
2976                   then
2977                      Non_Standard_Enum := True;
2978                   end if;
2979
2980                   Next_Index (Indx);
2981                end loop;
2982
2983                --  Processing that is done only for base types
2984
2985                if Ekind (E) = E_Array_Type then
2986
2987                   --  Propagate flags for component type
2988
2989                   if Is_Controlled (Component_Type (E))
2990                     or else Has_Controlled_Component (Ctyp)
2991                   then
2992                      Set_Has_Controlled_Component (E);
2993                   end if;
2994
2995                   if Has_Unchecked_Union (Component_Type (E)) then
2996                      Set_Has_Unchecked_Union (E);
2997                   end if;
2998
2999                   --  If packing was requested or if the component size was set
3000                   --  explicitly, then see if bit packing is required. This
3001                   --  processing is only done for base types, since all the
3002                   --  representation aspects involved are type-related. This
3003                   --  is not just an optimization, if we start processing the
3004                   --  subtypes, they interfere with the settings on the base
3005                   --  type (this is because Is_Packed has a slightly different
3006                   --  meaning before and after freezing).
3007
3008                   declare
3009                      Csiz : Uint;
3010                      Esiz : Uint;
3011
3012                   begin
3013                      if (Is_Packed (E) or else Has_Pragma_Pack (E))
3014                        and then not Has_Atomic_Components (E)
3015                        and then Known_Static_RM_Size (Ctyp)
3016                      then
3017                         Csiz := UI_Max (RM_Size (Ctyp), 1);
3018
3019                      elsif Known_Component_Size (E) then
3020                         Csiz := Component_Size (E);
3021
3022                      elsif not Known_Static_Esize (Ctyp) then
3023                         Csiz := Uint_0;
3024
3025                      else
3026                         Esiz := Esize (Ctyp);
3027
3028                         --  We can set the component size if it is less than
3029                         --  16, rounding it up to the next storage unit size.
3030
3031                         if Esiz <= 8 then
3032                            Csiz := Uint_8;
3033                         elsif Esiz <= 16 then
3034                            Csiz := Uint_16;
3035                         else
3036                            Csiz := Uint_0;
3037                         end if;
3038
3039                         --  Set component size up to match alignment if it
3040                         --  would otherwise be less than the alignment. This
3041                         --  deals with cases of types whose alignment exceeds
3042                         --  their size (padded types).
3043
3044                         if Csiz /= 0 then
3045                            declare
3046                               A : constant Uint := Alignment_In_Bits (Ctyp);
3047                            begin
3048                               if Csiz < A then
3049                                  Csiz := A;
3050                               end if;
3051                            end;
3052                         end if;
3053                      end if;
3054
3055                      --  Case of component size that may result in packing
3056
3057                      if 1 <= Csiz and then Csiz <= 64 then
3058                         declare
3059                            Ent         : constant Entity_Id :=
3060                                            First_Subtype (E);
3061                            Pack_Pragma : constant Node_Id :=
3062                                            Get_Rep_Pragma (Ent, Name_Pack);
3063                            Comp_Size_C : constant Node_Id :=
3064