OSDN Git Service

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