Subversion Repositories openrisc

/****************************************************************************

 *                                                                          *

 *                         GNAT COMPILER COMPONENTS                         *

 *                                                                          *

 *                                 D E C L                                  *

 *                                                                          *

 *                          C Implementation File                           *

 *                                                                          *

 *          Copyright (C) 1992-2012, Free Software Foundation, Inc.         *

 *                                                                          *

 * GNAT is free software;  you can  redistribute it  and/or modify it under *

 * terms of the  GNU General Public License as published  by the Free Soft- *

 * ware  Foundation;  either version 3,  or (at your option) any later ver- *

 * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *

 * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *

 * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *

 * for  more details.  You should have received a copy of the GNU General   *

 * Public License along with GCC; see the file COPYING3.  If not see        *

 * <http://www.gnu.org/licenses/>.                                          *

 *                                                                          *

 * GNAT was originally developed  by the GNAT team at  New York University. *

 * Extensive contributions were provided by Ada Core Technologies Inc.      *

 *                                                                          *

 ****************************************************************************/

#include "config.h"

#include "system.h"

#include "coretypes.h"

#include "tm.h"

#include "tree.h"

#include "flags.h"

#include "toplev.h"

#include "ggc.h"

#include "target.h"

#include "tree-inline.h"

#include "ada.h"

#include "types.h"

#include "atree.h"

#include "elists.h"

#include "namet.h"

#include "nlists.h"

#include "repinfo.h"

#include "snames.h"

#include "stringt.h"

#include "uintp.h"

#include "fe.h"

#include "sinfo.h"

#include "einfo.h"

#include "ada-tree.h"

#include "gigi.h"

/* Convention_Stdcall should be processed in a specific way on 32 bits

   Windows targets only.  The macro below is a helper to avoid having to

   check for a Windows specific attribute throughout this unit.  */

#if TARGET_DLLIMPORT_DECL_ATTRIBUTES

#ifdef TARGET_64BIT

#define Has_Stdcall_Convention(E) \

  (!TARGET_64BIT && Convention (E) == Convention_Stdcall)

#else

#define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)

#endif

#else

#define Has_Stdcall_Convention(E) 0

#endif

/* Stack realignment is necessary for functions with foreign conventions when

   the ABI doesn't mandate as much as what the compiler assumes - that is, up

   to PREFERRED_STACK_BOUNDARY.

   Such realignment can be requested with a dedicated function type attribute

   on the targets that support it.  We define FOREIGN_FORCE_REALIGN_STACK to

   characterize the situations where the attribute should be set.  We rely on

   compiler configuration settings for 'main' to decide.  */

#ifdef MAIN_STACK_BOUNDARY

#define FOREIGN_FORCE_REALIGN_STACK \

  (MAIN_STACK_BOUNDARY < PREFERRED_STACK_BOUNDARY)

#else

#define FOREIGN_FORCE_REALIGN_STACK 0

#endif

struct incomplete

{

  struct incomplete *next;

  tree old_type;

  Entity_Id full_type;

};

/* These variables are used to defer recursively expanding incomplete types

   while we are processing an array, a record or a subprogram type.  */

static int defer_incomplete_level = 0;

static struct incomplete *defer_incomplete_list;

/* This variable is used to delay expanding From_With_Type types until the

   end of the spec.  */

static struct incomplete *defer_limited_with;

/* These variables are used to defer finalizing types.  The element of the

   list is the TYPE_DECL associated with the type.  */

static int defer_finalize_level = 0;

static VEC (tree,heap) *defer_finalize_list;

typedef struct subst_pair_d {

  tree discriminant;

  tree replacement;

} subst_pair;

DEF_VEC_O(subst_pair);

DEF_VEC_ALLOC_O(subst_pair,heap);

typedef struct variant_desc_d {

  /* The type of the variant.  */

  tree type;

  /* The associated field.  */

  tree field;

  /* The value of the qualifier.  */

  tree qual;

  /* The record associated with this variant.  */

  tree record;

} variant_desc;

DEF_VEC_O(variant_desc);

DEF_VEC_ALLOC_O(variant_desc,heap);

/* A hash table used to cache the result of annotate_value.  */

static GTY ((if_marked ("tree_int_map_marked_p"),

             param_is (struct tree_int_map))) htab_t annotate_value_cache;

enum alias_set_op

{

  ALIAS_SET_COPY,

  ALIAS_SET_SUBSET,

  ALIAS_SET_SUPERSET

};

