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