OSDN Git Service

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