OSDN Git Service

493adf6ee168e24fd124a099875da5e604c7ee89
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / decl.c
1 /****************************************************************************
2  *                                                                          *
3  *                         GNAT COMPILER COMPONENTS                         *
4  *                                                                          *
5  *                                 D E C L                                  *
6  *                                                                          *
7  *                          C Implementation File                           *
8  *                                                                          *
9  *          Copyright (C) 1992-2010, Free Software Foundation, Inc.         *
10  *                                                                          *
11  * GNAT is free software;  you can  redistribute it  and/or modify it under *
12  * terms of the  GNU General Public License as published  by the Free Soft- *
13  * ware  Foundation;  either version 3,  or (at your option) any later ver- *
14  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
15  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
16  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
17  * for  more details.  You should have received a copy of the GNU General   *
18  * Public License along with GCC; see the file COPYING3.  If not see        *
19  * <http://www.gnu.org/licenses/>.                                          *
20  *                                                                          *
21  * GNAT was originally developed  by the GNAT team at  New York University. *
22  * Extensive contributions were provided by Ada Core Technologies Inc.      *
23  *                                                                          *
24  ****************************************************************************/
25
26 #include "config.h"
27 #include "system.h"
28 #include "coretypes.h"
29 #include "tm.h"
30 #include "tree.h"
31 #include "flags.h"
32 #include "toplev.h"
33 #include "ggc.h"
34 #include "target.h"
35 #include "expr.h"
36 #include "tree-inline.h"
37
38 #include "ada.h"
39 #include "types.h"
40 #include "atree.h"
41 #include "elists.h"
42 #include "namet.h"
43 #include "nlists.h"
44 #include "repinfo.h"
45 #include "snames.h"
46 #include "stringt.h"
47 #include "uintp.h"
48 #include "fe.h"
49 #include "sinfo.h"
50 #include "einfo.h"
51 #include "ada-tree.h"
52 #include "gigi.h"
53
54 #ifndef MAX_FIXED_MODE_SIZE
55 #define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode)
56 #endif
57
58 /* Convention_Stdcall should be processed in a specific way on Windows targets
59    only.  The macro below is a helper to avoid having to check for a Windows
60    specific attribute throughout this unit.  */
61
62 #if TARGET_DLLIMPORT_DECL_ATTRIBUTES
63 #define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
64 #else
65 #define Has_Stdcall_Convention(E) (0)
66 #endif
67
68 /* Stack realignment for functions with foreign conventions is provided on a
69    per back-end basis now, as it is handled by the prologue expanders and not
70    as part of the function's body any more.  It might be requested by way of a
71    dedicated function type attribute on the targets that support it.
72
73    We need a way to avoid setting the attribute on the targets that don't
74    support it and use FORCE_PREFERRED_STACK_BOUNDARY_IN_MAIN for this purpose.
75
76    It is defined on targets where the circuitry is available, and indicates
77    whether the realignment is needed for 'main'.  We use this to decide for
78    foreign subprograms as well.
79
80    It is not defined on targets where the circuitry is not implemented, and
81    we just never set the attribute in these cases.
82
83    Whether it is defined on all targets that would need it in theory is
84    not entirely clear.  We currently trust the base GCC settings for this
85    purpose.  */
86
87 #ifndef FORCE_PREFERRED_STACK_BOUNDARY_IN_MAIN
88 #define FORCE_PREFERRED_STACK_BOUNDARY_IN_MAIN 0
89 #endif
90
91 struct incomplete
92 {
93   struct incomplete *next;
94   tree old_type;
95   Entity_Id full_type;
96 };
97
98 /* These variables are used to defer recursively expanding incomplete types
99    while we are processing an array, a record or a subprogram type.  */
100 static int defer_incomplete_level = 0;
101 static struct incomplete *defer_incomplete_list;
102
103 /* This variable is used to delay expanding From_With_Type types until the
104    end of the spec.  */
105 static struct incomplete *defer_limited_with;
106
107 /* These variables are used to defer finalizing types.  The element of the
108    list is the TYPE_DECL associated with the type.  */
109 static int defer_finalize_level = 0;
110 static VEC (tree,heap) *defer_finalize_list;
111
112 /* A hash table used to cache the result of annotate_value.  */
113 static GTY ((if_marked ("tree_int_map_marked_p"),
114              param_is (struct tree_int_map))) htab_t annotate_value_cache;
115
116 enum alias_set_op
117 {
118   ALIAS_SET_COPY,
119   ALIAS_SET_SUBSET,
120   ALIAS_SET_SUPERSET
121 };
122
123 static void relate_alias_sets (tree, tree, enum alias_set_op);
124
125 static bool allocatable_size_p (tree, bool);
126 static void prepend_one_attribute_to (struct attrib **,
127                                       enum attr_type, tree, tree, Node_Id);
128 static void prepend_attributes (Entity_Id, struct attrib **);
129 static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
130 static bool is_variable_size (tree);
131 static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);
132 static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool,
133                                     unsigned int);
134 static tree make_packable_type (tree, bool);
135 static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);
136 static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
137                                bool *);
138 static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool);
139 static bool same_discriminant_p (Entity_Id, Entity_Id);
140 static bool array_type_has_nonaliased_component (tree, Entity_Id);
141 static bool compile_time_known_address_p (Node_Id);
142 static bool cannot_be_superflat_p (Node_Id);
143 static bool constructor_address_p (tree);
144 static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
145                                   bool, bool, bool, bool, bool);
146 static Uint annotate_value (tree);
147 static void annotate_rep (Entity_Id, tree);
148 static tree build_position_list (tree, bool, tree, tree, unsigned int, tree);
149 static tree build_subst_list (Entity_Id, Entity_Id, bool);
150 static tree build_variant_list (tree, tree, tree);
151 static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
152 static void set_rm_size (Uint, tree, Entity_Id);
153 static tree make_type_from_size (tree, tree, bool);
154 static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
155 static unsigned int ceil_alignment (unsigned HOST_WIDE_INT);
156 static void check_ok_for_atomic (tree, Entity_Id, bool);
157 static int compatible_signatures_p (tree, tree);
158 static tree create_field_decl_from (tree, tree, tree, tree, tree, tree);
159 static tree get_rep_part (tree);
160 static tree get_variant_part (tree);
161 static tree create_variant_part_from (tree, tree, tree, tree, tree);
162 static void copy_and_substitute_in_size (tree, tree, tree);
163 static void rest_of_type_decl_compilation_no_defer (tree);
164 \f
165 /* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada
166    entity, return the equivalent GCC tree for that entity (a ..._DECL node)
167    and associate the ..._DECL node with the input GNAT defining identifier.
168
169    If GNAT_ENTITY is a variable or a constant declaration, GNU_EXPR gives its
170    initial value (in GCC tree form).  This is optional for a variable.  For
171    a renamed entity, GNU_EXPR gives the object being renamed.
172
173    DEFINITION is nonzero if this call is intended for a definition.  This is
174    used for separate compilation where it is necessary to know whether an
175    external declaration or a definition must be created if the GCC equivalent
176    was not created previously.  The value of 1 is normally used for a nonzero
177    DEFINITION, but a value of 2 is used in special circumstances, defined in
178    the code.  */
179
180 tree
181 gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
182 {
183   /* Contains the kind of the input GNAT node.  */
184   const Entity_Kind kind = Ekind (gnat_entity);
185   /* True if this is a type.  */
186   const bool is_type = IN (kind, Type_Kind);
187   /* True if debug info is requested for this entity.  */
188   const bool debug_info_p = Needs_Debug_Info (gnat_entity);
189   /* True if this entity is to be considered as imported.  */
190   const bool imported_p
191     = (Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity)));
192   /* For a type, contains the equivalent GNAT node to be used in gigi.  */
193   Entity_Id gnat_equiv_type = Empty;
194   /* Temporary used to walk the GNAT tree.  */
195   Entity_Id gnat_temp;
196   /* Contains the GCC DECL node which is equivalent to the input GNAT node.
197      This node will be associated with the GNAT node by calling at the end
198      of the `switch' statement.  */
199   tree gnu_decl = NULL_TREE;
200   /* Contains the GCC type to be used for the GCC node.  */
201   tree gnu_type = NULL_TREE;
202   /* Contains the GCC size tree to be used for the GCC node.  */
203   tree gnu_size = NULL_TREE;
204   /* Contains the GCC name to be used for the GCC node.  */
205   tree gnu_entity_name;
206   /* True if we have already saved gnu_decl as a GNAT association.  */
207   bool saved = false;
208   /* True if we incremented defer_incomplete_level.  */
209   bool this_deferred = false;
210   /* True if we incremented force_global.  */
211   bool this_global = false;
212   /* True if we should check to see if elaborated during processing.  */
213   bool maybe_present = false;
214   /* True if we made GNU_DECL and its type here.  */
215   bool this_made_decl = false;
216   /* Size and alignment of the GCC node, if meaningful.  */
217   unsigned int esize = 0, align = 0;
218   /* Contains the list of attributes directly attached to the entity.  */
219   struct attrib *attr_list = NULL;
220
221   /* Since a use of an Itype is a definition, process it as such if it
222      is not in a with'ed unit.  */
223   if (!definition
224       && is_type
225       && Is_Itype (gnat_entity)
226       && !present_gnu_tree (gnat_entity)
227       && In_Extended_Main_Code_Unit (gnat_entity))
228     {
229       /* Ensure that we are in a subprogram mentioned in the Scope chain of
230          this entity, our current scope is global, or we encountered a task
231          or entry (where we can't currently accurately check scoping).  */
232       if (!current_function_decl
233           || DECL_ELABORATION_PROC_P (current_function_decl))
234         {
235           process_type (gnat_entity);
236           return get_gnu_tree (gnat_entity);
237         }
238
239       for (gnat_temp = Scope (gnat_entity);
240            Present (gnat_temp);
241            gnat_temp = Scope (gnat_temp))
242         {
243           if (Is_Type (gnat_temp))
244             gnat_temp = Underlying_Type (gnat_temp);
245
246           if (Ekind (gnat_temp) == E_Subprogram_Body)
247             gnat_temp
248               = Corresponding_Spec (Parent (Declaration_Node (gnat_temp)));
249
250           if (IN (Ekind (gnat_temp), Subprogram_Kind)
251               && Present (Protected_Body_Subprogram (gnat_temp)))
252             gnat_temp = Protected_Body_Subprogram (gnat_temp);
253
254           if (Ekind (gnat_temp) == E_Entry
255               || Ekind (gnat_temp) == E_Entry_Family
256               || Ekind (gnat_temp) == E_Task_Type
257               || (IN (Ekind (gnat_temp), Subprogram_Kind)
258                   && present_gnu_tree (gnat_temp)
259                   && (current_function_decl
260                       == gnat_to_gnu_entity (gnat_temp, NULL_TREE, 0))))
261             {
262               process_type (gnat_entity);
263               return get_gnu_tree (gnat_entity);
264             }
265         }
266
267       /* This abort means the Itype has an incorrect scope, i.e. that its
268          scope does not correspond to the subprogram it is declared in.  */
269       gcc_unreachable ();
270     }
271
272   /* If we've already processed this entity, return what we got last time.
273      If we are defining the node, we should not have already processed it.
274      In that case, we will abort below when we try to save a new GCC tree
275      for this object.  We also need to handle the case of getting a dummy
276      type when a Full_View exists.  */
277   if ((!definition || (is_type && imported_p))
278       && present_gnu_tree (gnat_entity))
279     {
280       gnu_decl = get_gnu_tree (gnat_entity);
281
282       if (TREE_CODE (gnu_decl) == TYPE_DECL
283           && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
284           && IN (kind, Incomplete_Or_Private_Kind)
285           && Present (Full_View (gnat_entity)))
286         {
287           gnu_decl
288             = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0);
289           save_gnu_tree (gnat_entity, NULL_TREE, false);
290           save_gnu_tree (gnat_entity, gnu_decl, false);
291         }
292
293       return gnu_decl;
294     }
295
296   /* If this is a numeric or enumeral type, or an access type, a nonzero
297      Esize must be specified unless it was specified by the programmer.  */
298   gcc_assert (!Unknown_Esize (gnat_entity)
299               || Has_Size_Clause (gnat_entity)
300               || (!IN (kind, Numeric_Kind)
301                   && !IN (kind, Enumeration_Kind)
302                   && (!IN (kind, Access_Kind)
303                       || kind == E_Access_Protected_Subprogram_Type
304                       || kind == E_Anonymous_Access_Protected_Subprogram_Type
305                       || kind == E_Access_Subtype)));
306
307   /* The RM size must be specified for all discrete and fixed-point types.  */
308   gcc_assert (!(IN (kind, Discrete_Or_Fixed_Point_Kind)
309                 && Unknown_RM_Size (gnat_entity)));
310
311   /* If we get here, it means we have not yet done anything with this entity.
312      If we are not defining it, it must be a type or an entity that is defined
313      elsewhere or externally, otherwise we should have defined it already.  */
314   gcc_assert (definition
315               || type_annotate_only
316               || is_type
317               || kind == E_Discriminant
318               || kind == E_Component
319               || kind == E_Label
320               || (kind == E_Constant && Present (Full_View (gnat_entity)))
321               || Is_Public (gnat_entity));
322
323   /* Get the name of the entity and set up the line number and filename of
324      the original definition for use in any decl we make.  */
325   gnu_entity_name = get_entity_name (gnat_entity);
326   Sloc_to_locus (Sloc (gnat_entity), &input_location);
327
328   /* For cases when we are not defining (i.e., we are referencing from
329      another compilation unit) public entities, show we are at global level
330      for the purpose of computing scopes.  Don't do this for components or
331      discriminants since the relevant test is whether or not the record is
332      being defined.  */
333   if (!definition
334       && kind != E_Component
335       && kind != E_Discriminant
336       && Is_Public (gnat_entity)
337       && !Is_Statically_Allocated (gnat_entity))
338     force_global++, this_global = true;
339
340   /* Handle any attributes directly attached to the entity.  */
341   if (Has_Gigi_Rep_Item (gnat_entity))
342     prepend_attributes (gnat_entity, &attr_list);
343
344   /* Do some common processing for types.  */
345   if (is_type)
346     {
347       /* Compute the equivalent type to be used in gigi.  */
348       gnat_equiv_type = Gigi_Equivalent_Type (gnat_entity);
349
350       /* Machine_Attributes on types are expected to be propagated to
351          subtypes.  The corresponding Gigi_Rep_Items are only attached
352          to the first subtype though, so we handle the propagation here.  */
353       if (Base_Type (gnat_entity) != gnat_entity
354           && !Is_First_Subtype (gnat_entity)
355           && Has_Gigi_Rep_Item (First_Subtype (Base_Type (gnat_entity))))
356         prepend_attributes (First_Subtype (Base_Type (gnat_entity)),
357                             &attr_list);
358
359       /* Compute a default value for the size of the type.  */
360       if (Known_Esize (gnat_entity)
361           && UI_Is_In_Int_Range (Esize (gnat_entity)))
362         {
363           unsigned int max_esize;
364           esize = UI_To_Int (Esize (gnat_entity));
365
366           if (IN (kind, Float_Kind))
367             max_esize = fp_prec_to_size (LONG_DOUBLE_TYPE_SIZE);
368           else if (IN (kind, Access_Kind))
369             max_esize = POINTER_SIZE * 2;
370           else
371             max_esize = LONG_LONG_TYPE_SIZE;
372
373           if (esize > max_esize)
374            esize = max_esize;
375         }
376       else
377         esize = LONG_LONG_TYPE_SIZE;
378     }
379
380   switch (kind)
381     {
382     case E_Constant:
383       /* If this is a use of a deferred constant without address clause,
384          get its full definition.  */
385       if (!definition
386           && No (Address_Clause (gnat_entity))
387           && Present (Full_View (gnat_entity)))
388         {
389           gnu_decl
390             = gnat_to_gnu_entity (Full_View (gnat_entity), gnu_expr, 0);
391           saved = true;
392           break;
393         }
394
395       /* If we have an external constant that we are not defining, get the
396          expression that is was defined to represent.  We may throw that
397          expression away later if it is not a constant.  Do not retrieve the
398          expression if it is an aggregate or allocator, because in complex
399          instantiation contexts it may not be expanded  */
400       if (!definition
401           && Present (Expression (Declaration_Node (gnat_entity)))
402           && !No_Initialization (Declaration_Node (gnat_entity))
403           && (Nkind (Expression (Declaration_Node (gnat_entity)))
404               != N_Aggregate)
405           && (Nkind (Expression (Declaration_Node (gnat_entity)))
406               != N_Allocator))
407         gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity)));
408
409       /* Ignore deferred constant definitions without address clause since
410          they are processed fully in the front-end.  If No_Initialization
411          is set, this is not a deferred constant but a constant whose value
412          is built manually.  And constants that are renamings are handled
413          like variables.  */
414       if (definition
415           && !gnu_expr
416           && No (Address_Clause (gnat_entity))
417           && !No_Initialization (Declaration_Node (gnat_entity))
418           && No (Renamed_Object (gnat_entity)))
419         {
420           gnu_decl = error_mark_node;
421           saved = true;
422           break;
423         }
424
425       /* Ignore constant definitions already marked with the error node.  See
426          the N_Object_Declaration case of gnat_to_gnu for the rationale.  */
427       if (definition
428           && gnu_expr
429           && present_gnu_tree (gnat_entity)
430           && get_gnu_tree (gnat_entity) == error_mark_node)
431         {
432           maybe_present = true;
433           break;
434         }
435
436       goto object;
437
438     case E_Exception:
439       /* We used to special case VMS exceptions here to directly map them to
440          their associated condition code.  Since this code had to be masked
441          dynamically to strip off the severity bits, this caused trouble in
442          the GCC/ZCX case because the "type" pointers we store in the tables
443          have to be static.  We now don't special case here anymore, and let
444          the regular processing take place, which leaves us with a regular
445          exception data object for VMS exceptions too.  The condition code
446          mapping is taken care of by the front end and the bitmasking by the
447          runtime library.  */
448       goto object;
449
450     case E_Discriminant:
451     case E_Component:
452       {
453         /* The GNAT record where the component was defined.  */
454         Entity_Id gnat_record = Underlying_Type (Scope (gnat_entity));
455
456         /* If the variable is an inherited record component (in the case of
457            extended record types), just return the inherited entity, which
458            must be a FIELD_DECL.  Likewise for discriminants.
459            For discriminants of untagged records which have explicit
460            stored discriminants, return the entity for the corresponding
461            stored discriminant.  Also use Original_Record_Component
462            if the record has a private extension.  */
463         if (Present (Original_Record_Component (gnat_entity))
464             && Original_Record_Component (gnat_entity) != gnat_entity)
465           {
466             gnu_decl
467               = gnat_to_gnu_entity (Original_Record_Component (gnat_entity),
468                                     gnu_expr, definition);
469             saved = true;
470             break;
471           }
472
473         /* If the enclosing record has explicit stored discriminants,
474            then it is an untagged record.  If the Corresponding_Discriminant
475            is not empty then this must be a renamed discriminant and its
476            Original_Record_Component must point to the corresponding explicit
477            stored discriminant (i.e. we should have taken the previous
478            branch).  */
479         else if (Present (Corresponding_Discriminant (gnat_entity))
480                  && Is_Tagged_Type (gnat_record))
481           {
482             /* A tagged record has no explicit stored discriminants.  */
483             gcc_assert (First_Discriminant (gnat_record)
484                        == First_Stored_Discriminant (gnat_record));
485             gnu_decl
486               = gnat_to_gnu_entity (Corresponding_Discriminant (gnat_entity),
487                                     gnu_expr, definition);
488             saved = true;
489             break;
490           }
491
492         else if (Present (CR_Discriminant (gnat_entity))
493                  && type_annotate_only)
494           {
495             gnu_decl = gnat_to_gnu_entity (CR_Discriminant (gnat_entity),
496                                            gnu_expr, definition);
497             saved = true;
498             break;
499           }
500
501         /* If the enclosing record has explicit stored discriminants, then
502            it is an untagged record.  If the Corresponding_Discriminant
503            is not empty then this must be a renamed discriminant and its
504            Original_Record_Component must point to the corresponding explicit
505            stored discriminant (i.e. we should have taken the first
506            branch).  */
507         else if (Present (Corresponding_Discriminant (gnat_entity))
508                  && (First_Discriminant (gnat_record)
509                      != First_Stored_Discriminant (gnat_record)))
510           gcc_unreachable ();
511
512         /* Otherwise, if we are not defining this and we have no GCC type
513            for the containing record, make one for it.  Then we should
514            have made our own equivalent.  */
515         else if (!definition && !present_gnu_tree (gnat_record))
516           {
517             /* ??? If this is in a record whose scope is a protected
518                type and we have an Original_Record_Component, use it.
519                This is a workaround for major problems in protected type
520                handling.  */
521             Entity_Id Scop = Scope (Scope (gnat_entity));
522             if ((Is_Protected_Type (Scop)
523                  || (Is_Private_Type (Scop)
524                      && Present (Full_View (Scop))
525                      && Is_Protected_Type (Full_View (Scop))))
526                 && Present (Original_Record_Component (gnat_entity)))
527               {
528                 gnu_decl
529                   = gnat_to_gnu_entity (Original_Record_Component
530                                         (gnat_entity),
531                                         gnu_expr, 0);
532                 saved = true;
533                 break;
534               }
535
536             gnat_to_gnu_entity (Scope (gnat_entity), NULL_TREE, 0);
537             gnu_decl = get_gnu_tree (gnat_entity);
538             saved = true;
539             break;
540           }
541
542         else
543           /* Here we have no GCC type and this is a reference rather than a
544              definition.  This should never happen.  Most likely the cause is
545              reference before declaration in the gnat tree for gnat_entity.  */
546           gcc_unreachable ();
547       }
548
549     case E_Loop_Parameter:
550     case E_Out_Parameter:
551     case E_Variable:
552
553       /* Simple variables, loop variables, Out parameters and exceptions.  */
554     object:
555       {
556         bool const_flag
557           = ((kind == E_Constant || kind == E_Variable)
558              && Is_True_Constant (gnat_entity)
559              && !Treat_As_Volatile (gnat_entity)
560              && (((Nkind (Declaration_Node (gnat_entity))
561                    == N_Object_Declaration)
562                   && Present (Expression (Declaration_Node (gnat_entity))))
563                  || Present (Renamed_Object (gnat_entity))
564                  || imported_p));
565         bool inner_const_flag = const_flag;
566         bool static_p = Is_Statically_Allocated (gnat_entity);
567         bool mutable_p = false;
568         bool used_by_ref = false;
569         tree gnu_ext_name = NULL_TREE;
570         tree renamed_obj = NULL_TREE;
571         tree gnu_object_size;
572
573         if (Present (Renamed_Object (gnat_entity)) && !definition)
574           {
575             if (kind == E_Exception)
576               gnu_expr = gnat_to_gnu_entity (Renamed_Entity (gnat_entity),
577                                              NULL_TREE, 0);
578             else
579               gnu_expr = gnat_to_gnu (Renamed_Object (gnat_entity));
580           }
581
582         /* Get the type after elaborating the renamed object.  */
583         gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
584
585         /* If this is a standard exception definition, then use the standard
586            exception type.  This is necessary to make sure that imported and
587            exported views of exceptions are properly merged in LTO mode.  */
588         if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL
589             && DECL_NAME (TYPE_NAME (gnu_type)) == exception_data_name_id)
590           gnu_type = except_type_node;
591
592         /* For a debug renaming declaration, build a pure debug entity.  */
593         if (Present (Debug_Renaming_Link (gnat_entity)))
594           {
595             rtx addr;
596             gnu_decl = build_decl (input_location,
597                                    VAR_DECL, gnu_entity_name, gnu_type);
598             /* The (MEM (CONST (0))) pattern is prescribed by STABS.  */
599             if (global_bindings_p ())
600               addr = gen_rtx_CONST (VOIDmode, const0_rtx);
601             else
602               addr = stack_pointer_rtx;
603             SET_DECL_RTL (gnu_decl, gen_rtx_MEM (Pmode, addr));
604             gnat_pushdecl (gnu_decl, gnat_entity);
605             break;
606           }
607
608         /* If this is a loop variable, its type should be the base type.
609            This is because the code for processing a loop determines whether
610            a normal loop end test can be done by comparing the bounds of the
611            loop against those of the base type, which is presumed to be the
612            size used for computation.  But this is not correct when the size
613            of the subtype is smaller than the type.  */
614         if (kind == E_Loop_Parameter)
615           gnu_type = get_base_type (gnu_type);
616
617         /* Reject non-renamed objects whose type is an unconstrained array or
618            any object whose type is a dummy type or void.  */
619         if ((TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
620              && No (Renamed_Object (gnat_entity)))
621             || TYPE_IS_DUMMY_P (gnu_type)
622             || TREE_CODE (gnu_type) == VOID_TYPE)
623           {
624             gcc_assert (type_annotate_only);
625             if (this_global)
626               force_global--;
627             return error_mark_node;
628           }
629
630         /* If an alignment is specified, use it if valid.  Note that exceptions
631            are objects but don't have an alignment.  We must do this before we
632            validate the size, since the alignment can affect the size.  */
633         if (kind != E_Exception && Known_Alignment (gnat_entity))
634           {
635             gcc_assert (Present (Alignment (gnat_entity)));
636             align = validate_alignment (Alignment (gnat_entity), gnat_entity,
637                                         TYPE_ALIGN (gnu_type));
638
639             /* No point in changing the type if there is an address clause
640                as the final type of the object will be a reference type.  */
641             if (Present (Address_Clause (gnat_entity)))
642               align = 0;
643             else
644               gnu_type
645                 = maybe_pad_type (gnu_type, NULL_TREE, align, gnat_entity,
646                                   false, false, definition, true);
647           }
648
649         /* If we are defining the object, see if it has a Size and validate it
650            if so.  If we are not defining the object and a Size clause applies,
651            simply retrieve the value.  We don't want to ignore the clause and
652            it is expected to have been validated already.  Then get the new
653            type, if any.  */
654         if (definition)
655           gnu_size = validate_size (Esize (gnat_entity), gnu_type,
656                                     gnat_entity, VAR_DECL, false,
657                                     Has_Size_Clause (gnat_entity));
658         else if (Has_Size_Clause (gnat_entity))
659           gnu_size = UI_To_gnu (Esize (gnat_entity), bitsizetype);
660
661         if (gnu_size)
662           {
663             gnu_type
664               = make_type_from_size (gnu_type, gnu_size,
665                                      Has_Biased_Representation (gnat_entity));
666
667             if (operand_equal_p (TYPE_SIZE (gnu_type), gnu_size, 0))
668               gnu_size = NULL_TREE;
669           }
670
671         /* If this object has self-referential size, it must be a record with
672            a default discriminant.  We are supposed to allocate an object of
673            the maximum size in this case, unless it is a constant with an
674            initializing expression, in which case we can get the size from
675            that.  Note that the resulting size may still be a variable, so
676            this may end up with an indirect allocation.  */
677         if (No (Renamed_Object (gnat_entity))
678             && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
679           {
680             if (gnu_expr && kind == E_Constant)
681               {
682                 tree size = TYPE_SIZE (TREE_TYPE (gnu_expr));
683                 if (CONTAINS_PLACEHOLDER_P (size))
684                   {
685                     /* If the initializing expression is itself a constant,
686                        despite having a nominal type with self-referential
687                        size, we can get the size directly from it.  */
688                     if (TREE_CODE (gnu_expr) == COMPONENT_REF
689                         && TYPE_IS_PADDING_P
690                            (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))
691                         && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == VAR_DECL
692                         && (TREE_READONLY (TREE_OPERAND (gnu_expr, 0))
693                             || DECL_READONLY_ONCE_ELAB
694                                (TREE_OPERAND (gnu_expr, 0))))
695                       gnu_size = DECL_SIZE (TREE_OPERAND (gnu_expr, 0));
696                     else
697                       gnu_size
698                         = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, gnu_expr);
699                   }
700                 else
701                   gnu_size = size;
702               }
703             /* We may have no GNU_EXPR because No_Initialization is
704                set even though there's an Expression.  */
705             else if (kind == E_Constant
706                      && (Nkind (Declaration_Node (gnat_entity))
707                          == N_Object_Declaration)
708                      && Present (Expression (Declaration_Node (gnat_entity))))
709               gnu_size
710                 = TYPE_SIZE (gnat_to_gnu_type
711                              (Etype
712                               (Expression (Declaration_Node (gnat_entity)))));
713             else
714               {
715                 gnu_size = max_size (TYPE_SIZE (gnu_type), true);
716                 mutable_p = true;
717               }
718           }
719
720         /* If the size is zero byte, make it one byte since some linkers have
721            troubles with zero-sized objects.  If the object will have a
722            template, that will make it nonzero so don't bother.  Also avoid
723            doing that for an object renaming or an object with an address
724            clause, as we would lose useful information on the view size
725            (e.g. for null array slices) and we are not allocating the object
726            here anyway.  */
727         if (((gnu_size
728               && integer_zerop (gnu_size)
729               && !TREE_OVERFLOW (gnu_size))
730              || (TYPE_SIZE (gnu_type)
731                  && integer_zerop (TYPE_SIZE (gnu_type))
732                  && !TREE_OVERFLOW (TYPE_SIZE (gnu_type))))
733             && (!Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
734                 || !Is_Array_Type (Etype (gnat_entity)))
735             && No (Renamed_Object (gnat_entity))
736             && No (Address_Clause (gnat_entity)))
737           gnu_size = bitsize_unit_node;
738
739         /* If this is an object with no specified size and alignment, and
740            if either it is atomic or we are not optimizing alignment for
741            space and it is composite and not an exception, an Out parameter
742            or a reference to another object, and the size of its type is a
743            constant, set the alignment to the smallest one which is not
744            smaller than the size, with an appropriate cap.  */
745         if (!gnu_size && align == 0
746             && (Is_Atomic (gnat_entity)
747                 || (!Optimize_Alignment_Space (gnat_entity)
748                     && kind != E_Exception
749                     && kind != E_Out_Parameter
750                     && Is_Composite_Type (Etype (gnat_entity))
751                     && !Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
752                     && !Is_Exported (gnat_entity)
753                     && !imported_p
754                     && No (Renamed_Object (gnat_entity))
755                     && No (Address_Clause (gnat_entity))))
756             && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST)
757           {
758             /* No point in jumping through all the hoops needed in order
759                to support BIGGEST_ALIGNMENT if we don't really have to.
760                So we cap to the smallest alignment that corresponds to
761                a known efficient memory access pattern of the target.  */
762             unsigned int align_cap = Is_Atomic (gnat_entity)
763                                      ? BIGGEST_ALIGNMENT
764                                      : get_mode_alignment (ptr_mode);
765
766             if (!host_integerp (TYPE_SIZE (gnu_type), 1)
767                 || compare_tree_int (TYPE_SIZE (gnu_type), align_cap) >= 0)
768               align = align_cap;
769             else
770               align = ceil_alignment (tree_low_cst (TYPE_SIZE (gnu_type), 1));
771
772             /* But make sure not to under-align the object.  */
773             if (align <= TYPE_ALIGN (gnu_type))
774               align = 0;
775
776             /* And honor the minimum valid atomic alignment, if any.  */
777 #ifdef MINIMUM_ATOMIC_ALIGNMENT
778             else if (align < MINIMUM_ATOMIC_ALIGNMENT)
779               align = MINIMUM_ATOMIC_ALIGNMENT;
780 #endif
781           }
782
783         /* If the object is set to have atomic components, find the component
784            type and validate it.
785
786            ??? Note that we ignore Has_Volatile_Components on objects; it's
787            not at all clear what to do in that case.  */
788         if (Has_Atomic_Components (gnat_entity))
789           {
790             tree gnu_inner = (TREE_CODE (gnu_type) == ARRAY_TYPE
791                               ? TREE_TYPE (gnu_type) : gnu_type);
792
793             while (TREE_CODE (gnu_inner) == ARRAY_TYPE
794                    && TYPE_MULTI_ARRAY_P (gnu_inner))
795               gnu_inner = TREE_TYPE (gnu_inner);
796
797             check_ok_for_atomic (gnu_inner, gnat_entity, true);
798           }
799
800         /* Now check if the type of the object allows atomic access.  Note
801            that we must test the type, even if this object has size and
802            alignment to allow such access, because we will be going inside
803            the padded record to assign to the object.  We could fix this by
804            always copying via an intermediate value, but it's not clear it's
805            worth the effort.  */
806         if (Is_Atomic (gnat_entity))
807           check_ok_for_atomic (gnu_type, gnat_entity, false);
808
809         /* If this is an aliased object with an unconstrained nominal subtype,
810            make a type that includes the template.  */
811         if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
812             && Is_Array_Type (Etype (gnat_entity))
813             && !type_annotate_only)
814         {
815           tree gnu_fat
816             = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
817
818           gnu_type
819             = build_unc_object_type_from_ptr (gnu_fat, gnu_type,
820                                               concat_name (gnu_entity_name,
821                                                            "UNC"),
822                                               debug_info_p);
823         }
824
825 #ifdef MINIMUM_ATOMIC_ALIGNMENT
826         /* If the size is a constant and no alignment is specified, force
827            the alignment to be the minimum valid atomic alignment.  The
828            restriction on constant size avoids problems with variable-size
829            temporaries; if the size is variable, there's no issue with
830            atomic access.  Also don't do this for a constant, since it isn't
831            necessary and can interfere with constant replacement.  Finally,
832            do not do it for Out parameters since that creates an
833            size inconsistency with In parameters.  */
834         if (align == 0 && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type)
835             && !FLOAT_TYPE_P (gnu_type)
836             && !const_flag && No (Renamed_Object (gnat_entity))
837             && !imported_p && No (Address_Clause (gnat_entity))
838             && kind != E_Out_Parameter
839             && (gnu_size ? TREE_CODE (gnu_size) == INTEGER_CST
840                 : TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST))
841           align = MINIMUM_ATOMIC_ALIGNMENT;
842 #endif
843
844         /* Make a new type with the desired size and alignment, if needed.
845            But do not take into account alignment promotions to compute the
846            size of the object.  */
847         gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
848         if (gnu_size || align > 0)
849           gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
850                                      false, false, definition,
851                                      gnu_size ? true : false);
852
853         /* If this is a renaming, avoid as much as possible to create a new
854            object.  However, in several cases, creating it is required.
855            This processing needs to be applied to the raw expression so
856            as to make it more likely to rename the underlying object.  */
857         if (Present (Renamed_Object (gnat_entity)))
858           {
859             bool create_normal_object = false;
860
861             /* If the renamed object had padding, strip off the reference
862                to the inner object and reset our type.  */
863             if ((TREE_CODE (gnu_expr) == COMPONENT_REF
864                  && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))))
865                 /* Strip useless conversions around the object.  */
866                 || (TREE_CODE (gnu_expr) == NOP_EXPR
867                     && gnat_types_compatible_p
868                        (TREE_TYPE (gnu_expr),
869                         TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))))
870               {
871                 gnu_expr = TREE_OPERAND (gnu_expr, 0);
872                 gnu_type = TREE_TYPE (gnu_expr);
873               }
874
875             /* Case 1: If this is a constant renaming stemming from a function
876                call, treat it as a normal object whose initial value is what
877                is being renamed.  RM 3.3 says that the result of evaluating a
878                function call is a constant object.  As a consequence, it can
879                be the inner object of a constant renaming.  In this case, the
880                renaming must be fully instantiated, i.e. it cannot be a mere
881                reference to (part of) an existing object.  */
882             if (const_flag)
883               {
884                 tree inner_object = gnu_expr;
885                 while (handled_component_p (inner_object))
886                   inner_object = TREE_OPERAND (inner_object, 0);
887                 if (TREE_CODE (inner_object) == CALL_EXPR)
888                   create_normal_object = true;
889               }
890
891             /* Otherwise, see if we can proceed with a stabilized version of
892                the renamed entity or if we need to make a new object.  */
893             if (!create_normal_object)
894               {
895                 tree maybe_stable_expr = NULL_TREE;
896                 bool stable = false;
897
898                 /* Case 2: If the renaming entity need not be materialized and
899                    the renamed expression is something we can stabilize, use
900                    that for the renaming.  At the global level, we can only do
901                    this if we know no SAVE_EXPRs need be made, because the
902                    expression we return might be used in arbitrary conditional
903                    branches so we must force the SAVE_EXPRs evaluation
904                    immediately and this requires a function context.  */
905                 if (!Materialize_Entity (gnat_entity)
906                     && (!global_bindings_p ()
907                         || (staticp (gnu_expr)
908                             && !TREE_SIDE_EFFECTS (gnu_expr))))
909                   {
910                     maybe_stable_expr
911                       = gnat_stabilize_reference (gnu_expr, true, &stable);
912
913                     if (stable)
914                       {
915                         /* ??? No DECL_EXPR is created so we need to mark
916                            the expression manually lest it is shared.  */
917                         if (global_bindings_p ())
918                           MARK_VISITED (maybe_stable_expr);
919                         gnu_decl = maybe_stable_expr;
920                         save_gnu_tree (gnat_entity, gnu_decl, true);
921                         saved = true;
922                         annotate_object (gnat_entity, gnu_type, NULL_TREE,
923                                          false);
924                         break;
925                       }
926
927                     /* The stabilization failed.  Keep maybe_stable_expr
928                        untouched here to let the pointer case below know
929                        about that failure.  */
930                   }
931
932                 /* Case 3: If this is a constant renaming and creating a
933                    new object is allowed and cheap, treat it as a normal
934                    object whose initial value is what is being renamed.  */
935                 if (const_flag
936                     && !Is_Composite_Type
937                         (Underlying_Type (Etype (gnat_entity))))
938                   ;
939
940                 /* Case 4: Make this into a constant pointer to the object we
941                    are to rename and attach the object to the pointer if it is
942                    something we can stabilize.
943
944                    From the proper scope, attached objects will be referenced
945                    directly instead of indirectly via the pointer to avoid
946                    subtle aliasing problems with non-addressable entities.
947                    They have to be stable because we must not evaluate the
948                    variables in the expression every time the renaming is used.
949                    The pointer is called a "renaming" pointer in this case.
950
951                    In the rare cases where we cannot stabilize the renamed
952                    object, we just make a "bare" pointer, and the renamed
953                    entity is always accessed indirectly through it.  */
954                 else
955                   {
956                     gnu_type = build_reference_type (gnu_type);
957                     inner_const_flag = TREE_READONLY (gnu_expr);
958                     const_flag = true;
959
960                     /* If the previous attempt at stabilizing failed, there
961                        is no point in trying again and we reuse the result
962                        without attaching it to the pointer.  In this case it
963                        will only be used as the initializing expression of
964                        the pointer and thus needs no special treatment with
965                        regard to multiple evaluations.  */
966                     if (maybe_stable_expr)
967                       ;
968
969                     /* Otherwise, try to stabilize and attach the expression
970                        to the pointer if the stabilization succeeds.
971
972                        Note that this might introduce SAVE_EXPRs and we don't
973                        check whether we're at the global level or not.  This
974                        is fine since we are building a pointer initializer and
975                        neither the pointer nor the initializing expression can
976                        be accessed before the pointer elaboration has taken
977                        place in a correct program.
978
979                        These SAVE_EXPRs will be evaluated at the right place
980                        by either the evaluation of the initializer for the
981                        non-global case or the elaboration code for the global
982                        case, and will be attached to the elaboration procedure
983                        in the latter case.  */
984                     else
985                      {
986                         maybe_stable_expr
987                           = gnat_stabilize_reference (gnu_expr, true, &stable);
988
989                         if (stable)
990                           renamed_obj = maybe_stable_expr;
991
992                         /* Attaching is actually performed downstream, as soon
993                            as we have a VAR_DECL for the pointer we make.  */
994                       }
995
996                     gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
997                                                maybe_stable_expr);
998
999                     gnu_size = NULL_TREE;
1000                     used_by_ref = true;
1001                   }
1002               }
1003           }
1004
1005         /* Make a volatile version of this object's type if we are to make
1006            the object volatile.  We also interpret 13.3(19) conservatively
1007            and disallow any optimizations for such a non-constant object.  */
1008         if ((Treat_As_Volatile (gnat_entity)
1009              || (!const_flag
1010                  && gnu_type != except_type_node
1011                  && (Is_Exported (gnat_entity)
1012                      || imported_p
1013                      || Present (Address_Clause (gnat_entity)))))
1014             && !TYPE_VOLATILE (gnu_type))
1015           gnu_type = build_qualified_type (gnu_type,
1016                                            (TYPE_QUALS (gnu_type)
1017                                             | TYPE_QUAL_VOLATILE));
1018
1019         /* If we are defining an aliased object whose nominal subtype is
1020            unconstrained, the object is a record that contains both the
1021            template and the object.  If there is an initializer, it will
1022            have already been converted to the right type, but we need to
1023            create the template if there is no initializer.  */
1024         if (definition
1025             && !gnu_expr
1026             && TREE_CODE (gnu_type) == RECORD_TYPE
1027             && (TYPE_CONTAINS_TEMPLATE_P (gnu_type)
1028                 /* Beware that padding might have been introduced above.  */
1029                 || (TYPE_PADDING_P (gnu_type)
1030                     && TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type)))
1031                        == RECORD_TYPE
1032                     && TYPE_CONTAINS_TEMPLATE_P
1033                        (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
1034           {
1035             tree template_field
1036               = TYPE_PADDING_P (gnu_type)
1037                 ? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type)))
1038                 : TYPE_FIELDS (gnu_type);
1039             gnu_expr
1040               = gnat_build_constructor
1041                 (gnu_type,
1042                  tree_cons
1043                  (template_field,
1044                   build_template (TREE_TYPE (template_field),
1045                                   TREE_TYPE (TREE_CHAIN (template_field)),
1046                                   NULL_TREE),
1047                   NULL_TREE));
1048           }
1049
1050         /* Convert the expression to the type of the object except in the
1051            case where the object's type is unconstrained or the object's type
1052            is a padded record whose field is of self-referential size.  In
1053            the former case, converting will generate unnecessary evaluations
1054            of the CONSTRUCTOR to compute the size and in the latter case, we
1055            want to only copy the actual data.  */
1056         if (gnu_expr
1057             && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
1058             && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
1059             && !(TYPE_IS_PADDING_P (gnu_type)
1060                  && CONTAINS_PLACEHOLDER_P
1061                     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
1062           gnu_expr = convert (gnu_type, gnu_expr);
1063
1064         /* If this is a pointer that doesn't have an initializing expression,
1065            initialize it to NULL, unless the object is imported.  */
1066         if (definition
1067             && (POINTER_TYPE_P (gnu_type) || TYPE_IS_FAT_POINTER_P (gnu_type))
1068             && !gnu_expr
1069             && !Is_Imported (gnat_entity))
1070           gnu_expr = integer_zero_node;
1071
1072         /* If we are defining the object and it has an Address clause, we must
1073            either get the address expression from the saved GCC tree for the
1074            object if it has a Freeze node, or elaborate the address expression
1075            here since the front-end has guaranteed that the elaboration has no
1076            effects in this case.  */
1077         if (definition && Present (Address_Clause (gnat_entity)))
1078           {
1079             Node_Id gnat_expr = Expression (Address_Clause (gnat_entity));
1080             tree gnu_address
1081               = present_gnu_tree (gnat_entity)
1082                 ? get_gnu_tree (gnat_entity) : gnat_to_gnu (gnat_expr);
1083
1084             save_gnu_tree (gnat_entity, NULL_TREE, false);
1085
1086             /* Ignore the size.  It's either meaningless or was handled
1087                above.  */
1088             gnu_size = NULL_TREE;
1089             /* Convert the type of the object to a reference type that can
1090                alias everything as per 13.3(19).  */
1091             gnu_type
1092               = build_reference_type_for_mode (gnu_type, ptr_mode, true);
1093             gnu_address = convert (gnu_type, gnu_address);
1094             used_by_ref = true;
1095             const_flag
1096               = !Is_Public (gnat_entity)
1097                 || compile_time_known_address_p (gnat_expr);
1098
1099             /* If this is a deferred constant, the initializer is attached to
1100                the full view.  */
1101             if (kind == E_Constant && Present (Full_View (gnat_entity)))
1102               gnu_expr
1103                 = gnat_to_gnu
1104                     (Expression (Declaration_Node (Full_View (gnat_entity))));
1105
1106             /* If we don't have an initializing expression for the underlying
1107                variable, the initializing expression for the pointer is the
1108                specified address.  Otherwise, we have to make a COMPOUND_EXPR
1109                to assign both the address and the initial value.  */
1110             if (!gnu_expr)
1111               gnu_expr = gnu_address;
1112             else
1113               gnu_expr
1114                 = build2 (COMPOUND_EXPR, gnu_type,
1115                           build_binary_op
1116                           (MODIFY_EXPR, NULL_TREE,
1117                            build_unary_op (INDIRECT_REF, NULL_TREE,
1118                                            gnu_address),
1119                            gnu_expr),
1120                           gnu_address);
1121           }
1122
1123         /* If it has an address clause and we are not defining it, mark it
1124            as an indirect object.  Likewise for Stdcall objects that are
1125            imported.  */
1126         if ((!definition && Present (Address_Clause (gnat_entity)))
1127             || (Is_Imported (gnat_entity)
1128                 && Has_Stdcall_Convention (gnat_entity)))
1129           {
1130             /* Convert the type of the object to a reference type that can
1131                alias everything as per 13.3(19).  */
1132             gnu_type
1133               = build_reference_type_for_mode (gnu_type, ptr_mode, true);
1134             gnu_size = NULL_TREE;
1135
1136             /* No point in taking the address of an initializing expression
1137                that isn't going to be used.  */
1138             gnu_expr = NULL_TREE;
1139
1140             /* If it has an address clause whose value is known at compile
1141                time, make the object a CONST_DECL.  This will avoid a
1142                useless dereference.  */
1143             if (Present (Address_Clause (gnat_entity)))
1144               {
1145                 Node_Id gnat_address
1146                   = Expression (Address_Clause (gnat_entity));
1147
1148                 if (compile_time_known_address_p (gnat_address))
1149                   {
1150                     gnu_expr = gnat_to_gnu (gnat_address);
1151                     const_flag = true;
1152                   }
1153               }
1154
1155             used_by_ref = true;
1156           }
1157
1158         /* If we are at top level and this object is of variable size,
1159            make the actual type a hidden pointer to the real type and
1160            make the initializer be a memory allocation and initialization.
1161            Likewise for objects we aren't defining (presumed to be
1162            external references from other packages), but there we do
1163            not set up an initialization.
1164
1165            If the object's size overflows, make an allocator too, so that
1166            Storage_Error gets raised.  Note that we will never free
1167            such memory, so we presume it never will get allocated.  */
1168         if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type),
1169                                  global_bindings_p ()
1170                                  || !definition
1171                                  || static_p)
1172             || (gnu_size && !allocatable_size_p (gnu_size,
1173                                                  global_bindings_p ()
1174                                                  || !definition
1175                                                  || static_p)))
1176           {
1177             gnu_type = build_reference_type (gnu_type);
1178             gnu_size = NULL_TREE;
1179             used_by_ref = true;
1180             const_flag = true;
1181
1182             /* In case this was a aliased object whose nominal subtype is
1183                unconstrained, the pointer above will be a thin pointer and
1184                build_allocator will automatically make the template.
1185
1186                If we have a template initializer only (that we made above),
1187                pretend there is none and rely on what build_allocator creates
1188                again anyway.  Otherwise (if we have a full initializer), get
1189                the data part and feed that to build_allocator.
1190
1191                If we are elaborating a mutable object, tell build_allocator to
1192                ignore a possibly simpler size from the initializer, if any, as
1193                we must allocate the maximum possible size in this case.  */
1194             if (definition)
1195               {
1196                 tree gnu_alloc_type = TREE_TYPE (gnu_type);
1197
1198                 if (TREE_CODE (gnu_alloc_type) == RECORD_TYPE
1199                     && TYPE_CONTAINS_TEMPLATE_P (gnu_alloc_type))
1200                   {
1201                     gnu_alloc_type
1202                       = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_alloc_type)));
1203
1204                     if (TREE_CODE (gnu_expr) == CONSTRUCTOR
1205                         && 1 == VEC_length (constructor_elt,
1206                                             CONSTRUCTOR_ELTS (gnu_expr)))
1207                       gnu_expr = 0;
1208                     else
1209                       gnu_expr
1210                         = build_component_ref
1211                             (gnu_expr, NULL_TREE,
1212                              TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))),
1213                              false);
1214                   }
1215
1216                 if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
1217                     && TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_alloc_type))
1218                     && !Is_Imported (gnat_entity))
1219                   post_error ("?Storage_Error will be raised at run-time!",
1220                               gnat_entity);
1221
1222                 gnu_expr
1223                   = build_allocator (gnu_alloc_type, gnu_expr, gnu_type,
1224                                      Empty, Empty, gnat_entity, mutable_p);
1225               }
1226             else
1227               {
1228                 gnu_expr = NULL_TREE;
1229                 const_flag = false;
1230               }
1231           }
1232
1233         /* If this object would go into the stack and has an alignment larger
1234            than the largest stack alignment the back-end can honor, resort to
1235            a variable of "aligning type".  */
1236         if (!global_bindings_p () && !static_p && definition
1237             && !imported_p && TYPE_ALIGN (gnu_type) > BIGGEST_ALIGNMENT)
1238           {
1239             /* Create the new variable.  No need for extra room before the
1240                aligned field as this is in automatic storage.  */
1241             tree gnu_new_type
1242               = make_aligning_type (gnu_type, TYPE_ALIGN (gnu_type),
1243                                     TYPE_SIZE_UNIT (gnu_type),
1244                                     BIGGEST_ALIGNMENT, 0);
1245             tree gnu_new_var
1246               = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
1247                                  NULL_TREE, gnu_new_type, NULL_TREE, false,
1248                                  false, false, false, NULL, gnat_entity);
1249
1250             /* Initialize the aligned field if we have an initializer.  */
1251             if (gnu_expr)
1252               add_stmt_with_node
1253                 (build_binary_op (MODIFY_EXPR, NULL_TREE,
1254                                   build_component_ref
1255                                   (gnu_new_var, NULL_TREE,
1256                                    TYPE_FIELDS (gnu_new_type), false),
1257                                   gnu_expr),
1258                  gnat_entity);
1259
1260             /* And setup this entity as a reference to the aligned field.  */
1261             gnu_type = build_reference_type (gnu_type);
1262             gnu_expr
1263               = build_unary_op
1264                 (ADDR_EXPR, gnu_type,
1265                  build_component_ref (gnu_new_var, NULL_TREE,
1266                                       TYPE_FIELDS (gnu_new_type), false));
1267
1268             gnu_size = NULL_TREE;
1269             used_by_ref = true;
1270             const_flag = true;
1271           }
1272
1273         if (const_flag)
1274           gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type)
1275                                                       | TYPE_QUAL_CONST));
1276
1277         /* Convert the expression to the type of the object except in the
1278            case where the object's type is unconstrained or the object's type
1279            is a padded record whose field is of self-referential size.  In
1280            the former case, converting will generate unnecessary evaluations
1281            of the CONSTRUCTOR to compute the size and in the latter case, we
1282            want to only copy the actual data.  */
1283         if (gnu_expr
1284             && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
1285             && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
1286             && !(TYPE_IS_PADDING_P (gnu_type)
1287                  && CONTAINS_PLACEHOLDER_P
1288                     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
1289           gnu_expr = convert (gnu_type, gnu_expr);
1290
1291         /* If this name is external or there was a name specified, use it,
1292            unless this is a VMS exception object since this would conflict
1293            with the symbol we need to export in addition.  Don't use the
1294            Interface_Name if there is an address clause (see CD30005).  */
1295         if (!Is_VMS_Exception (gnat_entity)
1296             && ((Present (Interface_Name (gnat_entity))
1297                  && No (Address_Clause (gnat_entity)))
1298                 || (Is_Public (gnat_entity)
1299                     && (!Is_Imported (gnat_entity)
1300                         || Is_Exported (gnat_entity)))))
1301           gnu_ext_name = create_concat_name (gnat_entity, NULL);
1302
1303         /* If this is an aggregate constant initialized to a constant, force it
1304            to be statically allocated.  This saves an initialization copy.  */
1305         if (!static_p
1306             && const_flag
1307             && gnu_expr && TREE_CONSTANT (gnu_expr)
1308             && AGGREGATE_TYPE_P (gnu_type)
1309             && host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
1310             && !(TYPE_IS_PADDING_P (gnu_type)
1311                  && !host_integerp (TYPE_SIZE_UNIT
1312                                     (TREE_TYPE (TYPE_FIELDS (gnu_type))), 1)))
1313           static_p = true;
1314
1315         /* Now create the variable or the constant and set various flags.  */
1316         gnu_decl
1317           = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
1318                              gnu_expr, const_flag, Is_Public (gnat_entity),
1319                              imported_p || !definition, static_p, attr_list,
1320                              gnat_entity);
1321         DECL_BY_REF_P (gnu_decl) = used_by_ref;
1322         DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
1323
1324         /* If we are defining an Out parameter and optimization isn't enabled,
1325            create a fake PARM_DECL for debugging purposes and make it point to
1326            the VAR_DECL.  Suppress debug info for the latter but make sure it
1327            will live on the stack so that it can be accessed from within the
1328            debugger through the PARM_DECL.  */
1329         if (kind == E_Out_Parameter && definition && !optimize && debug_info_p)
1330           {
1331             tree param = create_param_decl (gnu_entity_name, gnu_type, false);
1332             gnat_pushdecl (param, gnat_entity);
1333             SET_DECL_VALUE_EXPR (param, gnu_decl);
1334             DECL_HAS_VALUE_EXPR_P (param) = 1;
1335             DECL_IGNORED_P (gnu_decl) = 1;
1336             TREE_ADDRESSABLE (gnu_decl) = 1;
1337           }
1338
1339         /* If this is a renaming pointer, attach the renamed object to it and
1340            register it if we are at top level.  */
1341         if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
1342           {
1343             SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
1344             if (global_bindings_p ())
1345               {
1346                 DECL_RENAMING_GLOBAL_P (gnu_decl) = 1;
1347                 record_global_renaming_pointer (gnu_decl);
1348               }
1349           }
1350
1351         /* If this is a constant and we are defining it or it generates a real
1352            symbol at the object level and we are referencing it, we may want
1353            or need to have a true variable to represent it:
1354              - if optimization isn't enabled, for debugging purposes,
1355              - if the constant is public and not overlaid on something else,
1356              - if its address is taken,
1357              - if either itself or its type is aliased.  */
1358         if (TREE_CODE (gnu_decl) == CONST_DECL
1359             && (definition || Sloc (gnat_entity) > Standard_Location)
1360             && ((!optimize && debug_info_p)
1361                 || (Is_Public (gnat_entity)
1362                     && No (Address_Clause (gnat_entity)))
1363                 || Address_Taken (gnat_entity)
1364                 || Is_Aliased (gnat_entity)
1365                 || Is_Aliased (Etype (gnat_entity))))
1366           {
1367             tree gnu_corr_var
1368               = create_true_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
1369                                       gnu_expr, true, Is_Public (gnat_entity),
1370                                       !definition, static_p, attr_list,
1371                                       gnat_entity);
1372
1373             SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
1374
1375             /* As debugging information will be generated for the variable,
1376                do not generate debugging information for the constant.  */
1377             if (debug_info_p)
1378               DECL_IGNORED_P (gnu_decl) = 1;
1379             else
1380               DECL_IGNORED_P (gnu_corr_var) = 1;
1381           }
1382
1383         /* If this is a constant, even if we don't need a true variable, we
1384            may need to avoid returning the initializer in every case.  That
1385            can happen for the address of a (constant) constructor because,
1386            upon dereferencing it, the constructor will be reinjected in the
1387            tree, which may not be valid in every case; see lvalue_required_p
1388            for more details.  */
1389         if (TREE_CODE (gnu_decl) == CONST_DECL)
1390           DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr);
1391
1392         /* If this object is declared in a block that contains a block with an
1393            exception handler, and we aren't using the GCC exception mechanism,
1394            we must force this variable in memory in order to avoid an invalid
1395            optimization.  */
1396         if (Exception_Mechanism != Back_End_Exceptions
1397             && Has_Nested_Block_With_Handler (Scope (gnat_entity)))
1398           TREE_ADDRESSABLE (gnu_decl) = 1;
1399
1400         /* If we are defining an object with variable size or an object with
1401            fixed size that will be dynamically allocated, and we are using the
1402            setjmp/longjmp exception mechanism, update the setjmp buffer.  */
1403         if (definition
1404             && Exception_Mechanism == Setjmp_Longjmp
1405             && get_block_jmpbuf_decl ()
1406             && DECL_SIZE_UNIT (gnu_decl)
1407             && (TREE_CODE (DECL_SIZE_UNIT (gnu_decl)) != INTEGER_CST
1408                 || (flag_stack_check == GENERIC_STACK_CHECK
1409                     && compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
1410                                          STACK_CHECK_MAX_VAR_SIZE) > 0)))
1411           add_stmt_with_node (build_call_1_expr
1412                               (update_setjmp_buf_decl,
1413                                build_unary_op (ADDR_EXPR, NULL_TREE,
1414                                                get_block_jmpbuf_decl ())),
1415                               gnat_entity);
1416
1417         /* Back-annotate Esize and Alignment of the object if not already
1418            known.  Note that we pick the values of the type, not those of
1419            the object, to shield ourselves from low-level platform-dependent
1420            adjustments like alignment promotion.  This is both consistent with
1421            all the treatment above, where alignment and size are set on the
1422            type of the object and not on the object directly, and makes it
1423            possible to support all confirming representation clauses.  */
1424         annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size,
1425                          used_by_ref);
1426       }
1427       break;
1428
1429     case E_Void:
1430       /* Return a TYPE_DECL for "void" that we previously made.  */
1431       gnu_decl = TYPE_NAME (void_type_node);
1432       break;
1433
1434     case E_Enumeration_Type:
1435       /* A special case: for the types Character and Wide_Character in
1436          Standard, we do not list all the literals.  So if the literals
1437          are not specified, make this an unsigned type.  */
1438       if (No (First_Literal (gnat_entity)))
1439         {
1440           gnu_type = make_unsigned_type (esize);
1441           TYPE_NAME (gnu_type) = gnu_entity_name;
1442
1443           /* Set TYPE_STRING_FLAG for Character and Wide_Character types.
1444              This is needed by the DWARF-2 back-end to distinguish between
1445              unsigned integer types and character types.  */
1446           TYPE_STRING_FLAG (gnu_type) = 1;
1447           break;
1448         }
1449
1450       {
1451         /* We have a list of enumeral constants in First_Literal.  We make a
1452            CONST_DECL for each one and build into GNU_LITERAL_LIST the list to
1453            be placed into TYPE_FIELDS.  Each node in the list is a TREE_LIST
1454            whose TREE_VALUE is the literal name and whose TREE_PURPOSE is the
1455            value of the literal.  But when we have a regular boolean type, we
1456            simplify this a little by using a BOOLEAN_TYPE.  */
1457         bool is_boolean = Is_Boolean_Type (gnat_entity)
1458                           && !Has_Non_Standard_Rep (gnat_entity);
1459         tree gnu_literal_list = NULL_TREE;
1460         Entity_Id gnat_literal;
1461
1462         if (Is_Unsigned_Type (gnat_entity))
1463           gnu_type = make_unsigned_type (esize);
1464         else
1465           gnu_type = make_signed_type (esize);
1466
1467         TREE_SET_CODE (gnu_type, is_boolean ? BOOLEAN_TYPE : ENUMERAL_TYPE);
1468
1469         for (gnat_literal = First_Literal (gnat_entity);
1470              Present (gnat_literal);
1471              gnat_literal = Next_Literal (gnat_literal))
1472           {
1473             tree gnu_value
1474               = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type);
1475             tree gnu_literal
1476               = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
1477                                  gnu_type, gnu_value, true, false, false,
1478                                  false, NULL, gnat_literal);
1479
1480             save_gnu_tree (gnat_literal, gnu_literal, false);
1481             gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
1482                                           gnu_value, gnu_literal_list);
1483           }
1484
1485         if (!is_boolean)
1486           TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
1487
1488         /* Note that the bounds are updated at the end of this function
1489            to avoid an infinite recursion since they refer to the type.  */
1490       }
1491       break;
1492
1493     case E_Signed_Integer_Type:
1494     case E_Ordinary_Fixed_Point_Type:
1495     case E_Decimal_Fixed_Point_Type:
1496       /* For integer types, just make a signed type the appropriate number
1497          of bits.  */
1498       gnu_type = make_signed_type (esize);
1499       break;
1500
1501     case E_Modular_Integer_Type:
1502       {
1503         /* For modular types, make the unsigned type of the proper number
1504            of bits and then set up the modulus, if required.  */
1505         tree gnu_modulus, gnu_high = NULL_TREE;
1506
1507         /* Packed array types are supposed to be subtypes only.  */
1508         gcc_assert (!Is_Packed_Array_Type (gnat_entity));
1509
1510         gnu_type = make_unsigned_type (esize);
1511
1512         /* Get the modulus in this type.  If it overflows, assume it is because
1513            it is equal to 2**Esize.  Note that there is no overflow checking
1514            done on unsigned type, so we detect the overflow by looking for
1515            a modulus of zero, which is otherwise invalid.  */
1516         gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
1517
1518         if (!integer_zerop (gnu_modulus))
1519           {
1520             TYPE_MODULAR_P (gnu_type) = 1;
1521             SET_TYPE_MODULUS (gnu_type, gnu_modulus);
1522             gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
1523                                     convert (gnu_type, integer_one_node));
1524           }
1525
1526         /* If the upper bound is not maximal, make an extra subtype.  */
1527         if (gnu_high
1528             && !tree_int_cst_equal (gnu_high, TYPE_MAX_VALUE (gnu_type)))
1529           {
1530             tree gnu_subtype = make_unsigned_type (esize);
1531             SET_TYPE_RM_MAX_VALUE (gnu_subtype, gnu_high);
1532             TREE_TYPE (gnu_subtype) = gnu_type;
1533             TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
1534             TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
1535             gnu_type = gnu_subtype;
1536           }
1537       }
1538       break;
1539
1540     case E_Signed_Integer_Subtype:
1541     case E_Enumeration_Subtype:
1542     case E_Modular_Integer_Subtype:
1543     case E_Ordinary_Fixed_Point_Subtype:
1544     case E_Decimal_Fixed_Point_Subtype:
1545
1546       /* For integral subtypes, we make a new INTEGER_TYPE.  Note that we do
1547          not want to call create_range_type since we would like each subtype
1548          node to be distinct.  ??? Historically this was in preparation for
1549          when memory aliasing is implemented, but that's obsolete now given
1550          the call to relate_alias_sets below.
1551
1552          The TREE_TYPE field of the INTEGER_TYPE points to the base type;
1553          this fact is used by the arithmetic conversion functions.
1554
1555          We elaborate the Ancestor_Subtype if it is not in the current unit
1556          and one of our bounds is non-static.  We do this to ensure consistent
1557          naming in the case where several subtypes share the same bounds, by
1558          elaborating the first such subtype first, thus using its name.  */
1559
1560       if (!definition
1561           && Present (Ancestor_Subtype (gnat_entity))
1562           && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
1563           && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
1564               || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
1565         gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, 0);
1566
1567       /* Set the precision to the Esize except for bit-packed arrays.  */
1568       if (Is_Packed_Array_Type (gnat_entity)
1569           && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
1570         esize = UI_To_Int (RM_Size (gnat_entity));
1571
1572       /* This should be an unsigned type if the base type is unsigned or
1573          if the lower bound is constant and non-negative or if the type
1574          is biased.  */
1575       if (Is_Unsigned_Type (Etype (gnat_entity))
1576           || Is_Unsigned_Type (gnat_entity)
1577           || Has_Biased_Representation (gnat_entity))
1578         gnu_type = make_unsigned_type (esize);
1579       else
1580         gnu_type = make_signed_type (esize);
1581       TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
1582
1583       SET_TYPE_RM_MIN_VALUE
1584         (gnu_type,
1585          convert (TREE_TYPE (gnu_type),
1586                   elaborate_expression (Type_Low_Bound (gnat_entity),
1587                                         gnat_entity, get_identifier ("L"),
1588                                         definition, true,
1589                                         Needs_Debug_Info (gnat_entity))));
1590
1591       SET_TYPE_RM_MAX_VALUE
1592         (gnu_type,
1593          convert (TREE_TYPE (gnu_type),
1594                   elaborate_expression (Type_High_Bound (gnat_entity),
1595                                         gnat_entity, get_identifier ("U"),
1596                                         definition, true,
1597                                         Needs_Debug_Info (gnat_entity))));
1598
1599       /* One of the above calls might have caused us to be elaborated,
1600          so don't blow up if so.  */
1601       if (present_gnu_tree (gnat_entity))
1602         {
1603           maybe_present = true;
1604           break;
1605         }
1606
1607       TYPE_BIASED_REPRESENTATION_P (gnu_type)
1608         = Has_Biased_Representation (gnat_entity);
1609
1610       /* Attach the TYPE_STUB_DECL in case we have a parallel type.  */
1611       TYPE_STUB_DECL (gnu_type)
1612         = create_type_stub_decl (gnu_entity_name, gnu_type);
1613
1614       /* Inherit our alias set from what we're a subtype of.  Subtypes
1615          are not different types and a pointer can designate any instance
1616          within a subtype hierarchy.  */
1617       relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
1618
1619       /* For a packed array, make the original array type a parallel type.  */
1620       if (debug_info_p
1621           && Is_Packed_Array_Type (gnat_entity)
1622           && present_gnu_tree (Original_Array_Type (gnat_entity)))
1623         add_parallel_type (TYPE_STUB_DECL (gnu_type),
1624                            gnat_to_gnu_type
1625                            (Original_Array_Type (gnat_entity)));
1626
1627       /* We have to handle clauses that under-align the type specially.  */
1628       if ((Present (Alignment_Clause (gnat_entity))
1629            || (Is_Packed_Array_Type (gnat_entity)
1630                && Present
1631                   (Alignment_Clause (Original_Array_Type (gnat_entity)))))
1632           && UI_Is_In_Int_Range (Alignment (gnat_entity)))
1633         {
1634           align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT;
1635           if (align >= TYPE_ALIGN (gnu_type))
1636             align = 0;
1637         }
1638
1639       /* If the type we are dealing with represents a bit-packed array,
1640          we need to have the bits left justified on big-endian targets
1641          and right justified on little-endian targets.  We also need to
1642          ensure that when the value is read (e.g. for comparison of two
1643          such values), we only get the good bits, since the unused bits
1644          are uninitialized.  Both goals are accomplished by wrapping up
1645          the modular type in an enclosing record type.  */
1646       if (Is_Packed_Array_Type (gnat_entity)
1647           && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
1648         {
1649           tree gnu_field_type, gnu_field;
1650
1651           /* Set the RM size before wrapping up the original type.  */
1652           SET_TYPE_RM_SIZE (gnu_type,
1653                             UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
1654           TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
1655
1656           /* Create a stripped-down declaration, mainly for debugging.  */
1657           create_type_decl (gnu_entity_name, gnu_type, NULL, true,
1658                             debug_info_p, gnat_entity);
1659
1660           /* Now save it and build the enclosing record type.  */
1661           gnu_field_type = gnu_type;
1662
1663           gnu_type = make_node (RECORD_TYPE);
1664           TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "JM");
1665           TYPE_PACKED (gnu_type) = 1;
1666           TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type);
1667           TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type);
1668           SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type));
1669
1670           /* Propagate the alignment of the modular type to the record type,
1671              unless there is an alignment clause that under-aligns the type.
1672              This means that bit-packed arrays are given "ceil" alignment for
1673              their size by default, which may seem counter-intuitive but makes
1674              it possible to overlay them on modular types easily.  */
1675           TYPE_ALIGN (gnu_type)
1676             = align > 0 ? align : TYPE_ALIGN (gnu_field_type);
1677
1678           relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
1679
1680           /* Don't notify the field as "addressable", since we won't be taking
1681              it's address and it would prevent create_field_decl from making a
1682              bitfield.  */
1683           gnu_field = create_field_decl (get_identifier ("OBJECT"),
1684                                          gnu_field_type, gnu_type, 1,
1685                                          NULL_TREE, bitsize_zero_node, 0);
1686
1687           /* Do not emit debug info until after the parallel type is added.  */
1688           finish_record_type (gnu_type, gnu_field, 2, false);
1689           compute_record_mode (gnu_type);
1690           TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
1691
1692           if (debug_info_p)
1693             {
1694               /* Make the original array type a parallel type.  */
1695               if (present_gnu_tree (Original_Array_Type (gnat_entity)))
1696                 add_parallel_type (TYPE_STUB_DECL (gnu_type),
1697                                    gnat_to_gnu_type
1698                                    (Original_Array_Type (gnat_entity)));
1699
1700               rest_of_record_type_compilation (gnu_type);
1701             }
1702         }
1703
1704       /* If the type we are dealing with has got a smaller alignment than the
1705          natural one, we need to wrap it up in a record type and under-align
1706          the latter.  We reuse the padding machinery for this purpose.  */
1707       else if (align > 0)
1708         {
1709           tree gnu_field_type, gnu_field;
1710
1711           /* Set the RM size before wrapping up the type.  */
1712           SET_TYPE_RM_SIZE (gnu_type,
1713                             UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
1714
1715           /* Create a stripped-down declaration, mainly for debugging.  */
1716           create_type_decl (gnu_entity_name, gnu_type, NULL, true,
1717                             debug_info_p, gnat_entity);
1718
1719           /* Now save it and build the enclosing record type.  */
1720           gnu_field_type = gnu_type;
1721
1722           gnu_type = make_node (RECORD_TYPE);
1723           TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD");
1724           TYPE_PACKED (gnu_type) = 1;
1725           TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type);
1726           TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type);
1727           SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type));
1728           TYPE_ALIGN (gnu_type) = align;
1729           relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
1730
1731           /* Don't notify the field as "addressable", since we won't be taking
1732              it's address and it would prevent create_field_decl from making a
1733              bitfield.  */
1734           gnu_field = create_field_decl (get_identifier ("F"),
1735                                          gnu_field_type, gnu_type, 1,
1736                                          NULL_TREE, bitsize_zero_node, 0);
1737
1738           finish_record_type (gnu_type, gnu_field, 2, debug_info_p);
1739           compute_record_mode (gnu_type);
1740           TYPE_PADDING_P (gnu_type) = 1;
1741         }
1742
1743       break;
1744
1745     case E_Floating_Point_Type:
1746       /* If this is a VAX floating-point type, use an integer of the proper
1747          size.  All the operations will be handled with ASM statements.  */
1748       if (Vax_Float (gnat_entity))
1749         {
1750           gnu_type = make_signed_type (esize);
1751           TYPE_VAX_FLOATING_POINT_P (gnu_type) = 1;
1752           SET_TYPE_DIGITS_VALUE (gnu_type,
1753                                  UI_To_gnu (Digits_Value (gnat_entity),
1754                                             sizetype));
1755           break;
1756         }
1757
1758       /* The type of the Low and High bounds can be our type if this is
1759          a type from Standard, so set them at the end of the function.  */
1760       gnu_type = make_node (REAL_TYPE);
1761       TYPE_PRECISION (gnu_type) = fp_size_to_prec (esize);
1762       layout_type (gnu_type);
1763       break;
1764
1765     case E_Floating_Point_Subtype:
1766       if (Vax_Float (gnat_entity))
1767         {
1768           gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
1769           break;
1770         }
1771
1772       {
1773         if (!definition
1774             && Present (Ancestor_Subtype (gnat_entity))
1775             && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
1776             && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
1777                 || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
1778           gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity),
1779                               gnu_expr, 0);
1780
1781         gnu_type = make_node (REAL_TYPE);
1782         TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
1783         TYPE_PRECISION (gnu_type) = fp_size_to_prec (esize);
1784         TYPE_GCC_MIN_VALUE (gnu_type)
1785           = TYPE_GCC_MIN_VALUE (TREE_TYPE (gnu_type));
1786         TYPE_GCC_MAX_VALUE (gnu_type)
1787           = TYPE_GCC_MAX_VALUE (TREE_TYPE (gnu_type));
1788         layout_type (gnu_type);
1789
1790         SET_TYPE_RM_MIN_VALUE
1791           (gnu_type,
1792            convert (TREE_TYPE (gnu_type),
1793                     elaborate_expression (Type_Low_Bound (gnat_entity),
1794                                           gnat_entity, get_identifier ("L"),
1795                                           definition, true,
1796                                           Needs_Debug_Info (gnat_entity))));
1797
1798         SET_TYPE_RM_MAX_VALUE
1799           (gnu_type,
1800            convert (TREE_TYPE (gnu_type),
1801                     elaborate_expression (Type_High_Bound (gnat_entity),
1802                                           gnat_entity, get_identifier ("U"),
1803                                           definition, true,
1804                                           Needs_Debug_Info (gnat_entity))));
1805
1806         /* One of the above calls might have caused us to be elaborated,
1807            so don't blow up if so.  */
1808         if (present_gnu_tree (gnat_entity))
1809           {
1810             maybe_present = true;
1811             break;
1812           }
1813
1814         /* Inherit our alias set from what we're a subtype of, as for
1815            integer subtypes.  */
1816         relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
1817       }
1818     break;
1819
1820       /* Array and String Types and Subtypes
1821
1822          Unconstrained array types are represented by E_Array_Type and
1823          constrained array types are represented by E_Array_Subtype.  There
1824          are no actual objects of an unconstrained array type; all we have
1825          are pointers to that type.
1826
1827          The following fields are defined on array types and subtypes:
1828
1829                 Component_Type     Component type of the array.
1830                 Number_Dimensions  Number of dimensions (an int).
1831                 First_Index        Type of first index.  */
1832
1833     case E_String_Type:
1834     case E_Array_Type:
1835       {
1836         Entity_Id gnat_index, gnat_name;
1837         const bool convention_fortran_p
1838           = (Convention (gnat_entity) == Convention_Fortran);
1839         const int ndim = Number_Dimensions (gnat_entity);
1840         tree gnu_template_fields = NULL_TREE;
1841         tree gnu_template_type = make_node (RECORD_TYPE);
1842         tree gnu_template_reference;
1843         tree gnu_ptr_template = build_pointer_type (gnu_template_type);
1844         tree gnu_fat_type = make_node (RECORD_TYPE);
1845         tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree));
1846         tree *gnu_temp_fields = (tree *) alloca (ndim * sizeof (tree));
1847         tree gnu_max_size = size_one_node, gnu_max_size_unit, tem;
1848         int index;
1849
1850         TYPE_NAME (gnu_template_type)
1851           = create_concat_name (gnat_entity, "XUB");
1852
1853         /* Make a node for the array.  If we are not defining the array
1854            suppress expanding incomplete types.  */
1855         gnu_type = make_node (UNCONSTRAINED_ARRAY_TYPE);
1856
1857         if (!definition)
1858           {
1859             defer_incomplete_level++;
1860             this_deferred = true;
1861           }
1862
1863         /* Build the fat pointer type.  Use a "void *" object instead of
1864            a pointer to the array type since we don't have the array type
1865            yet (it will reference the fat pointer via the bounds).  */
1866         tem = chainon (chainon (NULL_TREE,
1867                                 create_field_decl (get_identifier ("P_ARRAY"),
1868                                                    ptr_void_type_node,
1869                                                    gnu_fat_type, NULL_TREE,
1870                                                    NULL_TREE, 0, 0)),
1871                        create_field_decl (get_identifier ("P_BOUNDS"),
1872                                           gnu_ptr_template,
1873                                           gnu_fat_type, NULL_TREE,
1874                                           NULL_TREE, 0, 0));
1875
1876         /* Make sure we can put this into a register.  */
1877         TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
1878
1879         /* Do not emit debug info for this record type since the types of its
1880            fields are still incomplete at this point.  */
1881         finish_record_type (gnu_fat_type, tem, 0, false);
1882         TYPE_FAT_POINTER_P (gnu_fat_type) = 1;
1883
1884         /* Build a reference to the template from a PLACEHOLDER_EXPR that
1885            is the fat pointer.  This will be used to access the individual
1886            fields once we build them.  */
1887         tem = build3 (COMPONENT_REF, gnu_ptr_template,
1888                       build0 (PLACEHOLDER_EXPR, gnu_fat_type),
1889                       TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE);
1890         gnu_template_reference
1891           = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
1892         TREE_READONLY (gnu_template_reference) = 1;
1893
1894         /* Now create the GCC type for each index and add the fields for that
1895            index to the template.  */
1896         for (index = (convention_fortran_p ? ndim - 1 : 0),
1897              gnat_index = First_Index (gnat_entity);
1898              0 <= index && index < ndim;
1899              index += (convention_fortran_p ? - 1 : 1),
1900              gnat_index = Next_Index (gnat_index))
1901           {
1902             char field_name[16];
1903             tree gnu_index_base_type
1904               = get_unpadded_type (Base_Type (Etype (gnat_index)));
1905             tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max;
1906             tree gnu_min, gnu_max, gnu_high;
1907
1908             /* Make the FIELD_DECLs for the low and high bounds of this
1909                type and then make extractions of these fields from the
1910                template.  */
1911             sprintf (field_name, "LB%d", index);
1912             gnu_lb_field = create_field_decl (get_identifier (field_name),
1913                                               gnu_index_base_type,
1914                                               gnu_template_type, NULL_TREE,
1915                                               NULL_TREE, 0, 0);
1916             Sloc_to_locus (Sloc (gnat_entity),
1917                            &DECL_SOURCE_LOCATION (gnu_lb_field));
1918
1919             field_name[0] = 'U';
1920             gnu_hb_field = create_field_decl (get_identifier (field_name),
1921                                               gnu_index_base_type,
1922                                               gnu_template_type, NULL_TREE,
1923                                               NULL_TREE, 0, 0);
1924             Sloc_to_locus (Sloc (gnat_entity),
1925                            &DECL_SOURCE_LOCATION (gnu_hb_field));
1926
1927             gnu_temp_fields[index] = chainon (gnu_lb_field, gnu_hb_field);
1928
1929             /* We can't use build_component_ref here since the template type
1930                isn't complete yet.  */
1931             gnu_low = build3 (COMPONENT_REF, gnu_index_base_type,
1932                               gnu_template_reference, gnu_low_field,
1933                               NULL_TREE);
1934             gnu_high = build3 (COMPONENT_REF, gnu_index_base_type,
1935                                gnu_template_reference, gnu_high_field,
1936                                NULL_TREE);
1937             TREE_READONLY (gnu_low) = TREE_READONLY (gnu_high) = 1;
1938
1939             /* Compute the size of this dimension.  */
1940             gnu_max
1941               = build3 (COND_EXPR, gnu_index_base_type,
1942                         build2 (GE_EXPR, boolean_type_node, gnu_high, gnu_low),
1943                         gnu_high,
1944                         build2 (MINUS_EXPR, gnu_index_base_type,
1945                                 gnu_low, fold_convert (gnu_index_base_type,
1946                                                        integer_one_node)));
1947
1948             /* Make a range type with the new range in the Ada base type.
1949                Then make an index type with the size range in sizetype.  */
1950             gnu_index_types[index]
1951               = create_index_type (gnu_min, gnu_high,
1952                                    create_range_type (gnu_index_base_type,
1953                                                       gnu_orig_min,
1954                                                       gnu_orig_max),
1955                                    gnat_entity);
1956
1957             /* Update the maximum size of the array in elements.  */
1958             if (gnu_max_size)
1959               {
1960                 tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
1961                 tree gnu_min
1962                   = convert (sizetype, TYPE_MIN_VALUE (gnu_index_type));
1963                 tree gnu_max
1964                   = convert (sizetype, TYPE_MAX_VALUE (gnu_index_type));
1965                 tree gnu_this_max
1966                   = size_binop (MAX_EXPR,
1967                                 size_binop (PLUS_EXPR, size_one_node,
1968                                             size_binop (MINUS_EXPR,
1969                                                         gnu_max, gnu_min)),
1970                                 size_zero_node);
1971
1972                 if (TREE_CODE (gnu_this_max) == INTEGER_CST
1973                     && TREE_OVERFLOW (gnu_this_max))
1974                   gnu_max_size = NULL_TREE;
1975                 else
1976                   gnu_max_size
1977                     = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
1978               }
1979
1980             TYPE_NAME (gnu_index_types[index])
1981               = create_concat_name (gnat_entity, field_name);
1982           }
1983
1984         for (index = 0; index < ndim; index++)
1985           gnu_template_fields
1986             = chainon (gnu_template_fields, gnu_temp_fields[index]);
1987
1988         /* Install all the fields into the template.  */
1989         finish_record_type (gnu_template_type, gnu_template_fields, 0,
1990                             debug_info_p);
1991         TYPE_READONLY (gnu_template_type) = 1;
1992
1993         /* Now make the array of arrays and update the pointer to the array
1994            in the fat pointer.  Note that it is the first field.  */
1995         tem = gnat_to_gnu_component_type (gnat_entity, definition,
1996                                           debug_info_p);
1997
1998         /* If Component_Size is not already specified, annotate it with the
1999            size of the component.  */
2000         if (Unknown_Component_Size (gnat_entity))
2001           Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (tem)));
2002
2003         /* Compute the maximum size of the array in units and bits.  */
2004         if (gnu_max_size)
2005           {
2006             gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
2007                                             TYPE_SIZE_UNIT (tem));
2008             gnu_max_size = size_binop (MULT_EXPR,
2009                                        convert (bitsizetype, gnu_max_size),
2010                                        TYPE_SIZE (tem));
2011           }
2012         else
2013           gnu_max_size_unit = NULL_TREE;
2014
2015         /* Now build the array type.  */
2016         for (index = ndim - 1; index >= 0; index--)
2017           {
2018             tem = build_array_type (tem, gnu_index_types[index]);
2019             TYPE_MULTI_ARRAY_P (tem) = (index > 0);
2020             if (array_type_has_nonaliased_component (tem, gnat_entity))
2021               TYPE_NONALIASED_COMPONENT (tem) = 1;
2022           }
2023
2024         /* If an alignment is specified, use it if valid.  But ignore it
2025            for the original type of packed array types.  If the alignment
2026            was requested with an explicit alignment clause, state so.  */
2027         if (No (Packed_Array_Type (gnat_entity))
2028             && Known_Alignment (gnat_entity))
2029           {
2030             TYPE_ALIGN (tem)
2031               = validate_alignment (Alignment (gnat_entity), gnat_entity,
2032                                     TYPE_ALIGN (tem));
2033             if (Present (Alignment_Clause (gnat_entity)))
2034               TYPE_USER_ALIGN (tem) = 1;
2035           }
2036
2037         TYPE_CONVENTION_FORTRAN_P (tem) = convention_fortran_p;
2038         TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem);
2039
2040         /* The result type is an UNCONSTRAINED_ARRAY_TYPE that indicates the
2041            corresponding fat pointer.  */
2042         TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type)
2043           = TYPE_REFERENCE_TO (gnu_type) = gnu_fat_type;
2044         SET_TYPE_MODE (gnu_type, BLKmode);
2045         TYPE_ALIGN (gnu_type) = TYPE_ALIGN (tem);
2046         SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type);
2047
2048         /* If the maximum size doesn't overflow, use it.  */
2049         if (gnu_max_size
2050             && TREE_CODE (gnu_max_size) == INTEGER_CST
2051             && !TREE_OVERFLOW (gnu_max_size)
2052             && TREE_CODE (gnu_max_size_unit) == INTEGER_CST
2053             && !TREE_OVERFLOW (gnu_max_size_unit))
2054           {
2055             TYPE_SIZE (tem) = size_binop (MIN_EXPR, gnu_max_size,
2056                                           TYPE_SIZE (tem));
2057             TYPE_SIZE_UNIT (tem) = size_binop (MIN_EXPR, gnu_max_size_unit,
2058                                                TYPE_SIZE_UNIT (tem));
2059           }
2060
2061         create_type_decl (create_concat_name (gnat_entity, "XUA"),
2062                           tem, NULL, !Comes_From_Source (gnat_entity),
2063                           debug_info_p, gnat_entity);
2064
2065         /* Give the fat pointer type a name.  If this is a packed type, tell
2066            the debugger how to interpret the underlying bits.  */
2067         if (Present (Packed_Array_Type (gnat_entity)))
2068           gnat_name = Packed_Array_Type (gnat_entity);
2069         else
2070           gnat_name = gnat_entity;
2071         create_type_decl (create_concat_name (gnat_name, "XUP"),
2072                           gnu_fat_type, NULL, true,
2073                           debug_info_p, gnat_entity);
2074
2075         /* Create the type to be used as what a thin pointer designates:
2076            a record type for the object and its template with the fields
2077            shifted to have the template at a negative offset.  */
2078         tem = build_unc_object_type (gnu_template_type, tem,
2079                                      create_concat_name (gnat_name, "XUT"),
2080                                      debug_info_p);
2081         shift_unc_components_for_thin_pointers (tem);
2082
2083         SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type);
2084         TYPE_OBJECT_RECORD_TYPE (gnu_type) = tem;
2085       }
2086       break;
2087
2088     case E_String_Subtype:
2089     case E_Array_Subtype:
2090
2091       /* This is the actual data type for array variables.  Multidimensional
2092          arrays are implemented as arrays of arrays.  Note that arrays which
2093          have sparse enumeration subtypes as index components create sparse
2094          arrays, which is obviously space inefficient but so much easier to
2095          code for now.
2096
2097          Also note that the subtype never refers to the unconstrained array
2098          type, which is somewhat at variance with Ada semantics.
2099
2100          First check to see if this is simply a renaming of the array type.
2101          If so, the result is the array type.  */
2102
2103       gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
2104       if (!Is_Constrained (gnat_entity))
2105         ;
2106       else
2107         {
2108           Entity_Id gnat_index, gnat_base_index;
2109           const bool convention_fortran_p
2110             = (Convention (gnat_entity) == Convention_Fortran);
2111           const int ndim = Number_Dimensions (gnat_entity);
2112           tree gnu_base_type = gnu_type;
2113           tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree));
2114           tree gnu_max_size = size_one_node, gnu_max_size_unit;
2115           bool need_index_type_struct = false;
2116           int index;
2117
2118           /* First create the GCC type for each index and find out whether
2119              special types are needed for debugging information.  */
2120           for (index = (convention_fortran_p ? ndim - 1 : 0),
2121                gnat_index = First_Index (gnat_entity),
2122                gnat_base_index
2123                  = First_Index (Implementation_Base_Type (gnat_entity));
2124                0 <= index && index < ndim;
2125                index += (convention_fortran_p ? - 1 : 1),
2126                gnat_index = Next_Index (gnat_index),
2127                gnat_base_index = Next_Index (gnat_base_index))
2128             {
2129               tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
2130               tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
2131               tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
2132               tree gnu_min = convert (sizetype, gnu_orig_min);
2133               tree gnu_max = convert (sizetype, gnu_orig_max);
2134               tree gnu_base_index_type
2135                 = get_unpadded_type (Etype (gnat_base_index));
2136               tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type);
2137               tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type);
2138               tree gnu_high;
2139
2140               /* See if the base array type is already flat.  If it is, we
2141                  are probably compiling an ACATS test but it will cause the
2142                  code below to malfunction if we don't handle it specially.  */
2143               if (TREE_CODE (gnu_base_orig_min) == INTEGER_CST
2144                   && TREE_CODE (gnu_base_orig_max) == INTEGER_CST
2145                   && tree_int_cst_lt (gnu_base_orig_max, gnu_base_orig_min))
2146                 {
2147                   gnu_min = size_one_node;
2148                   gnu_max = size_zero_node;
2149                   gnu_high = gnu_max;
2150                 }
2151
2152               /* Similarly, if one of the values overflows in sizetype and the
2153                  range is null, use 1..0 for the sizetype bounds.  */
2154               else if (TREE_CODE (gnu_min) == INTEGER_CST
2155                        && TREE_CODE (gnu_max) == INTEGER_CST
2156                        && (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max))
2157                        && tree_int_cst_lt (gnu_orig_max, gnu_orig_min))
2158                 {
2159                   gnu_min = size_one_node;
2160                   gnu_max = size_zero_node;
2161                   gnu_high = gnu_max;
2162                 }
2163
2164               /* If the minimum and maximum values both overflow in sizetype,
2165                  but the difference in the original type does not overflow in
2166                  sizetype, ignore the overflow indication.  */
2167               else if (TREE_CODE (gnu_min) == INTEGER_CST
2168                        && TREE_CODE (gnu_max) == INTEGER_CST
2169                        && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
2170                        && !TREE_OVERFLOW
2171                            (convert (sizetype,
2172                                      fold_build2 (MINUS_EXPR, gnu_index_type,
2173                                                   gnu_orig_max,
2174                                                   gnu_orig_min))))
2175                 {
2176                   TREE_OVERFLOW (gnu_min) = 0;
2177                   TREE_OVERFLOW (gnu_max) = 0;
2178                   gnu_high = gnu_max;
2179                 }
2180
2181               /* Compute the size of this dimension in the general case.  We
2182                  need to provide GCC with an upper bound to use but have to
2183                  deal with the "superflat" case.  There are three ways to do
2184                  this.  If we can prove that the array can never be superflat,
2185                  we can just use the high bound of the index type.  */
2186               else if ((Nkind (gnat_index) == N_Range
2187                         && cannot_be_superflat_p (gnat_index))
2188                        /* Packed Array Types are never superflat.  */
2189                        || Is_Packed_Array_Type (gnat_entity))
2190                 gnu_high = gnu_max;
2191
2192               /* Otherwise, if the high bound is constant but the low bound is
2193                  not, we use the expression (hb >= lb) ? lb : hb + 1 for the
2194                  lower bound.  Note that the comparison must be done in the
2195                  original type to avoid any overflow during the conversion.  */
2196               else if (TREE_CODE (gnu_max) == INTEGER_CST
2197                        && TREE_CODE (gnu_min) != INTEGER_CST)
2198                 {
2199                   gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node);
2200                   gnu_low = size_binop (PLUS_EXPR, gnu_max, size_one_node);
2201
2202                   /* If gnu_high is a constant that has overflowed, the low
2203                      bound is the smallest integer so cannot be the maximum.
2204                      If gnu_low is a constant that has overflowed, the high
2205                      bound is the highest integer so cannot be the minimum.  */
2206                   if ((TREE_CODE (gnu_high) == INTEGER_CST
2207                        && TREE_OVERFLOW (gnu_high))
2208                       || (TREE_CODE (gnu_low) == INTEGER_CST
2209                            && TREE_OVERFLOW (gnu_low)))
2210                     gnu_high = gnu_max;
2211
2212                   /* If the index type is a subrange and gnu_high a constant
2213                      that hasn't overflowed, we can use the maximum.  */
2214                   else if (subrange_p && TREE_CODE (gnu_high) == INTEGER_CST)
2215                     gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
2216
2217                   /* If the index type is a subrange and gnu_low a constant
2218                      that hasn't overflowed, we can use the minimum.  */
2219                   else if (subrange_p && TREE_CODE (gnu_low) == INTEGER_CST)
2220                     {
2221                       gnu_high = gnu_max;
2222                       gnu_min = size_binop (MIN_EXPR, gnu_min, gnu_low);
2223                     }
2224
2225                   else
2226                     gnu_high
2227                       = build_cond_expr (sizetype,
2228                                          build_binary_op (GE_EXPR,
2229                                                           boolean_type_node,
2230                                                           gnu_orig_max,
2231                                                           gnu_orig_min),
2232                                          gnu_max, gnu_high);
2233                 }
2234
2235               /* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound
2236                  in all the other cases.  Note that, here as well as above,
2237                  the condition used in the comparison must be equivalent to
2238                  the condition (length != 0).  This is relied upon in order
2239                  to optimize array comparisons in compare_arrays.  */
2240               else
2241                 gnu_high
2242                   = build_cond_expr (sizetype,
2243                                      build_binary_op (GE_EXPR,
2244                                                       boolean_type_node,
2245                                                       gnu_orig_max,
2246                                                       gnu_orig_min),
2247                                      gnu_max,
2248                                      size_binop (MINUS_EXPR, gnu_min,
2249                                                  size_one_node));
2250
2251               /* Reuse the index type for the range type.  Then make an index
2252                  type with the size range in sizetype.  */
2253               gnu_index_types[index]
2254                 = create_index_type (gnu_min, gnu_high, gnu_index_type,
2255                                      gnat_entity);
2256
2257               /* Update the maximum size of the array in elements.  Here we
2258                  see if any constraint on the index type of the base type
2259                  can be used in the case of self-referential bound on the
2260                  index type of the subtype.  We look for a non-"infinite"
2261                  and non-self-referential bound from any type involved and
2262                  handle each bound separately.  */
2263               if (gnu_max_size)
2264                 {
2265                   tree gnu_base_min = convert (sizetype, gnu_base_orig_min);
2266                   tree gnu_base_max = convert (sizetype, gnu_base_orig_max);
2267                   tree gnu_base_index_base_type
2268                     = get_base_type (gnu_base_index_type);
2269                   tree gnu_base_base_min
2270                     = convert (sizetype,
2271                                TYPE_MIN_VALUE (gnu_base_index_base_type));
2272                   tree gnu_base_base_max
2273                     = convert (sizetype,
2274                                TYPE_MAX_VALUE (gnu_base_index_base_type));
2275
2276                   if (!CONTAINS_PLACEHOLDER_P (gnu_min)
2277                       || !(TREE_CODE (gnu_base_min) == INTEGER_CST
2278                            && !TREE_OVERFLOW (gnu_base_min)))
2279                     gnu_base_min = gnu_min;
2280
2281                   if (!CONTAINS_PLACEHOLDER_P (gnu_max)
2282                       || !(TREE_CODE (gnu_base_max) == INTEGER_CST
2283                            && !TREE_OVERFLOW (gnu_base_max)))
2284                     gnu_base_max = gnu_max;
2285
2286                   if ((TREE_CODE (gnu_base_min) == INTEGER_CST
2287                        && TREE_OVERFLOW (gnu_base_min))
2288                       || operand_equal_p (gnu_base_min, gnu_base_base_min, 0)
2289                       || (TREE_CODE (gnu_base_max) == INTEGER_CST
2290                           && TREE_OVERFLOW (gnu_base_max))
2291                       || operand_equal_p (gnu_base_max, gnu_base_base_max, 0))
2292                     gnu_max_size = NULL_TREE;
2293                   else
2294                     {
2295                       tree gnu_this_max
2296                         = size_binop (MAX_EXPR,
2297                                       size_binop (PLUS_EXPR, size_one_node,
2298                                                   size_binop (MINUS_EXPR,
2299                                                               gnu_base_max,
2300                                                               gnu_base_min)),
2301                                       size_zero_node);
2302
2303                       if (TREE_CODE (gnu_this_max) == INTEGER_CST
2304                           && TREE_OVERFLOW (gnu_this_max))
2305                         gnu_max_size = NULL_TREE;
2306                       else
2307                         gnu_max_size
2308                           = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
2309                     }
2310                 }
2311
2312               /* We need special types for debugging information to point to
2313                  the index types if they have variable bounds, are not integer
2314                  types, are biased or are wider than sizetype.  */
2315               if (!integer_onep (gnu_orig_min)
2316                   || TREE_CODE (gnu_orig_max) != INTEGER_CST
2317                   || TREE_CODE (gnu_index_type) != INTEGER_TYPE
2318                   || (TREE_TYPE (gnu_index_type)
2319                       && TREE_CODE (TREE_TYPE (gnu_index_type))
2320                          != INTEGER_TYPE)
2321                   || TYPE_BIASED_REPRESENTATION_P (gnu_index_type)
2322                   || compare_tree_int (rm_size (gnu_index_type),
2323                                        TYPE_PRECISION (sizetype)) > 0)
2324                 need_index_type_struct = true;
2325             }
2326
2327           /* Then flatten: create the array of arrays.  For an array type
2328              used to implement a packed array, get the component type from
2329              the original array type since the representation clauses that
2330              can affect it are on the latter.  */
2331           if (Is_Packed_Array_Type (gnat_entity)
2332               && !Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
2333             {
2334               gnu_type = gnat_to_gnu_type (Original_Array_Type (gnat_entity));
2335               for (index = ndim - 1; index >= 0; index--)
2336                 gnu_type = TREE_TYPE (gnu_type);
2337
2338               /* One of the above calls might have caused us to be elaborated,
2339                  so don't blow up if so.  */
2340               if (present_gnu_tree (gnat_entity))
2341                 {
2342                   maybe_present = true;
2343                   break;
2344                 }
2345             }
2346           else
2347             {
2348               gnu_type = gnat_to_gnu_component_type (gnat_entity, definition,
2349                                                      debug_info_p);
2350
2351               /* One of the above calls might have caused us to be elaborated,
2352                  so don't blow up if so.  */
2353               if (present_gnu_tree (gnat_entity))
2354                 {
2355                   maybe_present = true;
2356                   break;
2357                 }
2358             }
2359
2360           /* Compute the maximum size of the array in units and bits.  */
2361           if (gnu_max_size)
2362             {
2363               gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
2364                                               TYPE_SIZE_UNIT (gnu_type));
2365               gnu_max_size = size_binop (MULT_EXPR,
2366                                          convert (bitsizetype, gnu_max_size),
2367                                          TYPE_SIZE (gnu_type));
2368             }
2369           else
2370             gnu_max_size_unit = NULL_TREE;
2371
2372           /* Now build the array type.  */
2373           for (index = ndim - 1; index >= 0; index --)
2374             {
2375               gnu_type = build_array_type (gnu_type, gnu_index_types[index]);
2376               TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
2377               if (array_type_has_nonaliased_component (gnu_type, gnat_entity))
2378                 TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
2379             }
2380
2381           /* Attach the TYPE_STUB_DECL in case we have a parallel type.  */
2382           TYPE_STUB_DECL (gnu_type)
2383             = create_type_stub_decl (gnu_entity_name, gnu_type);
2384
2385           /* If we are at file level and this is a multi-dimensional array,
2386              we need to make a variable corresponding to the stride of the
2387              inner dimensions.   */
2388           if (global_bindings_p () && ndim > 1)
2389             {
2390               tree gnu_st_name = get_identifier ("ST");
2391               tree gnu_arr_type;
2392
2393               for (gnu_arr_type = TREE_TYPE (gnu_type);
2394                    TREE_CODE (gnu_arr_type) == ARRAY_TYPE;
2395                    gnu_arr_type = TREE_TYPE (gnu_arr_type),
2396                    gnu_st_name = concat_name (gnu_st_name, "ST"))
2397                 {
2398                   tree eltype = TREE_TYPE (gnu_arr_type);
2399
2400                   TYPE_SIZE (gnu_arr_type)
2401                     = elaborate_expression_1 (TYPE_SIZE (gnu_arr_type),
2402                                               gnat_entity, gnu_st_name,
2403                                               definition, false);
2404
2405                   /* ??? For now, store the size as a multiple of the
2406                      alignment of the element type in bytes so that we
2407                      can see the alignment from the tree.  */
2408                   TYPE_SIZE_UNIT (gnu_arr_type)
2409                     = elaborate_expression_2 (TYPE_SIZE_UNIT (gnu_arr_type),
2410                                               gnat_entity,
2411                                               concat_name (gnu_st_name, "A_U"),
2412                                               definition, false,
2413                                               TYPE_ALIGN (eltype));
2414
2415                   /* ??? create_type_decl is not invoked on the inner types so
2416                      the MULT_EXPR node built above will never be marked.  */
2417                   MARK_VISITED (TYPE_SIZE_UNIT (gnu_arr_type));
2418                 }
2419             }
2420
2421           /* If we need to write out a record type giving the names of the
2422              bounds for debugging purposes, do it now and make the record
2423              type a parallel type.  This is not needed for a packed array
2424              since the bounds are conveyed by the original array type.  */
2425           if (need_index_type_struct
2426               && debug_info_p
2427               && !Is_Packed_Array_Type (gnat_entity))
2428             {
2429               tree gnu_bound_rec = make_node (RECORD_TYPE);
2430               tree gnu_field_list = NULL_TREE;
2431               tree gnu_field;
2432
2433               TYPE_NAME (gnu_bound_rec)
2434                 = create_concat_name (gnat_entity, "XA");
2435
2436               for (index = ndim - 1; index >= 0; index--)
2437                 {
2438                   tree gnu_index = TYPE_INDEX_TYPE (gnu_index_types[index]);
2439                   tree gnu_index_name = TYPE_NAME (gnu_index);
2440
2441                   if (TREE_CODE (gnu_index_name) == TYPE_DECL)
2442                     gnu_index_name = DECL_NAME (gnu_index_name);
2443
2444                   /* Make sure to reference the types themselves, and not just
2445                      their names, as the debugger may fall back on them.  */
2446                   gnu_field = create_field_decl (gnu_index_name, gnu_index,
2447                                                  gnu_bound_rec, NULL_TREE,
2448                                                  NULL_TREE, 0, 0);
2449                   TREE_CHAIN (gnu_field) = gnu_field_list;
2450                   gnu_field_list = gnu_field;
2451                 }
2452
2453               finish_record_type (gnu_bound_rec, gnu_field_list, 0, true);
2454               add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec);
2455             }
2456
2457           /* Otherwise, for a packed array, make the original array type a
2458              parallel type.  */
2459           else if (debug_info_p
2460                    && Is_Packed_Array_Type (gnat_entity)
2461                    && present_gnu_tree (Original_Array_Type (gnat_entity)))
2462             add_parallel_type (TYPE_STUB_DECL (gnu_type),
2463                                gnat_to_gnu_type
2464                                (Original_Array_Type (gnat_entity)));
2465
2466           TYPE_CONVENTION_FORTRAN_P (gnu_type) = convention_fortran_p;
2467           TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
2468             = (Is_Packed_Array_Type (gnat_entity)
2469                && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
2470
2471           /* If the size is self-referential and the maximum size doesn't
2472              overflow, use it.  */
2473           if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
2474               && gnu_max_size
2475               && !(TREE_CODE (gnu_max_size) == INTEGER_CST
2476                    && TREE_OVERFLOW (gnu_max_size))
2477               && !(TREE_CODE (gnu_max_size_unit) == INTEGER_CST
2478                    && TREE_OVERFLOW (gnu_max_size_unit)))
2479             {
2480               TYPE_SIZE (gnu_type) = size_binop (MIN_EXPR, gnu_max_size,
2481                                                  TYPE_SIZE (gnu_type));
2482               TYPE_SIZE_UNIT (gnu_type)
2483                 = size_binop (MIN_EXPR, gnu_max_size_unit,
2484                               TYPE_SIZE_UNIT (gnu_type));
2485             }
2486
2487           /* Set our alias set to that of our base type.  This gives all
2488              array subtypes the same alias set.  */
2489           relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY);
2490
2491           /* If this is a packed type, make this type the same as the packed
2492              array type, but do some adjusting in the type first.  */
2493           if (Present (Packed_Array_Type (gnat_entity)))
2494             {
2495               Entity_Id gnat_index;
2496               tree gnu_inner;
2497
2498               /* First finish the type we had been making so that we output
2499                  debugging information for it.  */
2500               if (Treat_As_Volatile (gnat_entity))
2501                 gnu_type
2502                   = build_qualified_type (gnu_type,
2503                                           TYPE_QUALS (gnu_type)
2504                                           | TYPE_QUAL_VOLATILE);
2505
2506               /* Make it artificial only if the base type was artificial too.
2507                  That's sort of "morally" true and will make it possible for
2508                  the debugger to look it up by name in DWARF, which is needed
2509                  in order to decode the packed array type.  */
2510               gnu_decl
2511                 = create_type_decl (gnu_entity_name, gnu_type, attr_list,
2512                                     !Comes_From_Source (Etype (gnat_entity))
2513                                     && !Comes_From_Source (gnat_entity),
2514                                     debug_info_p, gnat_entity);
2515
2516               /* Save it as our equivalent in case the call below elaborates
2517                  this type again.  */
2518               save_gnu_tree (gnat_entity, gnu_decl, false);
2519
2520               gnu_decl = gnat_to_gnu_entity (Packed_Array_Type (gnat_entity),
2521                                              NULL_TREE, 0);
2522               this_made_decl = true;
2523               gnu_type = TREE_TYPE (gnu_decl);
2524               save_gnu_tree (gnat_entity, NULL_TREE, false);
2525
2526               gnu_inner = gnu_type;
2527               while (TREE_CODE (gnu_inner) == RECORD_TYPE
2528                      && (TYPE_JUSTIFIED_MODULAR_P (gnu_inner)
2529                          || TYPE_PADDING_P (gnu_inner)))
2530                 gnu_inner = TREE_TYPE (TYPE_FIELDS (gnu_inner));
2531
2532               /* We need to attach the index type to the type we just made so
2533                  that the actual bounds can later be put into a template.  */
2534               if ((TREE_CODE (gnu_inner) == ARRAY_TYPE
2535                    && !TYPE_ACTUAL_BOUNDS (gnu_inner))
2536                   || (TREE_CODE (gnu_inner) == INTEGER_TYPE
2537                       && !TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner)))
2538                 {
2539                   if (TREE_CODE (gnu_inner) == INTEGER_TYPE)
2540                     {
2541                       /* The TYPE_ACTUAL_BOUNDS field is overloaded with the
2542                          TYPE_MODULUS for modular types so we make an extra
2543                          subtype if necessary.  */
2544                       if (TYPE_MODULAR_P (gnu_inner))
2545                         {
2546                           tree gnu_subtype
2547                             = make_unsigned_type (TYPE_PRECISION (gnu_inner));
2548                           TREE_TYPE (gnu_subtype) = gnu_inner;
2549                           TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
2550                           SET_TYPE_RM_MIN_VALUE (gnu_subtype,
2551                                                  TYPE_MIN_VALUE (gnu_inner));
2552                           SET_TYPE_RM_MAX_VALUE (gnu_subtype,
2553                                                  TYPE_MAX_VALUE (gnu_inner));
2554                           gnu_inner = gnu_subtype;
2555                         }
2556
2557                       TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner) = 1;
2558
2559 #ifdef ENABLE_CHECKING
2560                       /* Check for other cases of overloading.  */
2561                       gcc_assert (!TYPE_ACTUAL_BOUNDS (gnu_inner));
2562 #endif
2563                     }
2564
2565                   for (gnat_index = First_Index (gnat_entity);
2566                        Present (gnat_index);
2567                        gnat_index = Next_Index (gnat_index))
2568                     SET_TYPE_ACTUAL_BOUNDS
2569                       (gnu_inner,
2570                        tree_cons (NULL_TREE,
2571                                   get_unpadded_type (Etype (gnat_index)),
2572                                   TYPE_ACTUAL_BOUNDS (gnu_inner)));
2573
2574                   if (Convention (gnat_entity) != Convention_Fortran)
2575                     SET_TYPE_ACTUAL_BOUNDS
2576                       (gnu_inner, nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner)));
2577
2578                   if (TREE_CODE (gnu_type) == RECORD_TYPE
2579                       && TYPE_JUSTIFIED_MODULAR_P (gnu_type))
2580                     TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner;
2581                 }
2582             }
2583
2584           else
2585             /* Abort if packed array with no Packed_Array_Type field set.  */
2586             gcc_assert (!Is_Packed (gnat_entity));
2587         }
2588       break;
2589
2590     case E_String_Literal_Subtype:
2591       /* Create the type for a string literal.  */
2592       {
2593         Entity_Id gnat_full_type
2594           = (IN (Ekind (Etype (gnat_entity)), Private_Kind)
2595              && Present (Full_View (Etype (gnat_entity)))
2596              ? Full_View (Etype (gnat_entity)) : Etype (gnat_entity));
2597         tree gnu_string_type = get_unpadded_type (gnat_full_type);
2598         tree gnu_string_array_type
2599           = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_string_type))));
2600         tree gnu_string_index_type
2601           = get_base_type (TREE_TYPE (TYPE_INDEX_TYPE
2602                                       (TYPE_DOMAIN (gnu_string_array_type))));
2603         tree gnu_lower_bound
2604           = convert (gnu_string_index_type,
2605                      gnat_to_gnu (String_Literal_Low_Bound (gnat_entity)));
2606         int length = UI_To_Int (String_Literal_Length (gnat_entity));
2607         tree gnu_length = ssize_int (length - 1);
2608         tree gnu_upper_bound
2609           = build_binary_op (PLUS_EXPR, gnu_string_index_type,
2610                              gnu_lower_bound,
2611                              convert (gnu_string_index_type, gnu_length));
2612         tree gnu_index_type
2613           = create_index_type (convert (sizetype, gnu_lower_bound),
2614                                convert (sizetype, gnu_upper_bound),
2615                                create_range_type (gnu_string_index_type,
2616                                                   gnu_lower_bound,
2617                                                   gnu_upper_bound),
2618                                gnat_entity);
2619
2620         gnu_type
2621           = build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)),
2622                               gnu_index_type);
2623         if (array_type_has_nonaliased_component (gnu_type, gnat_entity))
2624           TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
2625         relate_alias_sets (gnu_type, gnu_string_type, ALIAS_SET_COPY);
2626       }
2627       break;
2628
2629     /* Record Types and Subtypes
2630
2631        The following fields are defined on record types:
2632
2633                 Has_Discriminants       True if the record has discriminants
2634                 First_Discriminant      Points to head of list of discriminants
2635                 First_Entity            Points to head of list of fields
2636                 Is_Tagged_Type          True if the record is tagged
2637
2638        Implementation of Ada records and discriminated records:
2639
2640        A record type definition is transformed into the equivalent of a C
2641        struct definition.  The fields that are the discriminants which are
2642        found in the Full_Type_Declaration node and the elements of the
2643        Component_List found in the Record_Type_Definition node.  The
2644        Component_List can be a recursive structure since each Variant of
2645        the Variant_Part of the Component_List has a Component_List.
2646
2647        Processing of a record type definition comprises starting the list of
2648        field declarations here from the discriminants and the calling the
2649        function components_to_record to add the rest of the fields from the
2650        component list and return the gnu type node.  The function
2651        components_to_record will call itself recursively as it traverses
2652        the tree.  */
2653
2654     case E_Record_Type:
2655       if (Has_Complex_Representation (gnat_entity))
2656         {
2657           gnu_type
2658             = build_complex_type
2659               (get_unpadded_type
2660                (Etype (Defining_Entity
2661                        (First (Component_Items
2662                                (Component_List
2663                                 (Type_Definition
2664                                  (Declaration_Node (gnat_entity)))))))));
2665
2666           break;
2667         }
2668
2669       {
2670         Node_Id full_definition = Declaration_Node (gnat_entity);
2671         Node_Id record_definition = Type_Definition (full_definition);
2672         Entity_Id gnat_field;
2673         tree gnu_field, gnu_field_list = NULL_TREE, gnu_get_parent;
2674         /* Set PACKED in keeping with gnat_to_gnu_field.  */
2675         int packed
2676           = Is_Packed (gnat_entity)
2677             ? 1
2678             : Component_Alignment (gnat_entity) == Calign_Storage_Unit
2679               ? -1
2680               : (Known_Alignment (gnat_entity)
2681                  || (Strict_Alignment (gnat_entity)
2682                      && Known_Static_Esize (gnat_entity)))
2683                 ? -2
2684                 : 0;
2685         bool has_discr = Has_Discriminants (gnat_entity);
2686         bool has_rep = Has_Specified_Layout (gnat_entity);
2687         bool all_rep = has_rep;
2688         bool is_extension
2689           = (Is_Tagged_Type (gnat_entity)
2690              && Nkind (record_definition) == N_Derived_Type_Definition);
2691         bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
2692
2693         /* See if all fields have a rep clause.  Stop when we find one
2694            that doesn't.  */
2695         if (all_rep)
2696           for (gnat_field = First_Entity (gnat_entity);
2697                Present (gnat_field);
2698                gnat_field = Next_Entity (gnat_field))
2699             if ((Ekind (gnat_field) == E_Component
2700                  || Ekind (gnat_field) == E_Discriminant)
2701                 && No (Component_Clause (gnat_field)))
2702               {
2703                 all_rep = false;
2704                 break;
2705               }
2706
2707         /* If this is a record extension, go a level further to find the
2708            record definition.  Also, verify we have a Parent_Subtype.  */
2709         if (is_extension)
2710           {
2711             if (!type_annotate_only
2712                 || Present (Record_Extension_Part (record_definition)))
2713               record_definition = Record_Extension_Part (record_definition);
2714
2715             gcc_assert (type_annotate_only
2716                         || Present (Parent_Subtype (gnat_entity)));
2717           }
2718
2719         /* Make a node for the record.  If we are not defining the record,
2720            suppress expanding incomplete types.  */
2721         gnu_type = make_node (tree_code_for_record_type (gnat_entity));
2722         TYPE_NAME (gnu_type) = gnu_entity_name;
2723         TYPE_PACKED (gnu_type) = (packed != 0) || has_rep;
2724
2725         if (!definition)
2726           {
2727             defer_incomplete_level++;
2728             this_deferred = true;
2729           }
2730
2731         /* If both a size and rep clause was specified, put the size in
2732            the record type now so that it can get the proper mode.  */
2733         if (has_rep && Known_Esize (gnat_entity))
2734           TYPE_SIZE (gnu_type) = UI_To_gnu (Esize (gnat_entity), sizetype);
2735
2736         /* Always set the alignment here so that it can be used to
2737            set the mode, if it is making the alignment stricter.  If
2738            it is invalid, it will be checked again below.  If this is to
2739            be Atomic, choose a default alignment of a word unless we know
2740            the size and it's smaller.  */
2741         if (Known_Alignment (gnat_entity))
2742           TYPE_ALIGN (gnu_type)
2743             = validate_alignment (Alignment (gnat_entity), gnat_entity, 0);
2744         else if (Is_Atomic (gnat_entity))
2745           TYPE_ALIGN (gnu_type)
2746             = esize >= BITS_PER_WORD ? BITS_PER_WORD : ceil_alignment (esize);
2747         /* If a type needs strict alignment, the minimum size will be the
2748            type size instead of the RM size (see validate_size).  Cap the
2749            alignment, lest it causes this type size to become too large.  */
2750         else if (Strict_Alignment (gnat_entity)
2751                  && Known_Static_Esize (gnat_entity))
2752           {
2753             unsigned int raw_size = UI_To_Int (Esize (gnat_entity));
2754             unsigned int raw_align = raw_size & -raw_size;
2755             if (raw_align < BIGGEST_ALIGNMENT)
2756               TYPE_ALIGN (gnu_type) = raw_align;
2757           }
2758         else
2759           TYPE_ALIGN (gnu_type) = 0;
2760
2761         /* If we have a Parent_Subtype, make a field for the parent.  If
2762            this record has rep clauses, force the position to zero.  */
2763         if (Present (Parent_Subtype (gnat_entity)))
2764           {
2765             Entity_Id gnat_parent = Parent_Subtype (gnat_entity);
2766             tree gnu_parent;
2767
2768             /* A major complexity here is that the parent subtype will
2769                reference our discriminants in its Discriminant_Constraint
2770                list.  But those must reference the parent component of this
2771                record which is of the parent subtype we have not built yet!
2772                To break the circle we first build a dummy COMPONENT_REF which
2773                represents the "get to the parent" operation and initialize
2774                each of those discriminants to a COMPONENT_REF of the above
2775                dummy parent referencing the corresponding discriminant of the
2776                base type of the parent subtype.  */
2777             gnu_get_parent = build3 (COMPONENT_REF, void_type_node,
2778                                      build0 (PLACEHOLDER_EXPR, gnu_type),
2779                                      build_decl (input_location,
2780                                                  FIELD_DECL, NULL_TREE,
2781                                                  void_type_node),
2782                                      NULL_TREE);
2783
2784             if (has_discr)
2785               for (gnat_field = First_Stored_Discriminant (gnat_entity);
2786                    Present (gnat_field);
2787                    gnat_field = Next_Stored_Discriminant (gnat_field))
2788                 if (Present (Corresponding_Discriminant (gnat_field)))
2789                   {
2790                     tree gnu_field
2791                       = gnat_to_gnu_field_decl (Corresponding_Discriminant
2792                                                 (gnat_field));
2793                     save_gnu_tree
2794                       (gnat_field,
2795                        build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
2796                                gnu_get_parent, gnu_field, NULL_TREE),
2797                        true);
2798                   }
2799
2800             /* Then we build the parent subtype.  If it has discriminants but
2801                the type itself has unknown discriminants, this means that it
2802                doesn't contain information about how the discriminants are
2803                derived from those of the ancestor type, so it cannot be used
2804                directly.  Instead it is built by cloning the parent subtype
2805                of the underlying record view of the type, for which the above
2806                derivation of discriminants has been made explicit.  */
2807             if (Has_Discriminants (gnat_parent)
2808                 && Has_Unknown_Discriminants (gnat_entity))
2809               {
2810                 Entity_Id gnat_uview = Underlying_Record_View (gnat_entity);
2811
2812                 /* If we are defining the type, the underlying record
2813                    view must already have been elaborated at this point.
2814                    Otherwise do it now as its parent subtype cannot be
2815                    technically elaborated on its own.  */
2816                 if (definition)
2817                   gcc_assert (present_gnu_tree (gnat_uview));
2818                 else
2819                   gnat_to_gnu_entity (gnat_uview, NULL_TREE, 0);
2820
2821                 gnu_parent = gnat_to_gnu_type (Parent_Subtype (gnat_uview));
2822
2823                 /* Substitute the "get to the parent" of the type for that
2824                    of its underlying record view in the cloned type.  */
2825                 for (gnat_field = First_Stored_Discriminant (gnat_uview);
2826                      Present (gnat_field);
2827                      gnat_field = Next_Stored_Discriminant (gnat_field))
2828                   if (Present (Corresponding_Discriminant (gnat_field)))
2829                     {
2830                       tree gnu_field = gnat_to_gnu_field_decl (gnat_field);
2831                       tree gnu_ref
2832                         = build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
2833                                   gnu_get_parent, gnu_field, NULL_TREE);
2834                       gnu_parent
2835                         = substitute_in_type (gnu_parent, gnu_field, gnu_ref);
2836                     }
2837               }
2838             else
2839               gnu_parent = gnat_to_gnu_type (gnat_parent);
2840
2841             /* Finally we fix up both kinds of twisted COMPONENT_REF we have
2842                initially built.  The discriminants must reference the fields
2843                of the parent subtype and not those of its base type for the
2844                placeholder machinery to properly work.  */
2845             if (has_discr)
2846               {
2847                 /* The actual parent subtype is the full view.  */
2848                 if (IN (Ekind (gnat_parent), Private_Kind))
2849                   {
2850                     if (Present (Full_View (gnat_parent)))
2851                       gnat_parent = Full_View (gnat_parent);
2852                     else
2853                       gnat_parent = Underlying_Full_View (gnat_parent);
2854                   }
2855
2856                 for (gnat_field = First_Stored_Discriminant (gnat_entity);
2857                      Present (gnat_field);
2858                      gnat_field = Next_Stored_Discriminant (gnat_field))
2859                   if (Present (Corresponding_Discriminant (gnat_field)))
2860                     {
2861                       Entity_Id field = Empty;
2862                       for (field = First_Stored_Discriminant (gnat_parent);
2863                            Present (field);
2864                            field = Next_Stored_Discriminant (field))
2865                         if (same_discriminant_p (gnat_field, field))
2866                           break;
2867                       gcc_assert (Present (field));
2868                       TREE_OPERAND (get_gnu_tree (gnat_field), 1)
2869                         = gnat_to_gnu_field_decl (field);
2870                     }
2871               }
2872
2873             /* The "get to the parent" COMPONENT_REF must be given its
2874                proper type...  */
2875             TREE_TYPE (gnu_get_parent) = gnu_parent;
2876
2877             /* ...and reference the _Parent field of this record.  */
2878             gnu_field
2879               = create_field_decl (parent_name_id,
2880                                    gnu_parent, gnu_type, 0,
2881                                    has_rep
2882                                    ? TYPE_SIZE (gnu_parent) : NULL_TREE,
2883                                    has_rep
2884                                    ? bitsize_zero_node : NULL_TREE,
2885                                    0, 1);
2886             DECL_INTERNAL_P (gnu_field) = 1;
2887             TREE_OPERAND (gnu_get_parent, 1) = gnu_field;
2888             TYPE_FIELDS (gnu_type) = gnu_field;
2889           }
2890
2891         /* Make the fields for the discriminants and put them into the record
2892            unless it's an Unchecked_Union.  */
2893         if (has_discr)
2894           for (gnat_field = First_Stored_Discriminant (gnat_entity);
2895                Present (gnat_field);
2896                gnat_field = Next_Stored_Discriminant (gnat_field))
2897             {
2898               /* If this is a record extension and this discriminant is the
2899                  renaming of another discriminant, we've handled it above.  */
2900               if (Present (Parent_Subtype (gnat_entity))
2901                   && Present (Corresponding_Discriminant (gnat_field)))
2902                 continue;
2903
2904               gnu_field
2905                 = gnat_to_gnu_field (gnat_field, gnu_type, packed, definition,
2906                                      debug_info_p);
2907
2908               /* Make an expression using a PLACEHOLDER_EXPR from the
2909                  FIELD_DECL node just created and link that with the
2910                  corresponding GNAT defining identifier.  */
2911               save_gnu_tree (gnat_field,
2912                              build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
2913                                      build0 (PLACEHOLDER_EXPR, gnu_type),
2914                                      gnu_field, NULL_TREE),
2915                              true);
2916
2917               if (!is_unchecked_union)
2918                 {
2919                   TREE_CHAIN (gnu_field) = gnu_field_list;
2920                   gnu_field_list = gnu_field;
2921                 }
2922             }
2923
2924         /* Add the fields into the record type and finish it up.  */
2925         components_to_record (gnu_type, Component_List (record_definition),
2926                               gnu_field_list, packed, definition, NULL,
2927                               false, all_rep, is_unchecked_union,
2928                               debug_info_p, false);
2929
2930         /* If it is passed by reference, force BLKmode to ensure that objects
2931            of this type will always be put in memory.  */
2932         if (Is_By_Reference_Type (gnat_entity))
2933           SET_TYPE_MODE (gnu_type, BLKmode);
2934
2935         /* We used to remove the associations of the discriminants and _Parent
2936            for validity checking but we may need them if there's a Freeze_Node
2937            for a subtype used in this record.  */
2938         TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
2939
2940         /* Fill in locations of fields.  */
2941         annotate_rep (gnat_entity, gnu_type);
2942
2943         /* If there are any entities in the chain corresponding to components
2944            that we did not elaborate, ensure we elaborate their types if they
2945            are Itypes.  */
2946         for (gnat_temp = First_Entity (gnat_entity);
2947              Present (gnat_temp);
2948              gnat_temp = Next_Entity (gnat_temp))
2949           if ((Ekind (gnat_temp) == E_Component
2950                || Ekind (gnat_temp) == E_Discriminant)
2951               && Is_Itype (Etype (gnat_temp))
2952               && !present_gnu_tree (gnat_temp))
2953             gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
2954
2955         /* If this is a record type associated with an exception definition,
2956            equate its fields to those of the standard exception type.  This
2957            will make it possible to convert between them.  */
2958         if (gnu_entity_name == exception_data_name_id)
2959           {
2960             tree gnu_std_field;
2961             for (gnu_field = TYPE_FIELDS (gnu_type),
2962                  gnu_std_field = TYPE_FIELDS (except_type_node);
2963                  gnu_field;
2964                  gnu_field = TREE_CHAIN (gnu_field),
2965                  gnu_std_field = TREE_CHAIN (gnu_std_field))
2966               SET_DECL_ORIGINAL_FIELD_TO_FIELD (gnu_field, gnu_std_field);
2967             gcc_assert (!gnu_std_field);
2968           }
2969       }
2970       break;
2971
2972     case E_Class_Wide_Subtype:
2973       /* If an equivalent type is present, that is what we should use.
2974          Otherwise, fall through to handle this like a record subtype
2975          since it may have constraints.  */
2976       if (gnat_equiv_type != gnat_entity)
2977         {
2978           gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0);
2979           maybe_present = true;
2980           break;
2981         }
2982
2983       /* ... fall through ... */
2984
2985     case E_Record_Subtype:
2986       /* If Cloned_Subtype is Present it means this record subtype has
2987          identical layout to that type or subtype and we should use
2988          that GCC type for this one.  The front end guarantees that
2989          the component list is shared.  */
2990       if (Present (Cloned_Subtype (gnat_entity)))
2991         {
2992           gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
2993                                          NULL_TREE, 0);
2994           maybe_present = true;
2995           break;
2996         }
2997
2998       /* Otherwise, first ensure the base type is elaborated.  Then, if we are
2999          changing the type, make a new type with each field having the type of
3000          the field in the new subtype but the position computed by transforming
3001          every discriminant reference according to the constraints.  We don't
3002          see any difference between private and non-private type here since
3003          derivations from types should have been deferred until the completion
3004          of the private type.  */
3005       else
3006         {
3007           Entity_Id gnat_base_type = Implementation_Base_Type (gnat_entity);
3008           tree gnu_base_type;
3009
3010           if (!definition)
3011             {
3012               defer_incomplete_level++;
3013               this_deferred = true;
3014             }
3015
3016           gnu_base_type = gnat_to_gnu_type (gnat_base_type);
3017
3018           if (present_gnu_tree (gnat_entity))
3019             {
3020               maybe_present = true;
3021               break;
3022             }
3023
3024           /* If this is a record subtype associated with a dispatch table,
3025              strip the suffix.  This is necessary to make sure 2 different
3026              subtypes associated with the imported and exported views of a
3027              dispatch table are properly merged in LTO mode.  */
3028           if (Is_Dispatch_Table_Entity (gnat_entity))
3029             {
3030               char *p;
3031               Get_Encoded_Name (gnat_entity);
3032               p = strchr (Name_Buffer, '_');
3033               gcc_assert (p);
3034               strcpy (p+2, "dtS");
3035               gnu_entity_name = get_identifier (Name_Buffer);
3036             }
3037
3038           /* When the subtype has discriminants and these discriminants affect
3039              the initial shape it has inherited, factor them in.  But for an
3040              Unchecked_Union (it must be an Itype), just return the type.
3041              We can't just test Is_Constrained because private subtypes without
3042              discriminants of types with discriminants with default expressions
3043              are Is_Constrained but aren't constrained!  */
3044           if (IN (Ekind (gnat_base_type), Record_Kind)
3045               && !Is_Unchecked_Union (gnat_base_type)
3046               && !Is_For_Access_Subtype (gnat_entity)
3047               && Is_Constrained (gnat_entity)
3048               && Has_Discriminants (gnat_entity)
3049               && Present (Discriminant_Constraint (gnat_entity))
3050               && Stored_Constraint (gnat_entity) != No_Elist)
3051             {
3052               tree gnu_subst_list
3053                 = build_subst_list (gnat_entity, gnat_base_type, definition);
3054               tree gnu_unpad_base_type, gnu_rep_part, gnu_variant_part, t;
3055               tree gnu_variant_list, gnu_pos_list, gnu_field_list = NULL_TREE;
3056               bool selected_variant = false;
3057               Entity_Id gnat_field;
3058
3059               gnu_type = make_node (RECORD_TYPE);
3060               TYPE_NAME (gnu_type) = gnu_entity_name;
3061
3062               /* Set the size, alignment and alias set of the new type to
3063                  match that of the old one, doing required substitutions.  */
3064               copy_and_substitute_in_size (gnu_type, gnu_base_type,
3065                                            gnu_subst_list);
3066
3067               if (TYPE_IS_PADDING_P (gnu_base_type))
3068                 gnu_unpad_base_type = TREE_TYPE (TYPE_FIELDS (gnu_base_type));
3069               else
3070                 gnu_unpad_base_type = gnu_base_type;
3071
3072               /* Look for a REP part in the base type.  */
3073               gnu_rep_part = get_rep_part (gnu_unpad_base_type);
3074
3075               /* Look for a variant part in the base type.  */
3076               gnu_variant_part = get_variant_part (gnu_unpad_base_type);
3077
3078               /* If there is a variant part, we must compute whether the
3079                  constraints statically select a particular variant.  If
3080                  so, we simply drop the qualified union and flatten the
3081                  list of fields.  Otherwise we'll build a new qualified
3082                  union for the variants that are still relevant.  */
3083               if (gnu_variant_part)
3084                 {
3085                   gnu_variant_list
3086                     = build_variant_list (TREE_TYPE (gnu_variant_part),
3087                                           gnu_subst_list, NULL_TREE);
3088
3089                   /* If all the qualifiers are unconditionally true, the
3090                      innermost variant is statically selected.  */
3091                   selected_variant = true;
3092                   for (t = gnu_variant_list; t; t = TREE_CHAIN (t))
3093                     if (!integer_onep (TREE_VEC_ELT (TREE_VALUE (t), 1)))
3094                       {
3095                         selected_variant = false;
3096                         break;
3097                       }
3098
3099                   /* Otherwise, create the new variants.  */
3100                   if (!selected_variant)
3101                     for (t = gnu_variant_list; t; t = TREE_CHAIN (t))
3102                       {
3103                         tree old_variant = TREE_PURPOSE (t);
3104                         tree new_variant = make_node (RECORD_TYPE);
3105                         TYPE_NAME (new_variant)
3106                           = DECL_NAME (TYPE_NAME (old_variant));
3107                         copy_and_substitute_in_size (new_variant, old_variant,
3108                                                      gnu_subst_list);
3109                         TREE_VEC_ELT (TREE_VALUE (t), 2) = new_variant;
3110                       }
3111                 }
3112               else
3113                 {
3114                   gnu_variant_list = NULL_TREE;
3115                   selected_variant = false;
3116                 }
3117
3118               gnu_pos_list
3119                 = build_position_list (gnu_unpad_base_type,
3120                                        gnu_variant_list && !selected_variant,
3121                                        size_zero_node, bitsize_zero_node,
3122                                        BIGGEST_ALIGNMENT, NULL_TREE);
3123
3124               for (gnat_field = First_Entity (gnat_entity);
3125                    Present (gnat_field);
3126                    gnat_field = Next_Entity (gnat_field))
3127                 if ((Ekind (gnat_field) == E_Component
3128                      || Ekind (gnat_field) == E_Discriminant)
3129                     && !(Present (Corresponding_Discriminant (gnat_field))
3130                          && Is_Tagged_Type (gnat_base_type))
3131                     && Underlying_Type (Scope (Original_Record_Component
3132                                                (gnat_field)))
3133                        == gnat_base_type)
3134                   {
3135                     Name_Id gnat_name = Chars (gnat_field);
3136                     Entity_Id gnat_old_field
3137                       = Original_Record_Component (gnat_field);
3138                     tree gnu_old_field
3139                       = gnat_to_gnu_field_decl (gnat_old_field);
3140                     tree gnu_context = DECL_CONTEXT (gnu_old_field);
3141                     tree gnu_field, gnu_field_type, gnu_size;
3142                     tree gnu_cont_type, gnu_last = NULL_TREE;
3143
3144                     /* If the type is the same, retrieve the GCC type from the
3145                        old field to take into account possible adjustments.  */
3146                     if (Etype (gnat_field) == Etype (gnat_old_field))
3147                       gnu_field_type = TREE_TYPE (gnu_old_field);
3148                     else
3149                       gnu_field_type = gnat_to_gnu_type (Etype (gnat_field));
3150
3151                     /* If there was a component clause, the field types must be
3152                        the same for the type and subtype, so copy the data from
3153                        the old field to avoid recomputation here.  Also if the
3154                        field is justified modular and the optimization in
3155                        gnat_to_gnu_field was applied.  */
3156                     if (Present (Component_Clause (gnat_old_field))
3157                         || (TREE_CODE (gnu_field_type) == RECORD_TYPE
3158                             && TYPE_JUSTIFIED_MODULAR_P (gnu_field_type)
3159                             && TREE_TYPE (TYPE_FIELDS (gnu_field_type))
3160                                == TREE_TYPE (gnu_old_field)))
3161                       {
3162                         gnu_size = DECL_SIZE (gnu_old_field);
3163                         gnu_field_type = TREE_TYPE (gnu_old_field);
3164                       }
3165
3166                     /* If the old field was packed and of constant size, we
3167                        have to get the old size here, as it might differ from
3168                        what the Etype conveys and the latter might overlap
3169                        onto the following field.  Try to arrange the type for
3170                        possible better packing along the way.  */
3171                     else if (DECL_PACKED (gnu_old_field)
3172                              && TREE_CODE (DECL_SIZE (gnu_old_field))
3173                                 == INTEGER_CST)
3174                       {
3175                         gnu_size = DECL_SIZE (gnu_old_field);
3176                         if (TREE_CODE (gnu_field_type) == RECORD_TYPE
3177                             && !TYPE_FAT_POINTER_P (gnu_field_type)
3178                             && host_integerp (TYPE_SIZE (gnu_field_type), 1))
3179                           gnu_field_type
3180                             = make_packable_type (gnu_field_type, true);
3181                       }
3182
3183                     else
3184                       gnu_size = TYPE_SIZE (gnu_field_type);
3185
3186                     /* If the context of the old field is the base type or its
3187                        REP part (if any), put the field directly in the new
3188                        type; otherwise look up the context in the variant list
3189                        and put the field either in the new type if there is a
3190                        selected variant or in one of the new variants.  */
3191                     if (gnu_context == gnu_unpad_base_type
3192                         || (gnu_rep_part
3193                             && gnu_context == TREE_TYPE (gnu_rep_part)))
3194                       gnu_cont_type = gnu_type;
3195                     else
3196                       {
3197                         t = purpose_member (gnu_context, gnu_variant_list);
3198                         if (t)
3199                           {
3200                             if (selected_variant)
3201                               gnu_cont_type = gnu_type;
3202                             else
3203                               gnu_cont_type = TREE_VEC_ELT (TREE_VALUE (t), 2);
3204                           }
3205                         else
3206                           /* The front-end may pass us "ghost" components if
3207                              it fails to recognize that a constrained subtype
3208                              is statically constrained.  Discard them.  */
3209                           continue;
3210                       }
3211
3212                     /* Now create the new field modeled on the old one.  */
3213                     gnu_field
3214                       = create_field_decl_from (gnu_old_field, gnu_field_type,
3215                                                 gnu_cont_type, gnu_size,
3216                                                 gnu_pos_list, gnu_subst_list);
3217
3218                     /* Put it in one of the new variants directly.  */
3219                     if (gnu_cont_type != gnu_type)
3220                       {
3221                         TREE_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type);
3222                         TYPE_FIELDS (gnu_cont_type) = gnu_field;
3223                       }
3224
3225                     /* To match the layout crafted in components_to_record,
3226                        if this is the _Tag or _Parent field, put it before
3227                        any other fields.  */
3228                     else if (gnat_name == Name_uTag
3229                              || gnat_name == Name_uParent)
3230                       gnu_field_list = chainon (gnu_field_list, gnu_field);
3231
3232                     /* Similarly, if this is the _Controller field, put
3233                        it before the other fields except for the _Tag or
3234                        _Parent field.  */
3235                     else if (gnat_name == Name_uController && gnu_last)
3236                       {
3237                         TREE_CHAIN (gnu_field) = TREE_CHAIN (gnu_last);
3238                         TREE_CHAIN (gnu_last) = gnu_field;
3239                       }
3240
3241                     /* Otherwise, if this is a regular field, put it after
3242                        the other fields.  */
3243                     else
3244                       {
3245                         TREE_CHAIN (gnu_field) = gnu_field_list;
3246                         gnu_field_list = gnu_field;
3247                         if (!gnu_last)
3248                           gnu_last = gnu_field;
3249                       }
3250
3251                     save_gnu_tree (gnat_field, gnu_field, false);
3252                   }
3253
3254               /* If there is a variant list and no selected variant, we need
3255                  to create the nest of variant parts from the old nest.  */
3256               if (gnu_variant_list && !selected_variant)
3257                 {
3258                   tree new_variant_part
3259                     = create_variant_part_from (gnu_variant_part,
3260                                                 gnu_variant_list, gnu_type,