static void relate_alias_sets (tree, tree, enum alias_set_op);

static bool allocatable_size_p (tree, bool);

static void prepend_one_attribute_to (struct attrib **,

                                      enum attr_type, tree, tree, Node_Id);

static void prepend_attributes (Entity_Id, struct attrib **);

static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);

static bool type_has_variable_size (tree);

static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);

static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool,

                                    unsigned int);

static tree make_packable_type (tree, bool);

static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);

static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,

                               bool *);

static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool);

static bool same_discriminant_p (Entity_Id, Entity_Id);

static bool array_type_has_nonaliased_component (tree, Entity_Id);

static bool compile_time_known_address_p (Node_Id);

static bool cannot_be_superflat_p (Node_Id);

static bool constructor_address_p (tree);

static void components_to_record (tree, Node_Id, tree, int, bool, bool, bool,

                                  bool, bool, bool, bool, bool, tree, tree *);

static Uint annotate_value (tree);

static void annotate_rep (Entity_Id, tree);

static tree build_position_list (tree, bool, tree, tree, unsigned int, tree);

static VEC(subst_pair,heap) *build_subst_list (Entity_Id, Entity_Id, bool);

static VEC(variant_desc,heap) *build_variant_list (tree,

                                                   VEC(subst_pair,heap) *,

                                                   VEC(variant_desc,heap) *);

static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);

static void set_rm_size (Uint, tree, Entity_Id);

static tree make_type_from_size (tree, tree, bool);

static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);

static unsigned int ceil_alignment (unsigned HOST_WIDE_INT);

static void check_ok_for_atomic (tree, Entity_Id, bool);

static tree create_field_decl_from (tree, tree, tree, tree, tree,

                                    VEC(subst_pair,heap) *);

static tree create_rep_part (tree, tree, tree);

static tree get_rep_part (tree);

static tree create_variant_part_from (tree, VEC(variant_desc,heap) *, tree,

                                      tree, VEC(subst_pair,heap) *);

static void copy_and_substitute_in_size (tree, tree, VEC(subst_pair,heap) *);

static void rest_of_type_decl_compilation_no_defer (tree);

/* The relevant constituents of a subprogram binding to a GCC builtin.  Used

   to pass around calls performing profile compatibility checks.  */

typedef struct {

  Entity_Id gnat_entity;  /* The Ada subprogram entity.  */

  tree ada_fntype;        /* The corresponding GCC type node.  */

  tree btin_fntype;       /* The GCC builtin function type node.  */

} intrin_binding_t;

static bool intrin_profiles_compatible_p (intrin_binding_t *);

/* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada

   entity, return the equivalent GCC tree for that entity (a ..._DECL node)

   and associate the ..._DECL node with the input GNAT defining identifier.

   If GNAT_ENTITY is a variable or a constant declaration, GNU_EXPR gives its

   initial value (in GCC tree form).  This is optional for a variable.  For

   a renamed entity, GNU_EXPR gives the object being renamed.

   DEFINITION is nonzero if this call is intended for a definition.  This is

   used for separate compilation where it is necessary to know whether an

   external declaration or a definition must be created if the GCC equivalent

   was not created previously.  The value of 1 is normally used for a nonzero

   DEFINITION, but a value of 2 is used in special circumstances, defined in

   the code.  */

tree

gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)

