OSDN Git Service

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