OSDN Git Service

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