OSDN Git Service

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