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