gcc/ada/gcc-interface/decl.c

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