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