OSDN Git Service

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