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