{

  /* Contains the kind of the input GNAT node.  */

  const Entity_Kind kind = Ekind (gnat_entity);

  /* True if this is a type.  */

  const bool is_type = IN (kind, Type_Kind);

  /* True if debug info is requested for this entity.  */

  const bool debug_info_p = Needs_Debug_Info (gnat_entity);

  /* True if this entity is to be considered as imported.  */

  const bool imported_p

    = (Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity)));

  /* For a type, contains the equivalent GNAT node to be used in gigi.  */

  Entity_Id gnat_equiv_type = Empty;

  /* Temporary used to walk the GNAT tree.  */

  Entity_Id gnat_temp;

  /* Contains the GCC DECL node which is equivalent to the input GNAT node.

     This node will be associated with the GNAT node by calling at the end

     of the `switch' statement.  */

  tree gnu_decl = NULL_TREE;

  /* Contains the GCC type to be used for the GCC node.  */

  tree gnu_type = NULL_TREE;

  /* Contains the GCC size tree to be used for the GCC node.  */

  tree gnu_size = NULL_TREE;

  /* Contains the GCC name to be used for the GCC node.  */

  tree gnu_entity_name;

  /* True if we have already saved gnu_decl as a GNAT association.  */

  bool saved = false;

  /* True if we incremented defer_incomplete_level.  */

  bool this_deferred = false;

  /* True if we incremented force_global.  */

  bool this_global = false;

  /* True if we should check to see if elaborated during processing.  */

  bool maybe_present = false;

  /* True if we made GNU_DECL and its type here.  */

  bool this_made_decl = false;

  /* Size and alignment of the GCC node, if meaningful.  */

  unsigned int esize = 0, align = 0;

  /* Contains the list of attributes directly attached to the entity.  */

  struct attrib *attr_list = NULL;

  /* Since a use of an Itype is a definition, process it as such if it

     is not in a with'ed unit.  */

  if (!definition

      && is_type

      && Is_Itype (gnat_entity)

      && !present_gnu_tree (gnat_entity)

      && In_Extended_Main_Code_Unit (gnat_entity))

    {

      /* Ensure that we are in a subprogram mentioned in the Scope chain of

         this entity, our current scope is global, or we encountered a task

         or entry (where we can't currently accurately check scoping).  */

      if (!current_function_decl

          || DECL_ELABORATION_PROC_P (current_function_decl))

        {

          process_type (gnat_entity);

          return get_gnu_tree (gnat_entity);

        }

      for (gnat_temp = Scope (gnat_entity);

           Present (gnat_temp);

           gnat_temp = Scope (gnat_temp))

        {

          if (Is_Type (gnat_temp))

            gnat_temp = Underlying_Type (gnat_temp);

          if (Ekind (gnat_temp) == E_Subprogram_Body)

            gnat_temp

              = Corresponding_Spec (Parent (Declaration_Node (gnat_temp)));

          if (IN (Ekind (gnat_temp), Subprogram_Kind)

              && Present (Protected_Body_Subprogram (gnat_temp)))

            gnat_temp = Protected_Body_Subprogram (gnat_temp);

          if (Ekind (gnat_temp) == E_Entry

              || Ekind (gnat_temp) == E_Entry_Family

              || Ekind (gnat_temp) == E_Task_Type

              || (IN (Ekind (gnat_temp), Subprogram_Kind)

                  && present_gnu_tree (gnat_temp)

                  && (current_function_decl

                      == gnat_to_gnu_entity (gnat_temp, NULL_TREE, 0))))

            {

              process_type (gnat_entity);

              return get_gnu_tree (gnat_entity);

            }

        }

      /* This abort means the Itype has an incorrect scope, i.e. that its

         scope does not correspond to the subprogram it is declared in.  */

      gcc_unreachable ();

    }

  /* If we've already processed this entity, return what we got last time.

     If we are defining the node, we should not have already processed it.

     In that case, we will abort below when we try to save a new GCC tree

     for this object.  We also need to handle the case of getting a dummy

     type when a Full_View exists.  */

  if ((!definition || (is_type && imported_p))

      && present_gnu_tree (gnat_entity))

    {

      gnu_decl = get_gnu_tree (gnat_entity);

      if (TREE_CODE (gnu_decl) == TYPE_DECL

          && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))

          && IN (kind, Incomplete_Or_Private_Kind)

          && Present (Full_View (gnat_entity)))

        {

          gnu_decl

            = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0);

          save_gnu_tree (gnat_entity, NULL_TREE, false);

          save_gnu_tree (gnat_entity, gnu_decl, false);

        }

      return gnu_decl;

    }

  /* If this is a numeric or enumeral type, or an access type, a nonzero

     Esize must be specified unless it was specified by the programmer.  */

  gcc_assert (!Unknown_Esize (gnat_entity)

              || Has_Size_Clause (gnat_entity)

              || (!IN (kind, Numeric_Kind)

                  && !IN (kind, Enumeration_Kind)

                  && (!IN (kind, Access_Kind)

                      || kind == E_Access_Protected_Subprogram_Type

                      || kind == E_Anonymous_Access_Protected_Subprogram_Type

                      || kind == E_Access_Subtype)));

  /* The RM size must be specified for all discrete and fixed-point types.  */

  gcc_assert (!(IN (kind, Discrete_Or_Fixed_Point_Kind)

                && Unknown_RM_Size (gnat_entity)));

  /* If we get here, it means we have not yet done anything with this entity.

     If we are not defining it, it must be a type or an entity that is defined

     elsewhere or externally, otherwise we should have defined it already.  */

  gcc_assert (definition

              || type_annotate_only

              || is_type

              || kind == E_Discriminant

              || kind == E_Component

              || kind == E_Label

              || (kind == E_Constant && Present (Full_View (gnat_entity)))

              || Is_Public (gnat_entity));

  /* Get the name of the entity and set up the line number and filename of

     the original definition for use in any decl we make.  */

  gnu_entity_name = get_entity_name (gnat_entity);

  Sloc_to_locus (Sloc (gnat_entity), &input_location);

  /* For cases when we are not defining (i.e., we are referencing from

     another compilation unit) public entities, show we are at global level

     for the purpose of computing scopes.  Don't do this for components or

     discriminants since the relevant test is whether or not the record is

     being defined.  Don't do this for constants either as we'll look into

     their defining expression in the local context.  */

  if (!definition

      && kind != E_Component

      && kind != E_Discriminant

      && kind != E_Constant

      && Is_Public (gnat_entity)

      && !Is_Statically_Allocated (gnat_entity))

    force_global++, this_global = true;

  /* Handle any attributes directly attached to the entity.  */

  if (Has_Gigi_Rep_Item (gnat_entity))

    prepend_attributes (gnat_entity, &attr_list);

  /* Do some common processing for types.  */

  if (is_type)

    {

      /* Compute the equivalent type to be used in gigi.  */

      gnat_equiv_type = Gigi_Equivalent_Type (gnat_entity);

      /* Machine_Attributes on types are expected to be propagated to

         subtypes.  The corresponding Gigi_Rep_Items are only attached

         to the first subtype though, so we handle the propagation here.  */

      if (Base_Type (gnat_entity) != gnat_entity

          && !Is_First_Subtype (gnat_entity)

          && Has_Gigi_Rep_Item (First_Subtype (Base_Type (gnat_entity))))

        prepend_attributes (First_Subtype (Base_Type (gnat_entity)),

                            &attr_list);

      /* Compute a default value for the size of the type.  */

      if (Known_Esize (gnat_entity)

          && UI_Is_In_Int_Range (Esize (gnat_entity)))

        {

          unsigned int max_esize;

          esize = UI_To_Int (Esize (gnat_entity));

          if (IN (kind, Float_Kind))

            max_esize = fp_prec_to_size (LONG_DOUBLE_TYPE_SIZE);

          else if (IN (kind, Access_Kind))

            max_esize = POINTER_SIZE * 2;

          else

            max_esize = LONG_LONG_TYPE_SIZE;

          if (esize > max_esize)

           esize = max_esize;

        }

    }

  switch (kind)

    {

    case E_Constant:

      /* If this is a use of a deferred constant without address clause,

         get its full definition.  */

      if (!definition

          && No (Address_Clause (gnat_entity))

          && Present (Full_View (gnat_entity)))

        {

          gnu_decl

            = gnat_to_gnu_entity (Full_View (gnat_entity), gnu_expr, 0);

          saved = true;

          break;

        }

      /* If we have an external constant that we are not defining, get the

         expression that is was defined to represent.  We may throw it away

         later if it is not a constant.  But do not retrieve the expression

         if it is an allocator because the designated type might be dummy

         at this point.  */

      if (!definition

          && !No_Initialization (Declaration_Node (gnat_entity))

          && Present (Expression (Declaration_Node (gnat_entity)))

          && Nkind (Expression (Declaration_Node (gnat_entity)))

             != N_Allocator)

        {

          bool went_into_elab_proc = false;

          /* The expression may contain N_Expression_With_Actions nodes and

             thus object declarations from other units.  In this case, even

             though the expression will eventually be discarded since not a

             constant, the declarations would be stuck either in the global

             varpool or in the current scope.  Therefore we force the local

             context and create a fake scope that we'll zap at the end.  */

          if (!current_function_decl)

            {

              current_function_decl = get_elaboration_procedure ();

              went_into_elab_proc = true;

            }

          gnat_pushlevel ();

          gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity)));

          gnat_zaplevel ();

          if (went_into_elab_proc)

            current_function_decl = NULL_TREE;

        }

      /* Ignore deferred constant definitions without address clause since

         they are processed fully in the front-end.  If No_Initialization

         is set, this is not a deferred constant but a constant whose value

         is built manually.  And constants that are renamings are handled

         like variables.  */

      if (definition

          && !gnu_expr

          && No (Address_Clause (gnat_entity))

          && !No_Initialization (Declaration_Node (gnat_entity))

          && No (Renamed_Object (gnat_entity)))

        {

          gnu_decl = error_mark_node;

          saved = true;

          break;

        }

      /* Ignore constant definitions already marked with the error node.  See

         the N_Object_Declaration case of gnat_to_gnu for the rationale.  */

      if (definition

          && gnu_expr

          && present_gnu_tree (gnat_entity)

          && get_gnu_tree (gnat_entity) == error_mark_node)

        {

          maybe_present = true;

          break;

        }

      goto object;

    case E_Exception:

      /* We used to special case VMS exceptions here to directly map them to

         their associated condition code.  Since this code had to be masked

         dynamically to strip off the severity bits, this caused trouble in

         the GCC/ZCX case because the "type" pointers we store in the tables

         have to be static.  We now don't special case here anymore, and let

         the regular processing take place, which leaves us with a regular

         exception data object for VMS exceptions too.  The condition code

         mapping is taken care of by the front end and the bitmasking by the

         run-time library.  */

      goto object;

    case E_Discriminant:

    case E_Component:

      {

        /* The GNAT record where the component was defined.  */

        Entity_Id gnat_record = Underlying_Type (Scope (gnat_entity));

        /* If the variable is an inherited record component (in the case of

           extended record types), just return the inherited entity, which

           must be a FIELD_DECL.  Likewise for discriminants.

           For discriminants of untagged records which have explicit

           stored discriminants, return the entity for the corresponding

           stored discriminant.  Also use Original_Record_Component

           if the record has a private extension.  */

        if (Present (Original_Record_Component (gnat_entity))

            && Original_Record_Component (gnat_entity) != gnat_entity)

          {

            gnu_decl

              = gnat_to_gnu_entity (Original_Record_Component (gnat_entity),

                                    gnu_expr, definition);

            saved = true;

            break;

          }

        /* If the enclosing record has explicit stored discriminants,

           then it is an untagged record.  If the Corresponding_Discriminant

           is not empty then this must be a renamed discriminant and its

           Original_Record_Component must point to the corresponding explicit

           stored discriminant (i.e. we should have taken the previous

           branch).  */

        else if (Present (Corresponding_Discriminant (gnat_entity))

                 && Is_Tagged_Type (gnat_record))

          {

            /* A tagged record has no explicit stored discriminants.  */

            gcc_assert (First_Discriminant (gnat_record)

                       == First_Stored_Discriminant (gnat_record));

            gnu_decl

              = gnat_to_gnu_entity (Corresponding_Discriminant (gnat_entity),

                                    gnu_expr, definition);

            saved = true;

            break;

          }

        else if (Present (CR_Discriminant (gnat_entity))

                 && type_annotate_only)

          {

            gnu_decl = gnat_to_gnu_entity (CR_Discriminant (gnat_entity),

                                           gnu_expr, definition);

            saved = true;

            break;

          }

        /* If the enclosing record has explicit stored discriminants, then

           it is an untagged record.  If the Corresponding_Discriminant

           is not empty then this must be a renamed discriminant and its

           Original_Record_Component must point to the corresponding explicit

           stored discriminant (i.e. we should have taken the first

           branch).  */

        else if (Present (Corresponding_Discriminant (gnat_entity))

                 && (First_Discriminant (gnat_record)

                     != First_Stored_Discriminant (gnat_record)))

          gcc_unreachable ();

        /* Otherwise, if we are not defining this and we have no GCC type

           for the containing record, make one for it.  Then we should

           have made our own equivalent.  */

        else if (!definition && !present_gnu_tree (gnat_record))

          {

            /* ??? If this is in a record whose scope is a protected

               type and we have an Original_Record_Component, use it.

               This is a workaround for major problems in protected type

               handling.  */

            Entity_Id Scop = Scope (Scope (gnat_entity));

            if ((Is_Protected_Type (Scop)

                 || (Is_Private_Type (Scop)

                     && Present (Full_View (Scop))

                     && Is_Protected_Type (Full_View (Scop))))

                && Present (Original_Record_Component (gnat_entity)))

              {

                gnu_decl

                  = gnat_to_gnu_entity (Original_Record_Component

                                        (gnat_entity),

                                        gnu_expr, 0);

                saved = true;

                break;

              }

            gnat_to_gnu_entity (Scope (gnat_entity), NULL_TREE, 0);

            gnu_decl = get_gnu_tree (gnat_entity);

            saved = true;

            break;

          }

        else

          /* Here we have no GCC type and this is a reference rather than a

             definition.  This should never happen.  Most likely the cause is

             reference before declaration in the gnat tree for gnat_entity.  */

          gcc_unreachable ();

      }

    case E_Loop_Parameter:

    case E_Out_Parameter:

    case E_Variable:

      /* Simple variables, loop variables, Out parameters and exceptions.  */

    object:

      {

        bool const_flag

          = ((kind == E_Constant || kind == E_Variable)

             && Is_True_Constant (gnat_entity)

             && !Treat_As_Volatile (gnat_entity)

             && (((Nkind (Declaration_Node (gnat_entity))

                   == N_Object_Declaration)

                  && Present (Expression (Declaration_Node (gnat_entity))))

                 || Present (Renamed_Object (gnat_entity))

                 || imported_p));

        bool inner_const_flag = const_flag;

        bool static_p = Is_Statically_Allocated (gnat_entity);

        bool mutable_p = false;

        bool used_by_ref = false;

        tree gnu_ext_name = NULL_TREE;

        tree renamed_obj = NULL_TREE;

        tree gnu_object_size;

        if (Present (Renamed_Object (gnat_entity)) && !definition)

          {

            if (kind == E_Exception)

              gnu_expr = gnat_to_gnu_entity (Renamed_Entity (gnat_entity),

                                             NULL_TREE, 0);

            else

              gnu_expr = gnat_to_gnu (Renamed_Object (gnat_entity));

          }

        /* Get the type after elaborating the renamed object.  */

        gnu_type = gnat_to_gnu_type (Etype (gnat_entity));

        /* If this is a standard exception definition, then use the standard

           exception type.  This is necessary to make sure that imported and

           exported views of exceptions are properly merged in LTO mode.  */

        if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL

            && DECL_NAME (TYPE_NAME (gnu_type)) == exception_data_name_id)

          gnu_type = except_type_node;

        /* For a debug renaming declaration, build a debug-only entity.  */

        if (Present (Debug_Renaming_Link (gnat_entity)))

          {

            /* Force a non-null value to make sure the symbol is retained.  */

            tree value = build1 (INDIRECT_REF, gnu_type,

                                 build1 (NOP_EXPR,

                                         build_pointer_type (gnu_type),

                                         integer_minus_one_node));

            gnu_decl = build_decl (input_location,

                                   VAR_DECL, gnu_entity_name, gnu_type);

            SET_DECL_VALUE_EXPR (gnu_decl, value);

            DECL_HAS_VALUE_EXPR_P (gnu_decl) = 1;

            gnat_pushdecl (gnu_decl, gnat_entity);

            break;

          }

        /* If this is a loop variable, its type should be the base type.

           This is because the code for processing a loop determines whether

           a normal loop end test can be done by comparing the bounds of the

           loop against those of the base type, which is presumed to be the

           size used for computation.  But this is not correct when the size

           of the subtype is smaller than the type.  */

        if (kind == E_Loop_Parameter)

          gnu_type = get_base_type (gnu_type);

        /* Reject non-renamed objects whose type is an unconstrained array or

           any object whose type is a dummy type or void.  */

        if ((TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE

             && No (Renamed_Object (gnat_entity)))

            || TYPE_IS_DUMMY_P (gnu_type)

            || TREE_CODE (gnu_type) == VOID_TYPE)

          {

            gcc_assert (type_annotate_only);

            if (this_global)

              force_global--;

            return error_mark_node;

          }

        /* If an alignment is specified, use it if valid.  Note that exceptions

           are objects but don't have an alignment.  We must do this before we

           validate the size, since the alignment can affect the size.  */

        if (kind != E_Exception && Known_Alignment (gnat_entity))

          {

            gcc_assert (Present (Alignment (gnat_entity)));

            align = validate_alignment (Alignment (gnat_entity), gnat_entity,

                                        TYPE_ALIGN (gnu_type));

            /* No point in changing the type if there is an address clause

               as the final type of the object will be a reference type.  */

            if (Present (Address_Clause (gnat_entity)))

              align = 0;

            else

              {

                tree orig_type = gnu_type;

                gnu_type

                  = maybe_pad_type (gnu_type, NULL_TREE, align, gnat_entity,

                                    false, false, definition, true);

                /* If a padding record was made, declare it now since it will

                   never be declared otherwise.  This is necessary to ensure

                   that its subtrees are properly marked.  */

                if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))

                  create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,

                                    debug_info_p, gnat_entity);

              }

          }