OSDN Git Service

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