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);
 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);
 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                         gnu_decl = maybe_stable_expr;
 902                         /* ??? No DECL_EXPR is created so we need to mark
 903                            the expression manually lest it is shared.  */
 904                         if (global_bindings_p ())
 905                           mark_visited (&gnu_decl);
 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;
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             /* Make a range type with the new range in the Ada base type.
1889                Then make an index type with the new range in sizetype.  */
1890             gnu_index_types[index]
1891               = create_index_type (convert (sizetype, gnu_low),
1892                                    convert (sizetype, gnu_high),
1893                                    create_range_type (gnu_index_base_type,
1894                                                       gnu_low, gnu_high),
1895                                    gnat_entity);
1896
1897             /* Update the maximum size of the array in elements.  */
1898             if (gnu_max_size)
1899               {
1900                 tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
1901                 tree gnu_min
1902                   = convert (sizetype, TYPE_MIN_VALUE (gnu_index_type));
1903                 tree gnu_max
1904                   = convert (sizetype, TYPE_MAX_VALUE (gnu_index_type));
1905                 tree gnu_this_max
1906                   = size_binop (MAX_EXPR,
1907                                 size_binop (PLUS_EXPR, size_one_node,
1908                                             size_binop (MINUS_EXPR,
1909                                                         gnu_max, gnu_min)),
1910                                 size_zero_node);
1911
1912                 if (TREE_CODE (gnu_this_max) == INTEGER_CST
1913                     && TREE_OVERFLOW (gnu_this_max))
1914                   gnu_max_size = NULL_TREE;
1915                 else
1916                   gnu_max_size
1917                     = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
1918               }
1919
1920             TYPE_NAME (gnu_index_types[index])
1921               = create_concat_name (gnat_entity, field_name);
1922           }
1923
1924         for (index = 0; index < ndim; index++)
1925           gnu_template_fields
1926             = chainon (gnu_template_fields, gnu_temp_fields[index]);
1927
1928         /* Install all the fields into the template.  */
1929         finish_record_type (gnu_template_type, gnu_template_fields, 0, false);
1930         TYPE_READONLY (gnu_template_type) = 1;
1931
1932         /* Now make the array of arrays and update the pointer to the array
1933            in the fat pointer.  Note that it is the first field.  */
1934         tem = gnat_to_gnu_type (Component_Type (gnat_entity));
1935
1936         /* Try to get a smaller form of the component if needed.  */
1937         if ((Is_Packed (gnat_entity)
1938              || Has_Component_Size_Clause (gnat_entity))
1939             && !Is_Bit_Packed_Array (gnat_entity)
1940             && !Has_Aliased_Components (gnat_entity)
1941             && !Strict_Alignment (Component_Type (gnat_entity))
1942             && TREE_CODE (tem) == RECORD_TYPE
1943             && !TYPE_IS_FAT_POINTER_P (tem)
1944             && host_integerp (TYPE_SIZE (tem), 1))
1945           tem = make_packable_type (tem, false);
1946
1947         if (Has_Atomic_Components (gnat_entity))
1948           check_ok_for_atomic (tem, gnat_entity, true);
1949
1950         /* Get and validate any specified Component_Size, but if Packed,
1951            ignore it since the front end will have taken care of it.  */
1952         gnu_comp_size
1953           = validate_size (Component_Size (gnat_entity), tem,
1954                            gnat_entity,
1955                            (Is_Bit_Packed_Array (gnat_entity)
1956                             ? TYPE_DECL : VAR_DECL),
1957                            true, Has_Component_Size_Clause (gnat_entity));
1958
1959         /* If the component type is a RECORD_TYPE that has a self-referential
1960            size, use the maximum size.  */
1961         if (!gnu_comp_size
1962             && TREE_CODE (tem) == RECORD_TYPE
1963             && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (tem)))
1964           gnu_comp_size = max_size (TYPE_SIZE (tem), true);
1965
1966         if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity))
1967           {
1968             tree orig_tem = tem;
1969             unsigned int max_align;
1970
1971             /* If an alignment is specified, use it as a cap on the component
1972                type so that it can be honored for the whole type.  But ignore
1973                it for the original type of packed array types.  */
1974             if (No (Packed_Array_Type (gnat_entity))
1975                 && Known_Alignment (gnat_entity))
1976               max_align = validate_alignment (Alignment (gnat_entity),
1977                                               gnat_entity, 0);
1978             else
1979               max_align = 0;
1980
1981             tem = make_type_from_size (tem, gnu_comp_size, false);
1982             if (max_align > 0 && TYPE_ALIGN (tem) > max_align)
1983               tem = orig_tem;
1984             else
1985               orig_tem = tem;
1986
1987             tem = maybe_pad_type (tem, gnu_comp_size, 0, gnat_entity,
1988                                   "C_PAD", false, definition, true);
1989
1990             /* If a padding record was made, declare it now since it will
1991                never be declared otherwise.  This is necessary to ensure
1992                that its subtrees are properly marked.  */
1993             if (tem != orig_tem)
1994               create_type_decl (TYPE_NAME (tem), tem, NULL, true,
1995                                 debug_info_p, gnat_entity);
1996           }
1997
1998         if (Has_Volatile_Components (gnat_entity))
1999           tem = build_qualified_type (tem,
2000                                       TYPE_QUALS (tem) | TYPE_QUAL_VOLATILE);
2001
2002         /* If Component_Size is not already specified, annotate it with the
2003            size of the component.  */
2004         if (Unknown_Component_Size (gnat_entity))
2005           Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (tem)));
2006
2007         /* Compute the maximum size of the array in units and bits.  */
2008         if (gnu_max_size)
2009           {
2010             gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
2011                                             TYPE_SIZE_UNIT (tem));
2012             gnu_max_size = size_binop (MULT_EXPR,
2013                                        convert (bitsizetype, gnu_max_size),
2014                                        TYPE_SIZE (tem));
2015           }
2016         else
2017           gnu_max_size_unit = NULL_TREE;
2018
2019         /* Now build the array type.  */
2020         for (index = ndim - 1; index >= 0; index--)
2021           {
2022             tem = build_array_type (tem, gnu_index_types[index]);
2023             TYPE_MULTI_ARRAY_P (tem) = (index > 0);
2024             if (array_type_has_nonaliased_component (gnat_entity, tem))
2025               TYPE_NONALIASED_COMPONENT (tem) = 1;
2026           }
2027
2028         /* If an alignment is specified, use it if valid.  But ignore it
2029            for the original type of packed array types.  If the alignment
2030            was requested with an explicit alignment clause, state so.  */
2031         if (No (Packed_Array_Type (gnat_entity))
2032             && Known_Alignment (gnat_entity))
2033           {
2034             TYPE_ALIGN (tem)
2035               = validate_alignment (Alignment (gnat_entity), gnat_entity,
2036                                     TYPE_ALIGN (tem));
2037             if (Present (Alignment_Clause (gnat_entity)))
2038               TYPE_USER_ALIGN (tem) = 1;
2039           }
2040
2041         TYPE_CONVENTION_FORTRAN_P (tem) = convention_fortran_p;
2042         TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem);
2043
2044         /* The result type is an UNCONSTRAINED_ARRAY_TYPE that indicates the
2045            corresponding fat pointer.  */
2046         TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type)
2047           = TYPE_REFERENCE_TO (gnu_type) = gnu_fat_type;
2048         SET_TYPE_MODE (gnu_type, BLKmode);
2049         TYPE_ALIGN (gnu_type) = TYPE_ALIGN (tem);
2050         SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type);
2051
2052         /* If the maximum size doesn't overflow, use it.  */
2053         if (gnu_max_size
2054             && TREE_CODE (gnu_max_size) == INTEGER_CST
2055             && !TREE_OVERFLOW (gnu_max_size)
2056             && TREE_CODE (gnu_max_size_unit) == INTEGER_CST
2057             && !TREE_OVERFLOW (gnu_max_size_unit))
2058           {
2059             TYPE_SIZE (tem) = size_binop (MIN_EXPR, gnu_max_size,
2060                                           TYPE_SIZE (tem));
2061             TYPE_SIZE_UNIT (tem) = size_binop (MIN_EXPR, gnu_max_size_unit,
2062                                                TYPE_SIZE_UNIT (tem));
2063           }
2064
2065         create_type_decl (create_concat_name (gnat_entity, "XUA"),
2066                           tem, NULL, !Comes_From_Source (gnat_entity),
2067                           debug_info_p, gnat_entity);
2068
2069         /* Give the fat pointer type a name.  If this is a packed type, tell
2070            the debugger how to interpret the underlying bits.  */
2071         if (Present (Packed_Array_Type (gnat_entity)))
2072           gnat_name = Packed_Array_Type (gnat_entity);
2073         else
2074           gnat_name = gnat_entity;
2075         create_type_decl (create_concat_name (gnat_name, "XUP"),
2076                           gnu_fat_type, NULL, true,
2077                           debug_info_p, gnat_entity);
2078
2079        /* Create the type to be used as what a thin pointer designates: an
2080           record type for the object and its template with the field offsets
2081           shifted to have the template at a negative offset.  */
2082         tem = build_unc_object_type (gnu_template_type, tem,
2083                                      create_concat_name (gnat_name, "XUT"));
2084         shift_unc_components_for_thin_pointers (tem);
2085
2086         SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type);
2087         TYPE_OBJECT_RECORD_TYPE (gnu_type) = tem;
2088       }
2089       break;
2090
2091     case E_String_Subtype:
2092     case E_Array_Subtype:
2093
2094       /* This is the actual data type for array variables.  Multidimensional
2095          arrays are implemented as arrays of arrays.  Note that arrays which
2096          have sparse enumeration subtypes as index components create sparse
2097          arrays, which is obviously space inefficient but so much easier to
2098          code for now.
2099
2100          Also note that the subtype never refers to the unconstrained array
2101          type, which is somewhat at variance with Ada semantics.
2102
2103          First check to see if this is simply a renaming of the array type.
2104          If so, the result is the array type.  */
2105
2106       gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
2107       if (!Is_Constrained (gnat_entity))
2108         ;
2109       else
2110         {
2111           Entity_Id gnat_index, gnat_base_index;
2112           const bool convention_fortran_p
2113             = (Convention (gnat_entity) == Convention_Fortran);
2114           const int ndim = Number_Dimensions (gnat_entity);
2115           tree gnu_base_type = gnu_type;
2116           tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree));
2117           tree gnu_max_size = size_one_node, gnu_max_size_unit;
2118           bool need_index_type_struct = false;
2119           int index;
2120
2121           /* First create the GCC type for each index and find out whether
2122              special types are needed for debugging information.  */
2123           for (index = (convention_fortran_p ? ndim - 1 : 0),
2124                gnat_index = First_Index (gnat_entity),
2125                gnat_base_index
2126                  = First_Index (Implementation_Base_Type (gnat_entity));
2127                0 <= index && index < ndim;
2128                index += (convention_fortran_p ? - 1 : 1),
2129                gnat_index = Next_Index (gnat_index),
2130                gnat_base_index = Next_Index (gnat_base_index))
2131             {
2132               tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
2133               tree prec = TYPE_RM_SIZE (gnu_index_type);
2134               const bool wider_p
2135                 = (compare_tree_int (prec, TYPE_PRECISION (sizetype)) > 0
2136                    || (compare_tree_int (prec, TYPE_PRECISION (sizetype)) == 0
2137                        && TYPE_UNSIGNED (gnu_index_type)
2138                           != TYPE_UNSIGNED (sizetype)));
2139               tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
2140               tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
2141               tree gnu_min = convert (sizetype, gnu_orig_min);
2142               tree gnu_max = convert (sizetype, gnu_orig_max);
2143               tree gnu_base_index_type
2144                 = get_unpadded_type (Etype (gnat_base_index));
2145               tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type);
2146               tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type);
2147               tree gnu_high;
2148
2149               /* See if the base array type is already flat.  If it is, we
2150                  are probably compiling an ACATS test but it will cause the
2151                  code below to malfunction if we don't handle it specially.  */
2152               if (TREE_CODE (gnu_base_orig_min) == INTEGER_CST
2153                   && TREE_CODE (gnu_base_orig_max) == INTEGER_CST
2154                   && tree_int_cst_lt (gnu_base_orig_max, gnu_base_orig_min))
2155                 {
2156                   gnu_min = size_one_node;
2157                   gnu_max = size_zero_node;
2158                   gnu_high = gnu_max;
2159                 }
2160
2161               /* Similarly, if one of the values overflows in sizetype and the
2162                  range is null, use 1..0 for the sizetype bounds.  */
2163               else if (wider_p
2164                        && TREE_CODE (gnu_min) == INTEGER_CST
2165                        && TREE_CODE (gnu_max) == INTEGER_CST
2166                        && (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max))
2167                        && tree_int_cst_lt (gnu_orig_max, gnu_orig_min))
2168                 {
2169                   gnu_min = size_one_node;
2170                   gnu_max = size_zero_node;
2171                   gnu_high = gnu_max;
2172                 }
2173
2174               /* If the minimum and maximum values both overflow in sizetype,
2175                  but the difference in the original type does not overflow in
2176                  sizetype, ignore the overflow indication.  */
2177               else if (wider_p
2178                        && TREE_CODE (gnu_min) == INTEGER_CST
2179                        && TREE_CODE (gnu_max) == INTEGER_CST
2180                        && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
2181                        && !TREE_OVERFLOW
2182                            (convert (sizetype,
2183                                      fold_build2 (MINUS_EXPR, gnu_index_type,
2184                                                   gnu_orig_max,
2185                                                   gnu_orig_min))))
2186                 {
2187                   TREE_OVERFLOW (gnu_min) = 0;
2188                   TREE_OVERFLOW (gnu_max) = 0;
2189                   gnu_high = gnu_max;
2190                 }
2191
2192               /* Compute the size of this dimension in the general case.  We
2193                  need to provide GCC with an upper bound to use but have to
2194                  deal with the "superflat" case.  There are three ways to do
2195                  this.  If we can prove that the array can never be superflat,
2196                  we can just use the high bound of the index type.  */
2197               else if (Nkind (gnat_index) == N_Range
2198                        && cannot_be_superflat_p (gnat_index))
2199                 gnu_high = gnu_max;
2200
2201               /* Otherwise, if we can prove that the low bound minus one and
2202                  the high bound cannot overflow, we can just use the expression
2203                  MAX (hb, lb - 1).  Otherwise, we have to use the most general
2204                  expression (hb >= lb) ? hb : lb - 1.  Note that the comparison
2205                  must be done in the original index type, to avoid any overflow
2206                  during the conversion.  */
2207               else
2208                 {
2209                   gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node);
2210
2211                   /* If gnu_high is a constant that has overflowed, the bound
2212                      is the smallest integer so cannot be the maximum.  */
2213                   if (TREE_CODE (gnu_high) == INTEGER_CST
2214                       && TREE_OVERFLOW (gnu_high))
2215                     gnu_high = gnu_max;
2216
2217                   /* If the index type is not wider and gnu_high is a constant
2218                      that hasn't overflowed, we can use the maximum.  */
2219                   else if (!wider_p && TREE_CODE (gnu_high) == INTEGER_CST)
2220                     gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
2221
2222                   else
2223                     gnu_high
2224                       = build_cond_expr (sizetype,
2225                                          build_binary_op (GE_EXPR,
2226                                                           integer_type_node,
2227                                                           gnu_orig_max,
2228                                                           gnu_orig_min),
2229                                          gnu_max, gnu_high);
2230                 }
2231
2232               gnu_index_types[index]
2233                 = create_index_type (gnu_min, gnu_high, gnu_index_type,
2234                                      gnat_entity);
2235
2236               /* Update the maximum size of the array in elements.  Here we
2237                  see if any constraint on the index type of the base type
2238                  can be used in the case of self-referential bound on the
2239                  index type of the subtype.  We look for a non-"infinite"
2240                  and non-self-referential bound from any type involved and
2241                  handle each bound separately.  */
2242               if (gnu_max_size)
2243                 {
2244                   tree gnu_base_min = convert (sizetype, gnu_base_orig_min);
2245                   tree gnu_base_max = convert (sizetype, gnu_base_orig_max);
2246                   tree gnu_base_index_base_type
2247                     = get_base_type (gnu_base_index_type);
2248                   tree gnu_base_base_min
2249                     = convert (sizetype,
2250                                TYPE_MIN_VALUE (gnu_base_index_base_type));
2251                   tree gnu_base_base_max
2252                     = convert (sizetype,
2253                                TYPE_MAX_VALUE (gnu_base_index_base_type));
2254
2255                   if (!CONTAINS_PLACEHOLDER_P (gnu_min)
2256                       || !(TREE_CODE (gnu_base_min) == INTEGER_CST
2257                            && !TREE_OVERFLOW (gnu_base_min)))
2258                     gnu_base_min = gnu_min;
2259
2260                   if (!CONTAINS_PLACEHOLDER_P (gnu_max)
2261                       || !(TREE_CODE (gnu_base_max) == INTEGER_CST
2262                            && !TREE_OVERFLOW (gnu_base_max)))
2263                     gnu_base_max = gnu_max;
2264
2265                   if ((TREE_CODE (gnu_base_min) == INTEGER_CST
2266                        && TREE_OVERFLOW (gnu_base_min))
2267                       || operand_equal_p (gnu_base_min, gnu_base_base_min, 0)
2268                       || (TREE_CODE (gnu_base_max) == INTEGER_CST
2269                           && TREE_OVERFLOW (gnu_base_max))
2270                       || operand_equal_p (gnu_base_max, gnu_base_base_max, 0))
2271                     gnu_max_size = NULL_TREE;
2272                   else
2273                     {
2274                       tree gnu_this_max
2275                         = size_binop (MAX_EXPR,
2276                                       size_binop (PLUS_EXPR, size_one_node,
2277                                                   size_binop (MINUS_EXPR,
2278                                                               gnu_base_max,
2279                                                               gnu_base_min)),
2280                                       size_zero_node);
2281
2282                       if (TREE_CODE (gnu_this_max) == INTEGER_CST
2283                           && TREE_OVERFLOW (gnu_this_max))
2284                         gnu_max_size = NULL_TREE;
2285                       else
2286                         gnu_max_size
2287                           = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
2288                     }
2289                 }
2290
2291               /* We need special types for debugging information to point to
2292                  the index types if they have variable bounds, are not integer
2293                  types, are biased or are wider than sizetype.  */
2294               if (!integer_onep (gnu_orig_min)
2295                   || TREE_CODE (gnu_orig_max) != INTEGER_CST
2296                   || TREE_CODE (gnu_index_type) != INTEGER_TYPE
2297                   || (TREE_TYPE (gnu_index_type)
2298                       && TREE_CODE (TREE_TYPE (gnu_index_type))
2299                          != INTEGER_TYPE)
2300                   || TYPE_BIASED_REPRESENTATION_P (gnu_index_type)
2301                   || compare_tree_int (prec, TYPE_PRECISION (sizetype)) > 0)
2302                 need_index_type_struct = true;
2303             }
2304
2305           /* Then flatten: create the array of arrays.  For an array type
2306              used to implement a packed array, get the component type from
2307              the original array type since the representation clauses that
2308              can affect it are on the latter.  */
2309           if (Is_Packed_Array_Type (gnat_entity)
2310               && !Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
2311             {
2312               gnu_type = gnat_to_gnu_type (Original_Array_Type (gnat_entity));
2313               for (index = ndim - 1; index >= 0; index--)
2314                 gnu_type = TREE_TYPE (gnu_type);
2315
2316               /* One of the above calls might have caused us to be elaborated,
2317                  so don't blow up if so.  */
2318               if (present_gnu_tree (gnat_entity))
2319                 {
2320                   maybe_present = true;
2321                   break;
2322                 }
2323             }
2324           else
2325             {
2326               tree gnu_comp_size;
2327
2328               gnu_type = gnat_to_gnu_type (Component_Type (gnat_entity));
2329
2330               /* One of the above calls might have caused us to be elaborated,
2331                  so don't blow up if so.  */
2332               if (present_gnu_tree (gnat_entity))
2333                 {
2334                   maybe_present = true;
2335                   break;
2336                 }
2337
2338               /* Try to get a smaller form of the component if needed.  */
2339               if ((Is_Packed (gnat_entity)
2340                    || Has_Component_Size_Clause (gnat_entity))
2341                   && !Is_Bit_Packed_Array (gnat_entity)
2342                   && !Has_Aliased_Components (gnat_entity)
2343                   && !Strict_Alignment (Component_Type (gnat_entity))
2344                   && TREE_CODE (gnu_type) == RECORD_TYPE
2345                   && !TYPE_IS_FAT_POINTER_P (gnu_type)
2346                   && host_integerp (TYPE_SIZE (gnu_type), 1))
2347                 gnu_type = make_packable_type (gnu_type, false);
2348
2349               /* Get and validate any specified Component_Size, but if Packed,
2350                  ignore it since the front end will have taken care of it.  */
2351               gnu_comp_size
2352                 = validate_size (Component_Size (gnat_entity), gnu_type,
2353                                  gnat_entity,
2354                                  (Is_Bit_Packed_Array (gnat_entity)
2355                                   ? TYPE_DECL : VAR_DECL), true,
2356                                  Has_Component_Size_Clause (gnat_entity));
2357
2358               /* If the component type is a RECORD_TYPE that has a
2359                  self-referential size, use the maximum size.  */
2360               if (!gnu_comp_size
2361                   && TREE_CODE (gnu_type) == RECORD_TYPE
2362                   && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
2363                 gnu_comp_size = max_size (TYPE_SIZE (gnu_type), true);
2364
2365               if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity))
2366                 {
2367                   tree orig_gnu_type = gnu_type;
2368                   unsigned int max_align;
2369
2370                   /* If an alignment is specified, use it as a cap on the
2371                      component type so that it can be honored for the whole
2372                      type.  But ignore it for the original type of packed
2373                      array types.  */
2374                   if (No (Packed_Array_Type (gnat_entity))
2375                       && Known_Alignment (gnat_entity))
2376                     max_align = validate_alignment (Alignment (gnat_entity),
2377                                                     gnat_entity, 0);
2378                   else
2379                     max_align = 0;
2380
2381                   gnu_type
2382                     = make_type_from_size (gnu_type, gnu_comp_size, false);
2383                   if (max_align > 0 && TYPE_ALIGN (gnu_type) > max_align)
2384                     gnu_type = orig_gnu_type;
2385                   else
2386                     orig_gnu_type = gnu_type;
2387
2388                   gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0,
2389                                              gnat_entity, "C_PAD", false,
2390                                              definition, true);
2391
2392                   /* If a padding record was made, declare it now since it
2393                      will never be declared otherwise.  This is necessary
2394                      to ensure that its subtrees are properly marked.  */
2395                   if (gnu_type != orig_gnu_type)
2396                     create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL,
2397                                       true, debug_info_p, gnat_entity);
2398                 }
2399
2400               if (Has_Volatile_Components (Base_Type (gnat_entity)))
2401                 gnu_type = build_qualified_type (gnu_type,
2402                                                  (TYPE_QUALS (gnu_type)
2403                                                   | TYPE_QUAL_VOLATILE));
2404             }
2405
2406           /* Compute the maximum size of the array in units and bits.  */
2407           if (gnu_max_size)
2408             {
2409               gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
2410                                               TYPE_SIZE_UNIT (gnu_type));
2411               gnu_max_size = size_binop (MULT_EXPR,
2412                                          convert (bitsizetype, gnu_max_size),
2413                                          TYPE_SIZE (gnu_type));
2414             }
2415           else
2416             gnu_max_size_unit = NULL_TREE;
2417
2418           /* Now build the array type.  */
2419           for (index = ndim - 1; index >= 0; index --)
2420             {
2421               gnu_type = build_array_type (gnu_type, gnu_index_types[index]);
2422               TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
2423               if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
2424                 TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
2425             }
2426
2427           /* Attach the TYPE_STUB_DECL in case we have a parallel type.  */
2428           TYPE_STUB_DECL (gnu_type)
2429             = create_type_stub_decl (gnu_entity_name, gnu_type);
2430
2431           /* If we are at file level and this is a multi-dimensional array,
2432              we need to make a variable corresponding to the stride of the
2433              inner dimensions.   */
2434           if (global_bindings_p () && ndim > 1)
2435             {
2436               tree gnu_str_name = get_identifier ("ST");
2437               tree gnu_arr_type;
2438
2439               for (gnu_arr_type = TREE_TYPE (gnu_type);
2440                    TREE_CODE (gnu_arr_type) == ARRAY_TYPE;
2441                    gnu_arr_type = TREE_TYPE (gnu_arr_type),
2442                    gnu_str_name = concat_name (gnu_str_name, "ST"))
2443                 {
2444                   tree eltype = TREE_TYPE (gnu_arr_type);
2445
2446                   TYPE_SIZE (gnu_arr_type)
2447                     = elaborate_expression_1 (TYPE_SIZE (gnu_arr_type),
2448                                               gnat_entity, gnu_str_name,
2449                                               definition, false);
2450
2451                   /* ??? For now, store the size as a multiple of the
2452                      alignment of the element type in bytes so that we
2453                      can see the alignment from the tree.  */
2454                   TYPE_SIZE_UNIT (gnu_arr_type)
2455                     = build_binary_op
2456                       (MULT_EXPR, sizetype,
2457                        elaborate_expression_1
2458                        (build_binary_op (EXACT_DIV_EXPR, sizetype,
2459                                          TYPE_SIZE_UNIT (gnu_arr_type),
2460                                          size_int (TYPE_ALIGN (eltype)
2461                                                    / BITS_PER_UNIT)),
2462                         gnat_entity, concat_name (gnu_str_name, "A_U"),
2463                         definition, false),
2464                        size_int (TYPE_ALIGN (eltype) / BITS_PER_UNIT));
2465
2466                   /* ??? create_type_decl is not invoked on the inner types so
2467                      the MULT_EXPR node built above will never be marked.  */
2468                   mark_visited (&TYPE_SIZE_UNIT (gnu_arr_type));
2469                 }
2470             }
2471
2472           /* If we need to write out a record type giving the names of the
2473              bounds for debugging purposes, do it now and make the record
2474              type a parallel type.  This is not needed for a packed array
2475              since the bounds are conveyed by the original array type.  */
2476           if (need_index_type_struct
2477               && debug_info_p
2478               && !Is_Packed_Array_Type (gnat_entity))
2479             {
2480               tree gnu_bound_rec = make_node (RECORD_TYPE);
2481               tree gnu_field_list = NULL_TREE;
2482               tree gnu_field;
2483
2484               TYPE_NAME (gnu_bound_rec)
2485                 = create_concat_name (gnat_entity, "XA");
2486
2487               for (index = ndim - 1; index >= 0; index--)
2488                 {
2489                   tree gnu_index = TYPE_INDEX_TYPE (gnu_index_types[index]);
2490                   tree gnu_index_name = TYPE_NAME (gnu_index);
2491
2492                   if (TREE_CODE (gnu_index_name) == TYPE_DECL)
2493                     gnu_index_name = DECL_NAME (gnu_index_name);
2494
2495                   /* Make sure to reference the types themselves, and not just
2496                      their names, as the debugger may fall back on them.  */
2497                   gnu_field = create_field_decl (gnu_index_name, gnu_index,
2498                                                  gnu_bound_rec,
2499                                                  0, NULL_TREE, NULL_TREE, 0);
2500                   TREE_CHAIN (gnu_field) = gnu_field_list;
2501                   gnu_field_list = gnu_field;
2502                 }
2503
2504               finish_record_type (gnu_bound_rec, gnu_field_list, 0, false);
2505               add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec);
2506             }
2507
2508           /* Otherwise, for a packed array, make the original array type a
2509              parallel type.  */
2510           else if (debug_info_p
2511                    && Is_Packed_Array_Type (gnat_entity)
2512                    && present_gnu_tree (Original_Array_Type (gnat_entity)))
2513             add_parallel_type (TYPE_STUB_DECL (gnu_type),
2514                                gnat_to_gnu_type
2515                                (Original_Array_Type (gnat_entity)));
2516
2517           TYPE_CONVENTION_FORTRAN_P (gnu_type) = convention_fortran_p;
2518           TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
2519             = (Is_Packed_Array_Type (gnat_entity)
2520                && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
2521
2522           /* If the size is self-referential and the maximum size doesn't
2523              overflow, use it.  */
2524           if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
2525               && gnu_max_size
2526               && !(TREE_CODE (gnu_max_size) == INTEGER_CST
2527                    && TREE_OVERFLOW (gnu_max_size))
2528               && !(TREE_CODE (gnu_max_size_unit) == INTEGER_CST
2529                    && TREE_OVERFLOW (gnu_max_size_unit)))
2530             {
2531               TYPE_SIZE (gnu_type) = size_binop (MIN_EXPR, gnu_max_size,
2532                                                  TYPE_SIZE (gnu_type));
2533               TYPE_SIZE_UNIT (gnu_type)
2534                 = size_binop (MIN_EXPR, gnu_max_size_unit,
2535                               TYPE_SIZE_UNIT (gnu_type));
2536             }
2537
2538           /* Set our alias set to that of our base type.  This gives all
2539              array subtypes the same alias set.  */
2540           relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY);
2541
2542           /* If this is a packed type, make this type the same as the packed
2543              array type, but do some adjusting in the type first.  */
2544           if (Present (Packed_Array_Type (gnat_entity)))
2545             {
2546               Entity_Id gnat_index;
2547               tree gnu_inner;
2548
2549               /* First finish the type we had been making so that we output
2550                  debugging information for it.  */
2551               if (Treat_As_Volatile (gnat_entity))
2552                 gnu_type
2553                   = build_qualified_type (gnu_type,
2554                                           TYPE_QUALS (gnu_type)
2555                                           | TYPE_QUAL_VOLATILE);
2556
2557               /* Make it artificial only if the base type was artificial too.
2558                  That's sort of "morally" true and will make it possible for
2559                  the debugger to look it up by name in DWARF, which is needed
2560                  in order to decode the packed array type.  */
2561               gnu_decl
2562                 = create_type_decl (gnu_entity_name, gnu_type, attr_list,
2563                                     !Comes_From_Source (Etype (gnat_entity))
2564                                     && !Comes_From_Source (gnat_entity),
2565                                     debug_info_p, gnat_entity);
2566
2567               /* Save it as our equivalent in case the call below elaborates
2568                  this type again.  */
2569               save_gnu_tree (gnat_entity, gnu_decl, false);
2570
2571               gnu_decl = gnat_to_gnu_entity (Packed_Array_Type (gnat_entity),
2572                                              NULL_TREE, 0);
2573               this_made_decl = true;
2574               gnu_type = TREE_TYPE (gnu_decl);
2575               save_gnu_tree (gnat_entity, NULL_TREE, false);
2576
2577               gnu_inner = gnu_type;
2578               while (TREE_CODE (gnu_inner) == RECORD_TYPE
2579                      && (TYPE_JUSTIFIED_MODULAR_P (gnu_inner)
2580                          || TYPE_IS_PADDING_P (gnu_inner)))
2581                 gnu_inner = TREE_TYPE (TYPE_FIELDS (gnu_inner));
2582
2583               /* We need to attach the index type to the type we just made so
2584                  that the actual bounds can later be put into a template.  */
2585               if ((TREE_CODE (gnu_inner) == ARRAY_TYPE
2586                    && !TYPE_ACTUAL_BOUNDS (gnu_inner))
2587                   || (TREE_CODE (gnu_inner) == INTEGER_TYPE
2588                       && !TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner)))
2589                 {
2590                   if (TREE_CODE (gnu_inner) == INTEGER_TYPE)
2591                     {
2592                       /* The TYPE_ACTUAL_BOUNDS field is overloaded with the
2593                          TYPE_MODULUS for modular types so we make an extra
2594                          subtype if necessary.  */
2595                       if (TYPE_MODULAR_P (gnu_inner))
2596                         {
2597                           tree gnu_subtype
2598                             = make_unsigned_type (TYPE_PRECISION (gnu_inner));
2599                           TREE_TYPE (gnu_subtype) = gnu_inner;
2600                           TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
2601                           SET_TYPE_RM_MIN_VALUE (gnu_subtype,
2602                                                  TYPE_MIN_VALUE (gnu_inner));
2603                           SET_TYPE_RM_MAX_VALUE (gnu_subtype,
2604                                                  TYPE_MAX_VALUE (gnu_inner));
2605                           gnu_inner = gnu_subtype;
2606                         }
2607
2608                       TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner) = 1;
2609
2610 #ifdef ENABLE_CHECKING
2611                       /* Check for other cases of overloading.  */
2612                       gcc_assert (!TYPE_ACTUAL_BOUNDS (gnu_inner));
2613 #endif
2614                     }
2615
2616                   for (gnat_index = First_Index (gnat_entity);
2617                        Present (gnat_index);
2618                        gnat_index = Next_Index (gnat_index))
2619                     SET_TYPE_ACTUAL_BOUNDS
2620                       (gnu_inner,
2621                        tree_cons (NULL_TREE,
2622                                   get_unpadded_type (Etype (gnat_index)),
2623                                   TYPE_ACTUAL_BOUNDS (gnu_inner)));
2624
2625                   if (Convention (gnat_entity) != Convention_Fortran)
2626                     SET_TYPE_ACTUAL_BOUNDS
2627                       (gnu_inner, nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner)));
2628
2629                   if (TREE_CODE (gnu_type) == RECORD_TYPE
2630                       && TYPE_JUSTIFIED_MODULAR_P (gnu_type))
2631                     TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner;
2632                 }
2633             }
2634
2635           else
2636             /* Abort if packed array with no Packed_Array_Type field set.  */
2637             gcc_assert (!Is_Packed (gnat_entity));
2638         }
2639       break;
2640
2641     case E_String_Literal_Subtype:
2642       /* Create the type for a string literal.  */
2643       {
2644         Entity_Id gnat_full_type
2645           = (IN (Ekind (Etype (gnat_entity)), Private_Kind)
2646              && Present (Full_View (Etype (gnat_entity)))
2647              ? Full_View (Etype (gnat_entity)) : Etype (gnat_entity));
2648         tree gnu_string_type = get_unpadded_type (gnat_full_type);
2649         tree gnu_string_array_type
2650           = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_string_type))));
2651         tree gnu_string_index_type
2652           = get_base_type (TREE_TYPE (TYPE_INDEX_TYPE
2653                                       (TYPE_DOMAIN (gnu_string_array_type))));
2654         tree gnu_lower_bound
2655           = convert (gnu_string_index_type,
2656                      gnat_to_gnu (String_Literal_Low_Bound (gnat_entity)));
2657         int length = UI_To_Int (String_Literal_Length (gnat_entity));
2658         tree gnu_length = ssize_int (length - 1);
2659         tree gnu_upper_bound
2660           = build_binary_op (PLUS_EXPR, gnu_string_index_type,
2661                              gnu_lower_bound,
2662                              convert (gnu_string_index_type, gnu_length));
2663         tree gnu_index_type
2664           = create_index_type (convert (sizetype, gnu_lower_bound),
2665                                convert (sizetype, gnu_upper_bound),
2666                                create_range_type (gnu_string_index_type,
2667                                                   gnu_lower_bound,
2668                                                   gnu_upper_bound),
2669                                gnat_entity);
2670
2671         gnu_type
2672           = build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)),
2673                               gnu_index_type);
2674         if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
2675           TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
2676         relate_alias_sets (gnu_type, gnu_string_type, ALIAS_SET_COPY);
2677       }
2678       break;
2679
2680     /* Record Types and Subtypes
2681
2682        The following fields are defined on record types:
2683
2684                 Has_Discriminants       True if the record has discriminants
2685                 First_Discriminant      Points to head of list of discriminants
2686                 First_Entity            Points to head of list of fields
2687                 Is_Tagged_Type          True if the record is tagged
2688
2689        Implementation of Ada records and discriminated records:
2690
2691        A record type definition is transformed into the equivalent of a C
2692        struct definition.  The fields that are the discriminants which are
2693        found in the Full_Type_Declaration node and the elements of the
2694        Component_List found in the Record_Type_Definition node.  The
2695        Component_List can be a recursive structure since each Variant of
2696        the Variant_Part of the Component_List has a Component_List.
2697
2698        Processing of a record type definition comprises starting the list of
2699        field declarations here from the discriminants and the calling the
2700        function components_to_record to add the rest of the fields from the
2701        component list and return the gnu type node.  The function
2702        components_to_record will call itself recursively as it traverses
2703        the tree.  */
2704
2705     case E_Record_Type:
2706       if (Has_Complex_Representation (gnat_entity))
2707         {
2708           gnu_type
2709             = build_complex_type
2710               (get_unpadded_type
2711                (Etype (Defining_Entity
2712                        (First (Component_Items
2713                                (Component_List
2714                                 (Type_Definition
2715                                  (Declaration_Node (gnat_entity)))))))));
2716
2717           break;
2718         }
2719
2720       {
2721         Node_Id full_definition = Declaration_Node (gnat_entity);
2722         Node_Id record_definition = Type_Definition (full_definition);
2723         Entity_Id gnat_field;
2724         tree gnu_field, gnu_field_list = NULL_TREE, gnu_get_parent;
2725         /* Set PACKED in keeping with gnat_to_gnu_field.  */
2726         int packed
2727           = Is_Packed (gnat_entity)
2728             ? 1
2729             : Component_Alignment (gnat_entity) == Calign_Storage_Unit
2730               ? -1
2731               : (Known_Alignment (gnat_entity)
2732                  || (Strict_Alignment (gnat_entity)
2733                      && Known_Static_Esize (gnat_entity)))
2734                 ? -2
2735                 : 0;
2736         bool has_discr = Has_Discriminants (gnat_entity);
2737         bool has_rep = Has_Specified_Layout (gnat_entity);
2738         bool all_rep = has_rep;
2739         bool is_extension
2740           = (Is_Tagged_Type (gnat_entity)
2741              && Nkind (record_definition) == N_Derived_Type_Definition);
2742         bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
2743
2744         /* See if all fields have a rep clause.  Stop when we find one
2745            that doesn't.  */
2746         if (all_rep)
2747           for (gnat_field = First_Entity (gnat_entity);
2748                Present (gnat_field);
2749                gnat_field = Next_Entity (gnat_field))
2750             if ((Ekind (gnat_field) == E_Component
2751                  || Ekind (gnat_field) == E_Discriminant)
2752                 && No (Component_Clause (gnat_field)))
2753               {
2754                 all_rep = false;
2755                 break;
2756               }
2757
2758         /* If this is a record extension, go a level further to find the
2759            record definition.  Also, verify we have a Parent_Subtype.  */
2760         if (is_extension)
2761           {
2762             if (!type_annotate_only
2763                 || Present (Record_Extension_Part (record_definition)))
2764               record_definition = Record_Extension_Part (record_definition);
2765
2766             gcc_assert (type_annotate_only
2767                         || Present (Parent_Subtype (gnat_entity)));
2768           }
2769
2770         /* Make a node for the record.  If we are not defining the record,
2771            suppress expanding incomplete types.  */
2772         gnu_type = make_node (tree_code_for_record_type (gnat_entity));
2773         TYPE_NAME (gnu_type) = gnu_entity_name;
2774         TYPE_PACKED (gnu_type) = (packed != 0) || has_rep;
2775
2776         if (!definition)
2777           {
2778             defer_incomplete_level++;
2779             this_deferred = true;
2780           }
2781
2782         /* If both a size and rep clause was specified, put the size in
2783            the record type now so that it can get the proper mode.  */
2784         if (has_rep && Known_Esize (gnat_entity))
2785           TYPE_SIZE (gnu_type) = UI_To_gnu (Esize (gnat_entity), sizetype);
2786
2787         /* Always set the alignment here so that it can be used to
2788            set the mode, if it is making the alignment stricter.  If
2789            it is invalid, it will be checked again below.  If this is to
2790            be Atomic, choose a default alignment of a word unless we know
2791            the size and it's smaller.  */
2792         if (Known_Alignment (gnat_entity))
2793           TYPE_ALIGN (gnu_type)
2794             = validate_alignment (Alignment (gnat_entity), gnat_entity, 0);
2795         else if (Is_Atomic (gnat_entity))
2796           TYPE_ALIGN (gnu_type)
2797             = esize >= BITS_PER_WORD ? BITS_PER_WORD : ceil_alignment (esize);
2798         /* If a type needs strict alignment, the minimum size will be the
2799            type size instead of the RM size (see validate_size).  Cap the
2800            alignment, lest it causes this type size to become too large.  */
2801         else if (Strict_Alignment (gnat_entity)
2802                  && Known_Static_Esize (gnat_entity))
2803           {
2804             unsigned int raw_size = UI_To_Int (Esize (gnat_entity));
2805             unsigned int raw_align = raw_size & -raw_size;
2806             if (raw_align < BIGGEST_ALIGNMENT)
2807               TYPE_ALIGN (gnu_type) = raw_align;
2808           }
2809         else
2810           TYPE_ALIGN (gnu_type) = 0;
2811
2812         /* If we have a Parent_Subtype, make a field for the parent.  If
2813            this record has rep clauses, force the position to zero.  */
2814         if (Present (Parent_Subtype (gnat_entity)))
2815           {
2816             Entity_Id gnat_parent = Parent_Subtype (gnat_entity);
2817             tree gnu_parent;
2818
2819             /* A major complexity here is that the parent subtype will
2820                reference our discriminants in its Discriminant_Constraint
2821                list.  But those must reference the parent component of this
2822                record which is of the parent subtype we have not built yet!
2823                To break the circle we first build a dummy COMPONENT_REF which
2824                represents the "get to the parent" operation and initialize
2825                each of those discriminants to a COMPONENT_REF of the above
2826                dummy parent referencing the corresponding discriminant of the
2827                base type of the parent subtype.  */
2828             gnu_get_parent = build3 (COMPONENT_REF, void_type_node,
2829                                      build0 (PLACEHOLDER_EXPR, gnu_type),
2830                                      build_decl (input_location,
2831                                                  FIELD_DECL, NULL_TREE,
2832                                                  void_type_node),
2833                                      NULL_TREE);
2834
2835             if (has_discr)
2836               for (gnat_field = First_Stored_Discriminant (gnat_entity);
2837                    Present (gnat_field);
2838                    gnat_field = Next_Stored_Discriminant (gnat_field))
2839                 if (Present (Corresponding_Discriminant (gnat_field)))
2840                   save_gnu_tree
2841                     (gnat_field,
2842                      build3 (COMPONENT_REF,
2843                              get_unpadded_type (Etype (gnat_field)),
2844                              gnu_get_parent,
2845                              gnat_to_gnu_field_decl (Corresponding_Discriminant
2846                                                      (gnat_field)),
2847                              NULL_TREE),
2848                      true);
2849
2850             /* Then we build the parent subtype.  If it has discriminants but
2851                the type itself has unknown discriminants, this means that it
2852                doesn't contain information about how the discriminants are
2853                derived from those of the ancestor type, so it cannot be used
2854                directly.  Instead it is built by cloning the parent subtype
2855                of the underlying record view of the type, for which the above
2856                derivation of discriminants has been made explicit.  */
2857             if (Has_Discriminants (gnat_parent)
2858                 && Has_Unknown_Discriminants (gnat_entity))
2859               {
2860                 Entity_Id gnat_uview = Underlying_Record_View (gnat_entity);
2861
2862                 /* If we are defining the type, the underlying record
2863                    view must already have been elaborated at this point.
2864                    Otherwise do it now as its parent subtype cannot be
2865                    technically elaborated on its own.  */
2866                 if (definition)
2867                   gcc_assert (present_gnu_tree (gnat_uview));
2868                 else
2869                   gnat_to_gnu_entity (gnat_uview, NULL_TREE, 0);
2870
2871                 gnu_parent = gnat_to_gnu_type (Parent_Subtype (gnat_uview));
2872
2873                 /* Substitute the "get to the parent" of the type for that
2874                    of its underlying record view in the cloned type.  */
2875                 for (gnat_field = First_Stored_Discriminant (gnat_uview);
2876                      Present (gnat_field);
2877                      gnat_field = Next_Stored_Discriminant (gnat_field))
2878                   if (Present (Corresponding_Discriminant (gnat_field)))
2879                     {
2880                       tree gnu_field = gnat_to_gnu_field_decl (gnat_field);
2881                       tree gnu_ref
2882                         = build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
2883                                   gnu_get_parent, gnu_field, NULL_TREE);
2884                       gnu_parent
2885                         = substitute_in_type (gnu_parent, gnu_field, gnu_ref);
2886                     }
2887               }
2888             else
2889               gnu_parent = gnat_to_gnu_type (gnat_parent);
2890
2891             /* Finally we fix up both kinds of twisted COMPONENT_REF we have
2892                initially built.  The discriminants must reference the fields
2893                of the parent subtype and not those of its base type for the
2894                placeholder machinery to properly work.  */
2895             if (has_discr)
2896               {
2897                 /* The actual parent subtype is the full view.  */
2898                 if (IN (Ekind (gnat_parent), Private_Kind))
2899                   {
2900                     if (Present (Full_View (gnat_parent)))
2901                       gnat_parent = Full_View (gnat_parent);
2902                     else
2903                       gnat_parent = Underlying_Full_View (gnat_parent);
2904                   }
2905
2906                 for (gnat_field = First_Stored_Discriminant (gnat_entity);
2907                      Present (gnat_field);
2908                      gnat_field = Next_Stored_Discriminant (gnat_field))
2909                   if (Present (Corresponding_Discriminant (gnat_field)))
2910                     {
2911                       Entity_Id field = Empty;
2912                       for (field = First_Stored_Discriminant (gnat_parent);
2913                            Present (field);
2914                            field = Next_Stored_Discriminant (field))
2915                         if (same_discriminant_p (gnat_field, field))
2916                           break;
2917                       gcc_assert (Present (field));
2918                       TREE_OPERAND (get_gnu_tree (gnat_field), 1)
2919                         = gnat_to_gnu_field_decl (field);
2920                     }
2921               }
2922
2923             /* The "get to the parent" COMPONENT_REF must be given its
2924                proper type...  */
2925             TREE_TYPE (gnu_get_parent) = gnu_parent;
2926
2927             /* ...and reference the _Parent field of this record.  */
2928             gnu_field
2929               = create_field_decl (get_identifier
2930                                    (Get_Name_String (Name_uParent)),
2931                                    gnu_parent, gnu_type, 0,
2932                                    has_rep
2933                                    ? TYPE_SIZE (gnu_parent) : NULL_TREE,
2934                                    has_rep
2935                                    ? bitsize_zero_node : NULL_TREE, 1);
2936             DECL_INTERNAL_P (gnu_field) = 1;
2937             TREE_OPERAND (gnu_get_parent, 1) = gnu_field;
2938             TYPE_FIELDS (gnu_type) = gnu_field;
2939           }
2940
2941         /* Make the fields for the discriminants and put them into the record
2942            unless it's an Unchecked_Union.  */
2943         if (has_discr)
2944           for (gnat_field = First_Stored_Discriminant (gnat_entity);
2945                Present (gnat_field);
2946                gnat_field = Next_Stored_Discriminant (gnat_field))
2947             {
2948               /* If this is a record extension and this discriminant is the
2949                  renaming of another discriminant, we've handled it above.  */
2950               if (Present (Parent_Subtype (gnat_entity))
2951                   && Present (Corresponding_Discriminant (gnat_field)))
2952                 continue;
2953
2954               gnu_field
2955                 = gnat_to_gnu_field (gnat_field, gnu_type, packed, definition);
2956
2957               /* Make an expression using a PLACEHOLDER_EXPR from the
2958                  FIELD_DECL node just created and link that with the
2959                  corresponding GNAT defining identifier.  */
2960               save_gnu_tree (gnat_field,
2961                              build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
2962                                      build0 (PLACEHOLDER_EXPR, gnu_type),
2963                                      gnu_field, NULL_TREE),
2964                              true);
2965
2966               if (!is_unchecked_union)
2967                 {
2968                   TREE_CHAIN (gnu_field) = gnu_field_list;
2969                   gnu_field_list = gnu_field;
2970                 }
2971             }
2972
2973         /* Add the fields into the record type and finish it up.  */
2974         components_to_record (gnu_type, Component_List (record_definition),
2975                               gnu_field_list, packed, definition, NULL,
2976                               false, all_rep, false, is_unchecked_union);
2977
2978         /* If it is a tagged record force the type to BLKmode to insure that
2979            these objects will always be put in memory.  Likewise for limited
2980            record types.  */
2981         if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity))
2982           SET_TYPE_MODE (gnu_type, BLKmode);
2983
2984         /* We used to remove the associations of the discriminants and _Parent
2985            for validity checking but we may need them if there's a Freeze_Node
2986            for a subtype used in this record.  */
2987         TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
2988
2989         /* Fill in locations of fields.  */
2990         annotate_rep (gnat_entity, gnu_type);
2991
2992         /* If there are any entities in the chain corresponding to components
2993            that we did not elaborate, ensure we elaborate their types if they
2994            are Itypes.  */
2995         for (gnat_temp = First_Entity (gnat_entity);
2996              Present (gnat_temp);
2997              gnat_temp = Next_Entity (gnat_temp))
2998           if ((Ekind (gnat_temp) == E_Component
2999                || Ekind (gnat_temp) == E_Discriminant)
3000               && Is_Itype (Etype (gnat_temp))
3001               && !present_gnu_tree (gnat_temp))
3002             gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
3003       }
3004       break;
3005
3006     case E_Class_Wide_Subtype:
3007       /* If an equivalent type is present, that is what we should use.
3008          Otherwise, fall through to handle this like a record subtype
3009          since it may have constraints.  */
3010       if (gnat_equiv_type != gnat_entity)
3011         {
3012           gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0);
3013           maybe_present = true;
3014           break;
3015         }
3016
3017       /* ... fall through ... */
3018
3019     case E_Record_Subtype:
3020       /* If Cloned_Subtype is Present it means this record subtype has
3021          identical layout to that type or subtype and we should use
3022          that GCC type for this one.  The front end guarantees that
3023          the component list is shared.  */
3024       if (Present (Cloned_Subtype (gnat_entity)))
3025         {
3026           gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
3027                                          NULL_TREE, 0);
3028           maybe_present = true;
3029           break;
3030         }
3031
3032       /* Otherwise, first ensure the base type is elaborated.  Then, if we are
3033          changing the type, make a new type with each field having the type of
3034          the field in the new subtype but the position computed by transforming
3035          every discriminant reference according to the constraints.  We don't
3036          see any difference between private and non-private type here since
3037          derivations from types should have been deferred until the completion
3038          of the private type.  */
3039       else
3040         {
3041           Entity_Id gnat_base_type = Implementation_Base_Type (gnat_entity);
3042           tree gnu_base_type;
3043
3044           if (!definition)
3045             {
3046               defer_incomplete_level++;
3047               this_deferred = true;
3048             }
3049
3050           gnu_base_type = gnat_to_gnu_type (gnat_base_type);
3051
3052           if (present_gnu_tree (gnat_entity))
3053             {
3054               maybe_present = true;
3055               break;
3056             }
3057
3058           /* When the subtype has discriminants and these discriminants affect
3059              the initial shape it has inherited, factor them in.  But for the
3060              of an Unchecked_Union (it must be an Itype), just return the type.
3061
3062              We can't just test Is_Constrained because private subtypes without
3063              discriminants of types with discriminants with default expressions
3064              are Is_Constrained but aren't constrained!  */
3065           if (IN (Ekind (gnat_base_type), Record_Kind)
3066               && !Is_Unchecked_Union (gnat_base_type)
3067               && !Is_For_Access_Subtype (gnat_entity)
3068               && Is_Constrained (gnat_entity)
3069               && Has_Discriminants (gnat_entity)
3070               && Present (Discriminant_Constraint (gnat_entity))
3071               && Stored_Constraint (gnat_entity) != No_Elist)
3072             {
3073               tree gnu_subst_list
3074                 = build_subst_list (gnat_entity, gnat_base_type, definition);
3075               tree gnu_pos_list, gnu_field_list = NULL_TREE;
3076               tree gnu_unpad_base_type, t;
3077               Entity_Id gnat_field;
3078
3079               gnu_type = make_node (RECORD_TYPE);
3080               TYPE_NAME (gnu_type) = gnu_entity_name;
3081
3082               /* Set the size, alignment and alias set of the new type to
3083                  match that of the old one, doing required substitutions.
3084                  We do it this early because we need the size of the new
3085                  type below to discard old fields if necessary.  */
3086               TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_base_type);
3087               TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type);
3088               SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type));
3089               TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
3090               relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY);
3091
3092               if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
3093                 for (t = gnu_subst_list; t; t = TREE_CHAIN (t))
3094                   TYPE_SIZE (gnu_type)
3095                     = substitute_in_expr (TYPE_SIZE (gnu_type),
3096                                           TREE_PURPOSE (t),
3097                                           TREE_VALUE (t));
3098
3099               if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (gnu_type)))
3100                 for (t = gnu_subst_list; t; t = TREE_CHAIN (t))
3101                   TYPE_SIZE_UNIT (gnu_type)
3102                     = substitute_in_expr (TYPE_SIZE_UNIT (gnu_type),
3103                                           TREE_PURPOSE (t),
3104                                           TREE_VALUE (t));
3105
3106               if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type)))
3107                 for (t = gnu_subst_list; t; t = TREE_CHAIN (t))
3108                   SET_TYPE_ADA_SIZE
3109                     (gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type),
3110                                                    TREE_PURPOSE (t),
3111                                                    TREE_VALUE (t)));
3112
3113               if (TREE_CODE (gnu_base_type) == RECORD_TYPE
3114                   && TYPE_IS_PADDING_P (gnu_base_type))
3115                 gnu_unpad_base_type = TREE_TYPE (TYPE_FIELDS (gnu_base_type));
3116               else
3117                 gnu_unpad_base_type = gnu_base_type;
3118
3119               gnu_pos_list
3120                 = compute_field_positions (gnu_unpad_base_type, NULL_TREE,
3121                                            size_zero_node, bitsize_zero_node,
3122                                            BIGGEST_ALIGNMENT);
3123
3124               for (gnat_field = First_Entity (gnat_entity);
3125                    Present (gnat_field);
3126                    gnat_field = Next_Entity (gnat_field))
3127                 if ((Ekind (gnat_field) == E_Component
3128                      || Ekind (gnat_field) == E_Discriminant)
3129                     && !(Present (Corresponding_Discriminant (gnat_field))
3130                          && Is_Tagged_Type (gnat_base_type))
3131                     && Underlying_Type (Scope (Original_Record_Component
3132                                                (gnat_field)))
3133                        == gnat_base_type)
3134                   {
3135                     Name_Id gnat_name = Chars (gnat_field);
3136                     Entity_Id gnat_old_field
3137                       = Original_Record_Component (gnat_field);
3138                     tree gnu_old_field
3139                       = gnat_to_gnu_field_decl (gnat_old_field);
3140                     tree gnu_offset
3141                       = TREE_VALUE
3142                         (purpose_member (gnu_old_field, gnu_pos_list));
3143                     tree gnu_pos = TREE_PURPOSE (gnu_offset);
3144                     tree gnu_bitpos = TREE_VALUE (TREE_VALUE (gnu_offset));
3145                     tree gnu_field, gnu_field_type, gnu_size, gnu_new_pos;
3146                     tree gnu_last = NULL_TREE;
3147                     unsigned int offset_align
3148                       = tree_low_cst
3149                         (TREE_PURPOSE (TREE_VALUE (gnu_offset)), 1);
3150
3151                     /* If the type is the same, retrieve the GCC type from the
3152                        old field to take into account possible adjustments.  */
3153                     if (Etype (gnat_field) == Etype (gnat_old_field))
3154                       gnu_field_type = TREE_TYPE (gnu_old_field);
3155                     else
3156                       gnu_field_type = gnat_to_gnu_type (Etype (gnat_field));
3157
3158                     /* If there was a component clause, the field types must be
3159                        the same for the type and subtype, so copy the data from
3160                        the old field to avoid recomputation here.  Also if the
3161                        field is justified modular and the optimization in
3162                        gnat_to_gnu_field was applied.  */
3163                     if (Present (Component_Clause (gnat_old_field))
3164                         || (TREE_CODE (gnu_field_type) == RECORD_TYPE
3165                             && TYPE_JUSTIFIED_MODULAR_P (gnu_field_type)
3166                             && TREE_TYPE (TYPE_FIELDS (gnu_field_type))
3167                                == TREE_TYPE (gnu_old_field)))
3168                       {
3169                         gnu_size = DECL_SIZE (gnu_old_field);
3170                         gnu_field_type = TREE_TYPE (gnu_old_field);
3171                       }
3172
3173                     /* If the old field was packed and of constant size, we
3174                        have to get the old size here, as it might differ from
3175                        what the Etype conveys and the latter might overlap
3176                        onto the following field.  Try to arrange the type for
3177                        possible better packing along the way.  */
3178                     else if (DECL_PACKED (gnu_old_field)
3179                              && TREE_CODE (DECL_SIZE (gnu_old_field))
3180                                 == INTEGER_CST)
3181                       {
3182                         gnu_size = DECL_SIZE (gnu_old_field);
3183                         if (TREE_CODE (gnu_field_type) == RECORD_TYPE
3184                             && !TYPE_IS_FAT_POINTER_P (gnu_field_type)
3185                             && host_integerp (TYPE_SIZE (gnu_field_type), 1))
3186                           gnu_field_type
3187                             = make_packable_type (gnu_field_type, true);
3188                       }
3189
3190                     else
3191                       gnu_size = TYPE_SIZE (gnu_field_type);
3192
3193                     if (CONTAINS_PLACEHOLDER_P (gnu_pos))
3194                       for (t = gnu_subst_list; t; t = TREE_CHAIN (t))
3195                         gnu_pos = substitute_in_expr (gnu_pos,
3196                                                       TREE_PURPOSE (t),
3197                                                       TREE_VALUE (t));
3198
3199                     /* If the position is now a constant, we can set it as the
3200                        position of the field when we make it.  Otherwise, we
3201                        need to deal with it specially below.  */
3202                     if (TREE_CONSTANT (gnu_pos))
3203                       {
3204                         gnu_new_pos = bit_from_pos (gnu_pos, gnu_bitpos);
3205
3206                         /* Discard old fields that are outside the new type.
3207                            This avoids confusing code scanning it to decide
3208                            how to pass it to functions on some platforms.  */
3209                         if (TREE_CODE (gnu_new_pos) == INTEGER_CST
3210                             && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST
3211                             && !integer_zerop (gnu_size)
3212                             && !tree_int_cst_lt (gnu_new_pos,
3213                                                  TYPE_SIZE (gnu_type)))
3214                           continue;
3215                       }
3216                     else
3217                       gnu_new_pos = NULL_TREE;
3218
3219                     gnu_field
3220                       = create_field_decl
3221                         (DECL_NAME (gnu_old_field), gnu_field_type, gnu_type,
3222                          DECL_PACKED (gnu_old_field), gnu_size, gnu_new_pos,
3223                          !DECL_NONADDRESSABLE_P (gnu_old_field));
3224
3225                     if (!TREE_CONSTANT (gnu_pos))
3226                       {
3227                         normalize_offset (&gnu_pos, &gnu_bitpos, offset_align);
3228                         DECL_FIELD_OFFSET (gnu_field) = gnu_pos;
3229                         DECL_FIELD_BIT_OFFSET (gnu_field) = gnu_bitpos;
3230                         SET_DECL_OFFSET_ALIGN (gnu_field, offset_align);
3231                         DECL_SIZE (gnu_field) = gnu_size;
3232                         DECL_SIZE_UNIT (gnu_field)
3233                           = convert (sizetype,
3234                                      size_binop (CEIL_DIV_EXPR, gnu_size,
3235                                                  bitsize_unit_node));
3236                         layout_decl (gnu_field, DECL_OFFSET_ALIGN (gnu_field));
3237                       }
3238
3239                     DECL_INTERNAL_P (gnu_field)
3240                       = DECL_INTERNAL_P (gnu_old_field);
3241                     SET_DECL_ORIGINAL_FIELD
3242                       (gnu_field, (DECL_ORIGINAL_FIELD (gnu_old_field)
3243                                    ? DECL_ORIGINAL_FIELD (gnu_old_field)
3244                                    : gnu_old_field));
3245                     DECL_DISCRIMINANT_NUMBER (gnu_field)
3246                       = DECL_DISCRIMINANT_NUMBER (gnu_old_field);
3247                     TREE_THIS_VOLATILE (gnu_field)
3248                       = TREE_THIS_VOLATILE (gnu_old_field);
3249
3250                     /* To match the layout crafted in components_to_record,
3251                        if this is the _Tag or _Parent field,