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