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