OSDN Git Service

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