OSDN Git Service

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