* exp_disp.adb (Expand_Dispatching_Call): Propagate the convention on

[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / decl.c

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 1f9083a..c8b49e7 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *

- *          Copyright (C) 1992-2011, Free Software Foundation, Inc.         *
+ *          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- *
  *                                                                          *
  * 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- *


@@ -50,19 +50,23 @@
 #include "ada-tree.h"
 #include "gigi.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.  */
+/* "stdcall" and "thiscall" conventions should be processed in a specific way
+   on 32-bit x86/Windows only.  The macros below are helpers 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)
 
 #if TARGET_DLLIMPORT_DECL_ATTRIBUTES
 #ifdef TARGET_64BIT
 #define Has_Stdcall_Convention(E) \
   (!TARGET_64BIT && Convention (E) == Convention_Stdcall)

+#define Has_Thiscall_Convention(E) \
+  (!TARGET_64BIT && is_cplusplus_method (E))

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

+#define Has_Thiscall_Convention(E) (is_cplusplus_method (E))

 #endif
 #else
 #define Has_Stdcall_Convention(E) 0
 #endif
 #else
 #define Has_Stdcall_Convention(E) 0

+#define Has_Thiscall_Convention(E) 0

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


@@ -120,8 +124,8 @@ typedef struct variant_desc_d {
   /* The value of the qualifier.  */
   tree qual;
 
   /* The value of the qualifier.  */
   tree qual;
 

-  /* The record associated with this variant.  */
-  tree record;
+  /* The type of the variant after transformation.  */
+  tree new_type;

 } variant_desc;
 
 DEF_VEC_O(variant_desc);
 } variant_desc;
 
 DEF_VEC_O(variant_desc);


@@ -145,7 +149,7 @@ 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);
                                      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 is_variable_size (tree);
+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 elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);
 static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool,
                                    unsigned int);


@@ -160,7 +164,7 @@ 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,
 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, tree *);
+                                 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 Uint annotate_value (tree);
 static void annotate_rep (Entity_Id, tree);
 static tree build_position_list (tree, bool, tree, tree, unsigned int, tree);


@@ -176,6 +180,7 @@ 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 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 tree get_rep_part (tree);
 static tree create_variant_part_from (tree, VEC(variant_desc,heap) *, tree,
                                      tree, VEC(subst_pair,heap) *);


@@ -406,8 +411,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          if (esize > max_esize)
           esize = max_esize;
        }
          if (esize > max_esize)
           esize = max_esize;
        }

-      else
-       esize = LONG_LONG_TYPE_SIZE;

     }
 
   switch (kind)
     }
 
   switch (kind)


@@ -779,6 +782,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                gnu_size = max_size (TYPE_SIZE (gnu_type), true);
                mutable_p = true;
              }
                gnu_size = max_size (TYPE_SIZE (gnu_type), true);
                mutable_p = true;
              }

+
+           /* If we are at global level and the size isn't constant, call
+              elaborate_expression_1 to make a variable for it rather than
+              calculating it each time.  */
+           if (global_bindings_p () && !TREE_CONSTANT (gnu_size))
+             gnu_size = elaborate_expression_1 (gnu_size, gnat_entity,
+                                                get_identifier ("SIZE"),
+                                                definition, false);

          }
 
        /* If the size is zero byte, make it one byte since some linkers have
          }
 
        /* If the size is zero byte, make it one byte since some linkers have


@@ -819,16 +830,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                    && No (Address_Clause (gnat_entity))))
            && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST)
          {
                    && No (Address_Clause (gnat_entity))))
            && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST)
          {

-           /* No point in jumping through all the hoops needed in order
+           unsigned int size_cap, align_cap;
+
+           /* No point in promoting the alignment if this doesn't prevent
+              BLKmode access to the object, in particular block copy, as
+              this will for example disable the NRV optimization for it.
+              No point in jumping through all the hoops needed in order

               to support BIGGEST_ALIGNMENT if we don't really have to.
               So we cap to the smallest alignment that corresponds to
               a known efficient memory access pattern of the target.  */
               to support BIGGEST_ALIGNMENT if we don't really have to.
               So we cap to the smallest alignment that corresponds to
               a known efficient memory access pattern of the target.  */

-           unsigned int align_cap = Is_Atomic (gnat_entity)
-                                    ? BIGGEST_ALIGNMENT
-                                    : get_mode_alignment (ptr_mode);
+           if (Is_Atomic (gnat_entity))
+             {
+               size_cap = UINT_MAX;
+               align_cap = BIGGEST_ALIGNMENT;
+             }
+           else
+             {
+               size_cap = MAX_FIXED_MODE_SIZE;
+               align_cap = get_mode_alignment (ptr_mode);
+             }

 
            if (!host_integerp (TYPE_SIZE (gnu_type), 1)
 
            if (!host_integerp (TYPE_SIZE (gnu_type), 1)

-               || compare_tree_int (TYPE_SIZE (gnu_type), align_cap) >= 0)
+               || compare_tree_int (TYPE_SIZE (gnu_type), size_cap) > 0)
+             align = 0;
+           else if (compare_tree_int (TYPE_SIZE (gnu_type), align_cap) > 0)

              align = align_cap;
            else
              align = ceil_alignment (tree_low_cst (TYPE_SIZE (gnu_type), 1));
              align = align_cap;
            else
              align = ceil_alignment (tree_low_cst (TYPE_SIZE (gnu_type), 1));


@@ -876,10 +901,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            && Is_Array_Type (Etype (gnat_entity))
            && !type_annotate_only)
          {
            && Is_Array_Type (Etype (gnat_entity))
            && !type_annotate_only)
          {

-           tree gnu_fat
-             = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
+           tree gnu_array
+             = gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));

            gnu_type
            gnu_type

-             = build_unc_object_type_from_ptr (gnu_fat, gnu_type,
+             = build_unc_object_type_from_ptr (TREE_TYPE (gnu_array),
+                                               gnu_type,

                                                concat_name (gnu_entity_name,
                                                             "UNC"),
                                                debug_info_p);
                                                concat_name (gnu_entity_name,
                                                             "UNC"),
                                                debug_info_p);


@@ -937,10 +963,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            if ((TREE_CODE (gnu_expr) == COMPONENT_REF
                 && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))))
                /* Strip useless conversions around the object.  */
            if ((TREE_CODE (gnu_expr) == COMPONENT_REF
                 && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))))
                /* Strip useless conversions around the object.  */

-               || (TREE_CODE (gnu_expr) == NOP_EXPR
-                   && gnat_types_compatible_p
-                      (TREE_TYPE (gnu_expr),
-                       TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))))
+               || gnat_useless_type_conversion (gnu_expr))

              {
                gnu_expr = TREE_OPERAND (gnu_expr, 0);
                gnu_type = TREE_TYPE (gnu_expr);
              {
                gnu_expr = TREE_OPERAND (gnu_expr, 0);
                gnu_type = TREE_TYPE (gnu_expr);


@@ -998,6 +1021,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                        saved = true;
                        annotate_object (gnat_entity, gnu_type, NULL_TREE,
                                         false, false);
                        saved = true;
                        annotate_object (gnat_entity, gnu_type, NULL_TREE,
                                         false, false);

+                       /* This assertion will fail if the renamed object
+                          isn't aligned enough as to make it possible to
+                          honor the alignment set on the renaming.  */
+                       if (align)
+                         {
+                           unsigned int renamed_align
+                             = DECL_P (gnu_decl)
+                               ? DECL_ALIGN (gnu_decl)
+                               : TYPE_ALIGN (TREE_TYPE (gnu_decl));
+                           gcc_assert (renamed_align >= align);
+                         }

                        break;
                      }
 
                        break;
                      }
 


@@ -1030,6 +1064,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                   entity is always accessed indirectly through it.  */
                else
                  {
                   entity is always accessed indirectly through it.  */
                else
                  {

+                   /* We need to preserve the volatileness of the renamed
+                      object through the indirection.  */
+                   if (TREE_THIS_VOLATILE (gnu_expr)
+                       && !TYPE_VOLATILE (gnu_type))
+                     gnu_type
+                       = build_qualified_type (gnu_type,
+                                               (TYPE_QUALS (gnu_type)
+                                                | TYPE_QUAL_VOLATILE));

                    gnu_type = build_reference_type (gnu_type);
                    inner_const_flag = TREE_READONLY (gnu_expr);
                    const_flag = true;
                    gnu_type = build_reference_type (gnu_type);
                    inner_const_flag = TREE_READONLY (gnu_expr);
                    const_flag = true;


@@ -1126,13 +1168,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           is a padded record whose field is of self-referential size.  In
           the former case, converting will generate unnecessary evaluations
           of the CONSTRUCTOR to compute the size and in the latter case, we
           is a padded record whose field is of self-referential size.  In
           the former case, converting will generate unnecessary evaluations
           of the CONSTRUCTOR to compute the size and in the latter case, we

-          want to only copy the actual data.  */
+          want to only copy the actual data.  Also don't convert to a record
+          type with a variant part from a record type without one, to keep
+          the object simpler.  */

        if (gnu_expr
            && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
            && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
            && !(TYPE_IS_PADDING_P (gnu_type)
                 && CONTAINS_PLACEHOLDER_P
        if (gnu_expr
            && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
            && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
            && !(TYPE_IS_PADDING_P (gnu_type)
                 && CONTAINS_PLACEHOLDER_P

-                   (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
+                   (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))
+           && !(TREE_CODE (gnu_type) == RECORD_TYPE
+                && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE
+                && get_variant_part (gnu_type) != NULL_TREE
+                && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE))

          gnu_expr = convert (gnu_type, gnu_expr);
 
        /* If this is a pointer that doesn't have an initializing expression,
          gnu_expr = convert (gnu_type, gnu_expr);
 
        /* If this is a pointer that doesn't have an initializing expression,


@@ -1343,6 +1391,49 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            const_flag = true;
          }
 
            const_flag = true;
          }
 

+       /* If this is an aliased object with an unconstrained nominal subtype,
+          we make its type a thin reference, i.e. the reference counterpart
+          of a thin pointer, so that it points to the array part.  This is
+          aimed at making it easier for the debugger to decode the object.
+          Note that we have to do that this late because of the couple of
+          allocation adjustments that might be made just above.  */
+       if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
+           && Is_Array_Type (Etype (gnat_entity))
+           && !type_annotate_only)
+         {
+           tree gnu_array
+             = gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
+
+           /* In case the object with the template has already been allocated
+              just above, we have nothing to do here.  */
+           if (!TYPE_IS_THIN_POINTER_P (gnu_type))
+             {
+               gnu_size = NULL_TREE;
+               used_by_ref = true;
+
+               if (definition && !imported_p)
+                 {
+                   tree gnu_unc_var
+                     = create_var_decl (concat_name (gnu_entity_name, "UNC"),
+                                        NULL_TREE, gnu_type, gnu_expr,
+                                        const_flag, Is_Public (gnat_entity),
+                                        false, static_p, NULL, gnat_entity);
+                   gnu_expr
+                     = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
+                   TREE_CONSTANT (gnu_expr) = 1;
+                   const_flag = true;
+                 }
+               else
+                 {
+                   gnu_expr = NULL_TREE;
+                   const_flag = false;
+                 }
+             }
+
+           gnu_type
+             = build_reference_type (TYPE_OBJECT_RECORD_TYPE (gnu_array));
+         }
+

        if (const_flag)
          gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type)
                                                      | TYPE_QUAL_CONST));
        if (const_flag)
          gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type)
                                                      | TYPE_QUAL_CONST));


@@ -1352,13 +1443,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           is a padded record whose field is of self-referential size.  In
           the former case, converting will generate unnecessary evaluations
           of the CONSTRUCTOR to compute the size and in the latter case, we
           is a padded record whose field is of self-referential size.  In
           the former case, converting will generate unnecessary evaluations
           of the CONSTRUCTOR to compute the size and in the latter case, we

-          want to only copy the actual data.  */
+          want to only copy the actual data.  Also don't convert to a record
+          type with a variant part from a record type without one, to keep
+          the object simpler.  */

        if (gnu_expr
            && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
            && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
            && !(TYPE_IS_PADDING_P (gnu_type)
                 && CONTAINS_PLACEHOLDER_P
        if (gnu_expr
            && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
            && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
            && !(TYPE_IS_PADDING_P (gnu_type)
                 && CONTAINS_PLACEHOLDER_P

-                   (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
+                   (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))
+           && !(TREE_CODE (gnu_type) == RECORD_TYPE
+                && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE
+                && get_variant_part (gnu_type) != NULL_TREE
+                && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE))

          gnu_expr = convert (gnu_type, gnu_expr);
 
        /* If this name is external or there was a name specified, use it,
          gnu_expr = convert (gnu_type, gnu_expr);
 
        /* If this name is external or there was a name specified, use it,


@@ -1393,6 +1490,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                             gnat_entity);
        DECL_BY_REF_P (gnu_decl) = used_by_ref;
        DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
                             gnat_entity);
        DECL_BY_REF_P (gnu_decl) = used_by_ref;
        DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;

+       DECL_CAN_NEVER_BE_NULL_P (gnu_decl) = Can_Never_Be_Null (gnat_entity);

 
        /* If we are defining an Out parameter and optimization isn't enabled,
           create a fake PARM_DECL for debugging purposes and make it point to
 
        /* If we are defining an Out parameter and optimization isn't enabled,
           create a fake PARM_DECL for debugging purposes and make it point to


@@ -1409,10 +1507,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            TREE_ADDRESSABLE (gnu_decl) = 1;
          }
 
            TREE_ADDRESSABLE (gnu_decl) = 1;
          }
 

+       /* If this is a loop parameter, set the corresponding flag.  */
+       else if (kind == E_Loop_Parameter)
+         DECL_LOOP_PARM_P (gnu_decl) = 1;
+

        /* If this is a renaming pointer, attach the renamed object to it and
           register it if we are at the global level.  Note that an external
           constant is at the global level.  */
        /* If this is a renaming pointer, attach the renamed object to it and
           register it if we are at the global level.  Note that an external
           constant is at the global level.  */

-       if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+       else if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)

          {
            SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
            if ((!definition && kind == E_Constant) || global_bindings_p ())
          {
            SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
            if ((!definition && kind == E_Constant) || global_bindings_p ())


@@ -1482,8 +1584,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                || (flag_stack_check == GENERIC_STACK_CHECK
                    && compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
                                         STACK_CHECK_MAX_VAR_SIZE) > 0)))
                || (flag_stack_check == GENERIC_STACK_CHECK
                    && compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
                                         STACK_CHECK_MAX_VAR_SIZE) > 0)))

-         add_stmt_with_node (build_call_1_expr
-                             (update_setjmp_buf_decl,
+         add_stmt_with_node (build_call_n_expr
+                             (update_setjmp_buf_decl, 1,

                               build_unary_op (ADDR_EXPR, NULL_TREE,
                                               get_block_jmpbuf_decl ())),
                              gnat_entity);
                               build_unary_op (ADDR_EXPR, NULL_TREE,
                                               get_block_jmpbuf_decl ())),
                              gnat_entity);


@@ -1913,14 +2015,26 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        const bool convention_fortran_p
          = (Convention (gnat_entity) == Convention_Fortran);
        const int ndim = Number_Dimensions (gnat_entity);
        const bool convention_fortran_p
          = (Convention (gnat_entity) == Convention_Fortran);
        const int ndim = Number_Dimensions (gnat_entity);

-       tree gnu_template_type = make_node (RECORD_TYPE);
-       tree gnu_ptr_template = build_pointer_type (gnu_template_type);
+       tree gnu_template_type;
+       tree gnu_ptr_template;

        tree gnu_template_reference, gnu_template_fields, gnu_fat_type;
        tree *gnu_index_types = XALLOCAVEC (tree, ndim);
        tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
        tree gnu_max_size = size_one_node, gnu_max_size_unit, tem, t;
        Entity_Id gnat_index, gnat_name;
        int index;
        tree gnu_template_reference, gnu_template_fields, gnu_fat_type;
        tree *gnu_index_types = XALLOCAVEC (tree, ndim);
        tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
        tree gnu_max_size = size_one_node, gnu_max_size_unit, tem, t;
        Entity_Id gnat_index, gnat_name;
        int index;

+       tree comp_type;
+
+       /* Create the type for the component now, as it simplifies breaking
+          type reference loops.  */
+       comp_type
+         = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p);
+       if (present_gnu_tree (gnat_entity))
+         {
+           /* As a side effect, the type may have been translated.  */
+           maybe_present = true;
+           break;
+         }

 
        /* We complete an existing dummy fat pointer type in place.  This both
           avoids further complex adjustments in update_pointer_to and yields
 
        /* We complete an existing dummy fat pointer type in place.  This both
           avoids further complex adjustments in update_pointer_to and yields


@@ -1933,9 +2047,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            TYPE_NAME (gnu_fat_type) = NULL_TREE;
            /* Save the contents of the dummy type for update_pointer_to.  */
            TYPE_POINTER_TO (gnu_type) = copy_type (gnu_fat_type);
            TYPE_NAME (gnu_fat_type) = NULL_TREE;
            /* Save the contents of the dummy type for update_pointer_to.  */
            TYPE_POINTER_TO (gnu_type) = copy_type (gnu_fat_type);

+           gnu_ptr_template =
+             TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)));
+           gnu_template_type = TREE_TYPE (gnu_ptr_template);

          }
        else
          }
        else

-         gnu_fat_type = make_node (RECORD_TYPE);
+         {
+           gnu_fat_type = make_node (RECORD_TYPE);
+           gnu_template_type = make_node (RECORD_TYPE);
+           gnu_ptr_template = build_pointer_type (gnu_template_type);
+         }

 
        /* Make a node for the array.  If we are not defining the array
           suppress expanding incomplete types.  */
 
        /* Make a node for the array.  If we are not defining the array
           suppress expanding incomplete types.  */


@@ -1985,6 +2106,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        gnu_template_reference
          = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
        TREE_READONLY (gnu_template_reference) = 1;
        gnu_template_reference
          = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
        TREE_READONLY (gnu_template_reference) = 1;

+       TREE_THIS_NOTRAP (gnu_template_reference) = 1;

 
        /* Now create the GCC type for each index and add the fields for that
           index to the template.  */
 
        /* Now create the GCC type for each index and add the fields for that
           index to the template.  */


@@ -2090,29 +2212,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                            debug_info_p);
        TYPE_READONLY (gnu_template_type) = 1;
 
                            debug_info_p);
        TYPE_READONLY (gnu_template_type) = 1;
 

-       /* Now make the array of arrays and update the pointer to the array
-          in the fat pointer.  Note that it is the first field.  */
-       tem
-         = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p);
+       /* Now build the array type.  */

 
        /* If Component_Size is not already specified, annotate it with the
           size of the component.  */
        if (Unknown_Component_Size (gnat_entity))
 
        /* If Component_Size is not already specified, annotate it with the
           size of the component.  */
        if (Unknown_Component_Size (gnat_entity))

-         Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (tem)));
+         Set_Component_Size (gnat_entity,
+                              annotate_value (TYPE_SIZE (comp_type)));

 
        /* Compute the maximum size of the array in units and bits.  */
        if (gnu_max_size)
          {
            gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
 
        /* Compute the maximum size of the array in units and bits.  */
        if (gnu_max_size)
          {
            gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,

-                                           TYPE_SIZE_UNIT (tem));
+                                           TYPE_SIZE_UNIT (comp_type));

            gnu_max_size = size_binop (MULT_EXPR,
                                       convert (bitsizetype, gnu_max_size),
            gnu_max_size = size_binop (MULT_EXPR,
                                       convert (bitsizetype, gnu_max_size),

-                                      TYPE_SIZE (tem));
+                                      TYPE_SIZE (comp_type));

          }
        else
          gnu_max_size_unit = NULL_TREE;
 
        /* Now build the array type.  */
          }
        else
          gnu_max_size_unit = NULL_TREE;
 
        /* Now build the array type.  */

+        tem = comp_type;

        for (index = ndim - 1; index >= 0; index--)
          {
            tem = build_nonshared_array_type (tem, gnu_index_types[index]);
        for (index = ndim - 1; index >= 0; index--)
          {
            tem = build_nonshared_array_type (tem, gnu_index_types[index]);


@@ -2773,7 +2894,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              ? -1
              : (Known_Alignment (gnat_entity)
                 || (Strict_Alignment (gnat_entity)
              ? -1
              : (Known_Alignment (gnat_entity)
                 || (Strict_Alignment (gnat_entity)

-                    && Known_Static_Esize (gnat_entity)))
+                    && Known_RM_Size (gnat_entity)))

                ? -2
                : 0;
        bool has_discr = Has_Discriminants (gnat_entity);
                ? -2
                : 0;
        bool has_discr = Has_Discriminants (gnat_entity);


@@ -2824,8 +2945,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
        /* If both a size and rep clause was specified, put the size in
           the record type now so that it can get the proper mode.  */
 
        /* If both a size and rep clause was specified, put the size in
           the record type now so that it can get the proper mode.  */

-       if (has_rep && Known_Esize (gnat_entity))
-         TYPE_SIZE (gnu_type) = UI_To_gnu (Esize (gnat_entity), sizetype);
+       if (has_rep && Known_RM_Size (gnat_entity))
+         TYPE_SIZE (gnu_type)
+           = UI_To_gnu (RM_Size (gnat_entity), bitsizetype);

 
        /* Always set the alignment here so that it can be used to
           set the mode, if it is making the alignment stricter.  If
 
        /* Always set the alignment here so that it can be used to
           set the mode, if it is making the alignment stricter.  If


@@ -2842,9 +2964,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           type size instead of the RM size (see validate_size).  Cap the
           alignment, lest it causes this type size to become too large.  */
        else if (Strict_Alignment (gnat_entity)
           type size instead of the RM size (see validate_size).  Cap the
           alignment, lest it causes this type size to become too large.  */
        else if (Strict_Alignment (gnat_entity)

-                && Known_Static_Esize (gnat_entity))
+                && Known_RM_Size (gnat_entity))

          {
          {

-           unsigned int raw_size = UI_To_Int (Esize (gnat_entity));
+           unsigned int raw_size = UI_To_Int (RM_Size (gnat_entity));

            unsigned int raw_align = raw_size & -raw_size;
            if (raw_align < BIGGEST_ALIGNMENT)
              TYPE_ALIGN (gnu_type) = raw_align;
            unsigned int raw_align = raw_size & -raw_size;
            if (raw_align < BIGGEST_ALIGNMENT)
              TYPE_ALIGN (gnu_type) = raw_align;


@@ -3018,9 +3140,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        /* Add the fields into the record type and finish it up.  */
        components_to_record (gnu_type, Component_List (record_definition),
                              gnu_field_list, packed, definition, false,
        /* Add the fields into the record type and finish it up.  */
        components_to_record (gnu_type, Component_List (record_definition),
                              gnu_field_list, packed, definition, false,

-                             all_rep, is_unchecked_union, debug_info_p,
+                             all_rep, is_unchecked_union,
+                             !Comes_From_Source (gnat_entity), debug_info_p,

                              false, OK_To_Reorder_Components (gnat_entity),
                              false, OK_To_Reorder_Components (gnat_entity),

-                             NULL);
+                             all_rep ? NULL_TREE : bitsize_zero_node, NULL);

 
        /* If it is passed by reference, force BLKmode to ensure that objects
           of this type will always be put in memory.  */
 
        /* If it is passed by reference, force BLKmode to ensure that objects
           of this type will always be put in memory.  */


@@ -3203,11 +3326,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                      {
                        tree old_variant = v->type;
                        tree new_variant = make_node (RECORD_TYPE);
                      {
                        tree old_variant = v->type;
                        tree new_variant = make_node (RECORD_TYPE);

+                       tree suffix
+                         = concat_name (DECL_NAME (gnu_variant_part),
+                                        IDENTIFIER_POINTER
+                                        (DECL_NAME (v->field)));

                        TYPE_NAME (new_variant)
                        TYPE_NAME (new_variant)

-                         = DECL_NAME (TYPE_NAME (old_variant));
+                         = concat_name (TYPE_NAME (gnu_type),
+                                        IDENTIFIER_POINTER (suffix));

                        copy_and_substitute_in_size (new_variant, old_variant,
                                                     gnu_subst_list);
                        copy_and_substitute_in_size (new_variant, old_variant,
                                                     gnu_subst_list);

-                       v->record = new_variant;
+                       v->new_type = new_variant;

                      }
                }
              else
                      }
                }
              else


@@ -3274,7 +3402,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                                == INTEGER_CST)
                      {
                        gnu_size = DECL_SIZE (gnu_old_field);
                                == INTEGER_CST)
                      {
                        gnu_size = DECL_SIZE (gnu_old_field);

-                       if (TREE_CODE (gnu_field_type) == RECORD_TYPE
+                       if (RECORD_OR_UNION_TYPE_P (gnu_field_type)

                            && !TYPE_FAT_POINTER_P (gnu_field_type)
                            && host_integerp (TYPE_SIZE (gnu_field_type), 1))
                          gnu_field_type
                            && !TYPE_FAT_POINTER_P (gnu_field_type)
                            && host_integerp (TYPE_SIZE (gnu_field_type), 1))
                          gnu_field_type


@@ -3311,7 +3439,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                            if (selected_variant)
                              gnu_cont_type = gnu_type;
                            else
                            if (selected_variant)
                              gnu_cont_type = gnu_type;
                            else

-                             gnu_cont_type = v->record;
+                             gnu_cont_type = v->new_type;

                          }
                        else
                          /* The front-end may pass us "ghost" components if
                          }
                        else
                          /* The front-end may pass us "ghost" components if


@@ -3487,8 +3615,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
         fill it in later.  */
       if (!definition && defer_incomplete_level != 0)
        {
         fill it in later.  */
       if (!definition && defer_incomplete_level != 0)
        {

-         struct incomplete *p
-           = (struct incomplete *) xmalloc (sizeof (struct incomplete));
+         struct incomplete *p = XNEW (struct incomplete);

 
          gnu_type
            = build_pointer_type
 
          gnu_type
            = build_pointer_type


@@ -3686,7 +3813,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            break;
          }
 
            break;
          }
 

-       /* If we have not done it yet, build the pointer type the usual way.  */
+       /* If we haven't done it yet, build the pointer type the usual way.  */

        if (!gnu_type)
          {
            /* Modify the designated type if we are pointing only to constant
        if (!gnu_type)
          {
            /* Modify the designated type if we are pointing only to constant


@@ -3813,15 +3940,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
     case E_Access_Subtype:
 
       /* We treat this as identical to its base type; any constraint is
     case E_Access_Subtype:
 
       /* We treat this as identical to its base type; any constraint is

-        meaningful only to the front end.
+        meaningful only to the front-end.

 
         The designated type must be elaborated as well, if it does
         not have its own freeze node.  Designated (sub)types created
         for constrained components of records with discriminants are
 
         The designated type must be elaborated as well, if it does
         not have its own freeze node.  Designated (sub)types created
         for constrained components of records with discriminants are

-        not frozen by the front end and thus not elaborated by gigi,
+        not frozen by the front-end and thus not elaborated by gigi,

         because their use may appear before the base type is frozen,
         and because it is not clear that they are needed anywhere in
         because their use may appear before the base type is frozen,
         and because it is not clear that they are needed anywhere in

-        Gigi.  With the current model, there is no correct place where
+        gigi.  With the current model, there is no correct place where

         they could be elaborated.  */
 
       gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
         they could be elaborated.  */
 
       gnu_type = gnat_to_gnu_type (Etype (gnat_entity));


@@ -3835,20 +3962,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
             elaborate it later.  */
          if (!definition && defer_incomplete_level != 0)
            {
             elaborate it later.  */
          if (!definition && defer_incomplete_level != 0)
            {

-             struct incomplete *p
-               = (struct incomplete *) xmalloc (sizeof (struct incomplete));
-             tree gnu_ptr_type
-               = build_pointer_type
-                 (make_dummy_type (Directly_Designated_Type (gnat_entity)));
+             struct incomplete *p = XNEW (struct incomplete);

 
 

-             p->old_type = TREE_TYPE (gnu_ptr_type);
+             p->old_type
+               = make_dummy_type (Directly_Designated_Type (gnat_entity));

              p->full_type = Directly_Designated_Type (gnat_entity);
              p->next = defer_incomplete_list;
              defer_incomplete_list = p;
            }
          else if (!IN (Ekind (Base_Type
              p->full_type = Directly_Designated_Type (gnat_entity);
              p->next = defer_incomplete_list;
              defer_incomplete_list = p;
            }
          else if (!IN (Ekind (Base_Type

-                             (Directly_Designated_Type (gnat_entity))),
-                      Incomplete_Or_Private_Kind))
+                              (Directly_Designated_Type (gnat_entity))),
+                       Incomplete_Or_Private_Kind))

            gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity),
                                NULL_TREE, 0);
        }
            gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity),
                                NULL_TREE, 0);
        }


@@ -4045,7 +4169,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              return_by_invisi_ref_p = true;
 
            /* Likewise, if the return type is itself By_Reference.  */
              return_by_invisi_ref_p = true;
 
            /* Likewise, if the return type is itself By_Reference.  */

-           else if (TREE_ADDRESSABLE (gnu_return_type))
+           else if (TYPE_IS_BY_REFERENCE_P (gnu_return_type))

              return_by_invisi_ref_p = true;
 
            /* If the type is a padded type and the underlying type would not
              return_by_invisi_ref_p = true;
 
            /* If the type is a padded type and the underlying type would not


@@ -4161,7 +4285,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            /* The failure of this assertion will very likely come from an
               order of elaboration issue for the type of the parameter.  */
            gcc_assert (kind == E_Subprogram_Type
            /* The failure of this assertion will very likely come from an
               order of elaboration issue for the type of the parameter.  */
            gcc_assert (kind == E_Subprogram_Type

-                       || !TYPE_IS_DUMMY_P (gnu_param_type));
+                       || !TYPE_IS_DUMMY_P (gnu_param_type)
+                       || type_annotate_only);

 
            if (gnu_param)
              {
 
            if (gnu_param)
              {


@@ -4224,7 +4349,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
                    gnu_return_type = gnu_new_ret_type;
                    TYPE_NAME (gnu_return_type) = get_identifier ("RETURN");
 
                    gnu_return_type = gnu_new_ret_type;
                    TYPE_NAME (gnu_return_type) = get_identifier ("RETURN");

-                   /* Set a default alignment to speed up accesses.  */
+                   /* Set a default alignment to speed up accesses.  But we
+                      shouldn't increase the size of the structure too much,
+                      lest it doesn't fit in return registers anymore.  */

                    TYPE_ALIGN (gnu_return_type)
                      = get_mode_alignment (ptr_mode);
                  }
                    TYPE_ALIGN (gnu_return_type)
                      = get_mode_alignment (ptr_mode);
                  }


@@ -4233,9 +4360,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                  = create_field_decl (gnu_param_name, gnu_param_type,
                                       gnu_return_type, NULL_TREE, NULL_TREE,
                                       0, 0);
                  = create_field_decl (gnu_param_name, gnu_param_type,
                                       gnu_return_type, NULL_TREE, NULL_TREE,
                                       0, 0);

-               /* Set a minimum alignment to speed up accesses.  */
-               if (DECL_ALIGN (gnu_field) < TYPE_ALIGN (gnu_return_type))
-                 DECL_ALIGN (gnu_field) = TYPE_ALIGN (gnu_return_type);

                Sloc_to_locus (Sloc (gnat_param),
                               &DECL_SOURCE_LOCATION (gnu_field));
                DECL_CHAIN (gnu_field) = gnu_field_list;
                Sloc_to_locus (Sloc (gnat_param),
                               &DECL_SOURCE_LOCATION (gnu_field));
                DECL_CHAIN (gnu_field) = gnu_field_list;


@@ -4245,23 +4369,61 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              }
          }
 
              }
          }
 

-       /* Do not compute record for out parameters if subprogram is
-          stubbed since structures are incomplete for the back-end.  */
-       if (gnu_field_list && Convention (gnat_entity) != Convention_Stubbed)
-         finish_record_type (gnu_return_type, nreverse (gnu_field_list),
-                             0, debug_info_p);
+       if (gnu_cico_list)
+         {
+           /* If we have a CICO list but it has only one entry, we convert
+              this function into a function that returns this object.  */
+           if (list_length (gnu_cico_list) == 1)
+             gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list));
+
+           /* Do not finalize the return type if the subprogram is stubbed
+              since structures are incomplete for the back-end.  */
+           else if (Convention (gnat_entity) != Convention_Stubbed)
+             {
+               finish_record_type (gnu_return_type, nreverse (gnu_field_list),
+                                   0, false);
+
+               /* Try to promote the mode of the return type if it is passed
+                  in registers, again to speed up accesses.  */
+               if (TYPE_MODE (gnu_return_type) == BLKmode
+                   && !targetm.calls.return_in_memory (gnu_return_type,
+                                                       NULL_TREE))
+                 {
+                   unsigned int size
+                     = TREE_INT_CST_LOW (TYPE_SIZE (gnu_return_type));
+                   unsigned int i = BITS_PER_UNIT;
+                   enum machine_mode mode;
+
+                   while (i < size)
+                     i <<= 1;
+                   mode = mode_for_size (i, MODE_INT, 0);
+                   if (mode != BLKmode)
+                     {
+                       SET_TYPE_MODE (gnu_return_type, mode);
+                       TYPE_ALIGN (gnu_return_type)
+                         = GET_MODE_ALIGNMENT (mode);
+                       TYPE_SIZE (gnu_return_type)
+                         = bitsize_int (GET_MODE_BITSIZE (mode));
+                       TYPE_SIZE_UNIT (gnu_return_type)
+                         = size_int (GET_MODE_SIZE (mode));
+                     }
+                 }

 
 

-       /* If we have a CICO list but it has only one entry, we convert
-          this function into a function that simply returns that one
-          object.  */
-       if (list_length (gnu_cico_list) == 1)
-         gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list));
+               if (debug_info_p)
+                 rest_of_record_type_compilation (gnu_return_type);
+             }
+         }

 
        if (Has_Stdcall_Convention (gnat_entity))
          prepend_one_attribute_to
            (&attr_list, ATTR_MACHINE_ATTRIBUTE,
             get_identifier ("stdcall"), NULL_TREE,
             gnat_entity);
 
        if (Has_Stdcall_Convention (gnat_entity))
          prepend_one_attribute_to
            (&attr_list, ATTR_MACHINE_ATTRIBUTE,
             get_identifier ("stdcall"), NULL_TREE,
             gnat_entity);

+       else if (Has_Thiscall_Convention (gnat_entity))
+         prepend_one_attribute_to
+           (&attr_list, ATTR_MACHINE_ATTRIBUTE,
+            get_identifier ("thiscall"), NULL_TREE,
+            gnat_entity);

 
        /* If we should request stack realignment for a foreign convention
           subprogram, do so.  Note that this applies to task entry points in
 
        /* If we should request stack realignment for a foreign convention
           subprogram, do so.  Note that this applies to task entry points in


@@ -4505,7 +4667,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       break;
 
     case E_Label:
       break;
 
     case E_Label:

-      gnu_decl = create_label_decl (gnu_entity_name);
+      gnu_decl = create_label_decl (gnu_entity_name, gnat_entity);

       break;
 
     case E_Block:
       break;
 
     case E_Block:


@@ -4541,18 +4703,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          || Is_Class_Wide_Equivalent_Type (gnat_entity))
        TYPE_ALIGN_OK (gnu_type) = 1;
 
          || Is_Class_Wide_Equivalent_Type (gnat_entity))
        TYPE_ALIGN_OK (gnu_type) = 1;
 

-      /* If the type is passed by reference, objects of this type must be
-        fully addressable and cannot be copied.  */
-      if (Is_By_Reference_Type (gnat_entity))
-       TREE_ADDRESSABLE (gnu_type) = 1;
+      /* Record whether the type is passed by reference.  */
+      if (!VOID_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity))
+       TYPE_BY_REFERENCE_P (gnu_type) = 1;

 
       /* ??? Don't set the size for a String_Literal since it is either
         confirming or we don't handle it properly (if the low bound is
         non-constant).  */
       if (!gnu_size && kind != E_String_Literal_Subtype)
 
       /* ??? Don't set the size for a String_Literal since it is either
         confirming or we don't handle it properly (if the low bound is
         non-constant).  */
       if (!gnu_size && kind != E_String_Literal_Subtype)

-       gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnat_entity,
-                                 TYPE_DECL, false,
-                                 Has_Size_Clause (gnat_entity));
+       {
+         Uint gnat_size = Known_Esize (gnat_entity)
+                          ? Esize (gnat_entity) : RM_Size (gnat_entity);
+         gnu_size
+           = validate_size (gnat_size, gnu_type, gnat_entity, TYPE_DECL,
+                            false, Has_Size_Clause (gnat_entity));
+       }

 
       /* If a size was specified, see if we can make a new type of that size
         by rearranging the type, for example from a fat to a thin pointer.  */
 
       /* If a size was specified, see if we can make a new type of that size
         by rearranging the type, for example from a fat to a thin pointer.  */


@@ -4584,13 +4749,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              tree size;
 
              /* If a size was specified, take it into account.  Otherwise
              tree size;
 
              /* If a size was specified, take it into account.  Otherwise

-                use the RM size for records as the type size has already
-                been adjusted to the alignment.  */
+                use the RM size for records or unions as the type size has
+                already been adjusted to the alignment.  */

              if (gnu_size)
                size = gnu_size;
              if (gnu_size)
                size = gnu_size;

-             else if ((TREE_CODE (gnu_type) == RECORD_TYPE
-                       || TREE_CODE (gnu_type) == UNION_TYPE
-                       || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
+             else if (RECORD_OR_UNION_TYPE_P (gnu_type)

                       && !TYPE_FAT_POINTER_P (gnu_type))
                size = rm_size (gnu_type);
              else
                       && !TYPE_FAT_POINTER_P (gnu_type))
                size = rm_size (gnu_type);
              else


@@ -5113,6 +5276,46 @@ get_unpadded_type (Entity_Id gnat_entity)
 
   return type;
 }
 
   return type;
 }

+
+/* Return the DECL associated with the public subprogram GNAT_ENTITY but whose
+   type has been changed to that of the parameterless procedure, except if an
+   alias is already present, in which case it is returned instead.  */
+
+tree
+get_minimal_subprog_decl (Entity_Id gnat_entity)
+{
+  tree gnu_entity_name, gnu_ext_name;
+  struct attrib *attr_list = NULL;
+
+  /* See the E_Function/E_Procedure case of gnat_to_gnu_entity for the model
+     of the handling applied here.  */
+
+  while (Present (Alias (gnat_entity)))
+    {
+      gnat_entity = Alias (gnat_entity);
+      if (present_gnu_tree (gnat_entity))
+       return get_gnu_tree (gnat_entity);
+    }
+
+  gnu_entity_name = get_entity_name (gnat_entity);
+  gnu_ext_name = create_concat_name (gnat_entity, NULL);
+
+  if (Has_Stdcall_Convention (gnat_entity))
+    prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE,
+                             get_identifier ("stdcall"), NULL_TREE,
+                             gnat_entity);
+  else if (Has_Thiscall_Convention (gnat_entity))
+    prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE,
+                             get_identifier ("thiscall"), NULL_TREE,
+                             gnat_entity);
+
+  if (No (Interface_Name (gnat_entity)) && gnu_ext_name == gnu_entity_name)
+    gnu_ext_name = NULL_TREE;
+
+  return
+    create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE,
+                        false, true, true, true, attr_list, gnat_entity);
+}

 \f
 /* Wrap up compilation of DECL, a TYPE_DECL, possibly deferring it.
    Every TYPE_DECL generated for a type definition must be passed
 \f
 /* Wrap up compilation of DECL, a TYPE_DECL, possibly deferring it.
    Every TYPE_DECL generated for a type definition must be passed


@@ -5153,6 +5356,39 @@ rest_of_type_decl_compilation_no_defer (tree decl)
     }
 }
 
     }
 }
 

+/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
+   a C++ imported method or equivalent.
+
+   We use the predicate on 32-bit x86/Windows to find out whether we need to
+   use the "thiscall" calling convention for GNAT_ENTITY.  This convention is
+   used for C++ methods (functions with METHOD_TYPE) by the back-end.  */
+
+bool
+is_cplusplus_method (Entity_Id gnat_entity)
+{
+  if (Convention (gnat_entity) != Convention_CPP)
+    return False;
+
+  /* This is the main case: C++ method imported as a primitive operation.  */
+  if (Is_Dispatching_Operation (gnat_entity))
+    return True;
+
+  /* A thunk needs to be handled like its associated primitive operation.  */
+  if (Is_Subprogram (gnat_entity) && Is_Thunk (gnat_entity))
+    return True;
+
+  /* C++ classes with no virtual functions can be imported as limited
+     record types, but we need to return true for the constructors.  */
+  if (Is_Constructor (gnat_entity))
+    return True;
+
+  /* This is set on the E_Subprogram_Type built for a dispatching call.  */
+  if (Is_Dispatch_Table_Entity (gnat_entity))
+    return True;
+
+  return False;
+}
+

 /* Finalize the processing of From_With_Type incomplete types.  */
 
 void
 /* Finalize the processing of From_With_Type incomplete types.  */
 
 void


@@ -5217,6 +5453,7 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity)
     }
 
   gcc_assert (Present (gnat_equiv) || type_annotate_only);
     }
 
   gcc_assert (Present (gnat_equiv) || type_annotate_only);

+

   return gnat_equiv;
 }
 
   return gnat_equiv;
 }
 


@@ -5239,7 +5476,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
       && !Is_Bit_Packed_Array (gnat_array)
       && !Has_Aliased_Components (gnat_array)
       && !Strict_Alignment (gnat_type)
       && !Is_Bit_Packed_Array (gnat_array)
       && !Has_Aliased_Components (gnat_array)
       && !Strict_Alignment (gnat_type)

-      && TREE_CODE (gnu_type) == RECORD_TYPE
+      && RECORD_OR_UNION_TYPE_P (gnu_type)

       && !TYPE_FAT_POINTER_P (gnu_type)
       && host_integerp (TYPE_SIZE (gnu_type), 1))
     gnu_type = make_packable_type (gnu_type, false);
       && !TYPE_FAT_POINTER_P (gnu_type)
       && host_integerp (TYPE_SIZE (gnu_type), 1))
     gnu_type = make_packable_type (gnu_type, false);


@@ -5446,7 +5683,15 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
                   || (!foreign
                       && default_pass_by_ref (gnu_param_type)))))
     {
                   || (!foreign
                       && default_pass_by_ref (gnu_param_type)))))
     {

+      /* We take advantage of 6.2(12) by considering that references built for
+        parameters whose type isn't by-ref and for which the mechanism hasn't
+        been forced to by-ref are restrict-qualified in the C sense.  */
+      bool restrict_p
+       = !TYPE_IS_BY_REFERENCE_P (gnu_param_type) && mech != By_Reference;

       gnu_param_type = build_reference_type (gnu_param_type);
       gnu_param_type = build_reference_type (gnu_param_type);

+      if (restrict_p)
+       gnu_param_type
+         = build_qualified_type (gnu_param_type, TYPE_QUAL_RESTRICT);

       by_ref = true;
 
       /* In some ABIs, e.g. SPARC 32-bit, fat pointer types are themselves
       by_ref = true;
 
       /* In some ABIs, e.g. SPARC 32-bit, fat pointer types are themselves


@@ -5507,8 +5752,13 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
   DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
   DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
                                       mech == By_Short_Descriptor);
   DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
   DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
                                       mech == By_Short_Descriptor);

+  /* Note that, in case of a parameter passed by double reference, the
+     DECL_POINTS_TO_READONLY_P flag is meant for the second reference.
+     The first reference always points to read-only, as it points to
+     the second reference, i.e. the reference to the actual parameter.  */

   DECL_POINTS_TO_READONLY_P (gnu_param)
     = (ro_param && (by_ref || by_component_ptr));
   DECL_POINTS_TO_READONLY_P (gnu_param)
     = (ro_param && (by_ref || by_component_ptr));

+  DECL_CAN_NEVER_BE_NULL_P (gnu_param) = Can_Never_Be_Null (gnat_param);

 
   /* Save the alternate descriptor type, if any.  */
   if (gnu_param_type_alt)
 
   /* Save the alternate descriptor type, if any.  */
   if (gnu_param_type_alt)


@@ -6025,7 +6275,8 @@ static tree
 elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
                        bool definition, bool need_debug)
 {
 elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
                        bool definition, bool need_debug)
 {

-  const bool expr_global_p = Is_Public (gnat_entity) || global_bindings_p ();
+  const bool expr_public_p = Is_Public (gnat_entity);
+  const bool expr_global_p = expr_public_p || global_bindings_p ();

   bool expr_variable_p, use_variable;
 
   /* In most cases, we won't see a naked FIELD_DECL because a discriminant
   bool expr_variable_p, use_variable;
 
   /* In most cases, we won't see a naked FIELD_DECL because a discriminant


@@ -6093,11 +6344,10 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
   if (use_variable || need_debug)
     {
       tree gnu_decl
   if (use_variable || need_debug)
     {
       tree gnu_decl

-       = create_var_decl (create_concat_name (gnat_entity,
-                                              IDENTIFIER_POINTER (gnu_name)),
-                          NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr,
-                          !need_debug, Is_Public (gnat_entity),
-                          !definition, expr_global_p, NULL, gnat_entity);
+       = create_var_decl_1
+         (create_concat_name (gnat_entity, IDENTIFIER_POINTER (gnu_name)),
+          NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, true, expr_public_p,
+          !definition, expr_global_p, !need_debug, NULL, gnat_entity);

 
       if (use_variable)
        return gnu_decl;
 
       if (use_variable)
        return gnu_decl;


@@ -6295,9 +6545,7 @@ make_packable_type (tree type, bool in_record)
       tree new_field_type = TREE_TYPE (old_field);
       tree new_field, new_size;
 
       tree new_field_type = TREE_TYPE (old_field);
       tree new_field, new_size;
 

-      if ((TREE_CODE (new_field_type) == RECORD_TYPE
-          || TREE_CODE (new_field_type) == UNION_TYPE
-          || TREE_CODE (new_field_type) == QUAL_UNION_TYPE)
+      if (RECORD_OR_UNION_TYPE_P (new_field_type)

          && !TYPE_FAT_POINTER_P (new_field_type)
          && host_integerp (TYPE_SIZE (new_field_type), 1))
        new_field_type = make_packable_type (new_field_type, true);
          && !TYPE_FAT_POINTER_P (new_field_type)
          && host_integerp (TYPE_SIZE (new_field_type), 1))
        new_field_type = make_packable_type (new_field_type, true);


@@ -6307,9 +6555,7 @@ make_packable_type (tree type, bool in_record)
         packable version of the record type, see finish_record_type.  */
       if (!DECL_CHAIN (old_field)
          && !TYPE_PACKED (type)
         packable version of the record type, see finish_record_type.  */
       if (!DECL_CHAIN (old_field)
          && !TYPE_PACKED (type)

-         && (TREE_CODE (new_field_type) == RECORD_TYPE
-             || TREE_CODE (new_field_type) == UNION_TYPE
-             || TREE_CODE (new_field_type) == QUAL_UNION_TYPE)
+         && RECORD_OR_UNION_TYPE_P (new_field_type)

          && !TYPE_FAT_POINTER_P (new_field_type)
          && !TYPE_CONTAINS_TEMPLATE_P (new_field_type)
          && TYPE_ADA_SIZE (new_field_type))
          && !TYPE_FAT_POINTER_P (new_field_type)
          && !TYPE_CONTAINS_TEMPLATE_P (new_field_type)
          && TYPE_ADA_SIZE (new_field_type))


@@ -6471,8 +6717,9 @@ maybe_pad_type (tree type, tree size, unsigned int align,
      between them and it might be hard to overcome afterwards, including
      at the RTL level when the stand-alone object is accessed as a whole.  */
   if (align != 0
      between them and it might be hard to overcome afterwards, including
      at the RTL level when the stand-alone object is accessed as a whole.  */
   if (align != 0

-      && TREE_CODE (type) == RECORD_TYPE
+      && RECORD_OR_UNION_TYPE_P (type)

       && TYPE_MODE (type) == BLKmode
       && TYPE_MODE (type) == BLKmode

+      && !TYPE_BY_REFERENCE_P (type)

       && TREE_CODE (orig_size) == INTEGER_CST
       && !TREE_OVERFLOW (orig_size)
       && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0
       && TREE_CODE (orig_size) == INTEGER_CST
       && !TREE_OVERFLOW (orig_size)
       && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0


@@ -6685,7 +6932,7 @@ adjust_packed (tree field_type, tree record_type, int packed)
      because we cannot create temporaries of non-fixed size in case
      we need to take the address of the field.  See addressable_p and
      the notes on the addressability issues for further details.  */
      because we cannot create temporaries of non-fixed size in case
      we need to take the address of the field.  See addressable_p and
      the notes on the addressability issues for further details.  */

-  if (is_variable_size (field_type))
+  if (type_has_variable_size (field_type))

     return 0;
 
   /* If the alignment of the record is specified and the field type
     return 0;
 
   /* If the alignment of the record is specified and the field type


@@ -6738,7 +6985,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   /* If a size is specified, use it.  Otherwise, if the record type is packed,
      use the official RM size.  See "Handling of Type'Size Values" in Einfo
      for further details.  */
   /* If a size is specified, use it.  Otherwise, if the record type is packed,
      use the official RM size.  See "Handling of Type'Size Values" in Einfo
      for further details.  */

-  if (Known_Static_Esize (gnat_field))
+  if (Known_Esize (gnat_field))

     gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
                              gnat_field, FIELD_DECL, false, true);
   else if (packed == 1)
     gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
                              gnat_field, FIELD_DECL, false, true);
   else if (packed == 1)


@@ -6770,7 +7017,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
      effects on the outer record type.  A typical case is a field known to be
      byte-aligned and not to share a byte with another field.  */
   if (!needs_strict_alignment
      effects on the outer record type.  A typical case is a field known to be
      byte-aligned and not to share a byte with another field.  */
   if (!needs_strict_alignment

-      && TREE_CODE (gnu_field_type) == RECORD_TYPE
+      && RECORD_OR_UNION_TYPE_P (gnu_field_type)

       && !TYPE_FAT_POINTER_P (gnu_field_type)
       && host_integerp (TYPE_SIZE (gnu_field_type), 1)
       && (packed == 1
       && !TYPE_FAT_POINTER_P (gnu_field_type)
       && host_integerp (TYPE_SIZE (gnu_field_type), 1)
       && (packed == 1


@@ -6790,10 +7037,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
        }
     }
 
        }
     }
 

-  /* If we are packing the record and the field is BLKmode, round the
-     size up to a byte boundary.  */
-  if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size)
-    gnu_size = round_up (gnu_size, BITS_PER_UNIT);
+  if (Is_Atomic (gnat_field))
+    check_ok_for_atomic (gnu_field_type, gnat_field, false);

 
   if (Present (Component_Clause (gnat_field)))
     {
 
   if (Present (Component_Clause (gnat_field)))
     {


@@ -6872,10 +7117,10 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
                   TYPE_ALIGN (gnu_field_type));
 
              else if (Strict_Alignment (gnat_field_type))
                   TYPE_ALIGN (gnu_field_type));
 
              else if (Strict_Alignment (gnat_field_type))

-               post_error_ne_num
-  ("position of & with aliased or tagged components not multiple of ^ bits",
-                  First_Bit (Component_Clause (gnat_field)), gnat_field,
-                  TYPE_ALIGN (gnu_field_type));
+               post_error_ne
+                 ("position of & is not compatible with alignment required "
+                  "by its components",
+                   First_Bit (Component_Clause (gnat_field)), gnat_field);

 
              else
                gcc_unreachable ();
 
              else
                gcc_unreachable ();


@@ -6883,9 +7128,6 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
              gnu_pos = NULL_TREE;
            }
        }
              gnu_pos = NULL_TREE;
            }
        }

-
-      if (Is_Atomic (gnat_field))
-       check_ok_for_atomic (gnu_field_type, gnat_field, false);

     }
 
   /* If the record has rep clauses and this is the tag field, make a rep
     }
 
   /* If the record has rep clauses and this is the tag field, make a rep


@@ -6898,7 +7140,14 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
     }
 
   else
     }
 
   else

-    gnu_pos = NULL_TREE;
+    {
+      gnu_pos = NULL_TREE;
+
+      /* If we are packing the record and the field is BLKmode, round the
+        size up to a byte boundary.  */
+      if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size)
+       gnu_size = round_up (gnu_size, BITS_PER_UNIT);
+    }

 
   /* We need to make the size the maximum for the type if it is
      self-referential and an unconstrained type.  In that case, we can't
 
   /* We need to make the size the maximum for the type if it is
      self-referential and an unconstrained type.  In that case, we can't


@@ -6958,6 +7207,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
     = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
                         gnu_size, gnu_pos, packed, Is_Aliased (gnat_field));
   Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
     = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
                         gnu_size, gnu_pos, packed, Is_Aliased (gnat_field));
   Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));

+  DECL_ALIASED_P (gnu_field) = Is_Aliased (gnat_field);

   TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile;
 
   if (Ekind (gnat_field) == E_Discriminant)
   TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile;
 
   if (Ekind (gnat_field) == E_Discriminant)


@@ -6967,11 +7217,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   return gnu_field;
 }
 \f
   return gnu_field;
 }
 \f

-/* Return true if TYPE is a type with variable size, a padding type with a
-   field of variable size or is a record that has a field such a field.  */
+/* Return true if TYPE is a type with variable size or a padding type with a
+   field of variable size or a record that has a field with such a type.  */

 
 static bool
 
 static bool

-is_variable_size (tree type)
+type_has_variable_size (tree type)

 {
   tree field;
 
 {
   tree field;
 


@@ -6982,18 +7232,72 @@ is_variable_size (tree type)
       && !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
     return true;
 
       && !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
     return true;
 

-  if (TREE_CODE (type) != RECORD_TYPE
-      && TREE_CODE (type) != UNION_TYPE
-      && TREE_CODE (type) != QUAL_UNION_TYPE)
+  if (!RECORD_OR_UNION_TYPE_P (type))

     return false;
 
   for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
     return false;
 
   for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))

-    if (is_variable_size (TREE_TYPE (field)))
+    if (type_has_variable_size (TREE_TYPE (field)))

       return true;
 
   return false;
 }
 \f
       return true;
 
   return false;
 }
 \f

+/* Return true if FIELD is an artificial field.  */
+
+static bool
+field_is_artificial (tree field)
+{
+  /* These fields are generated by the front-end proper.  */
+  if (IDENTIFIER_POINTER (DECL_NAME (field)) [0] == '_')
+    return true;
+
+  /* These fields are generated by gigi.  */
+  if (DECL_INTERNAL_P (field))
+    return true;
+
+  return false;
+}
+
+/* Return true if FIELD is a non-artificial aliased field.  */
+
+static bool
+field_is_aliased (tree field)
+{
+  if (field_is_artificial (field))
+    return false;
+
+  return DECL_ALIASED_P (field);
+}
+
+/* Return true if FIELD is a non-artificial field with self-referential
+   size.  */
+
+static bool
+field_has_self_size (tree field)
+{
+  if (field_is_artificial (field))
+    return false;
+
+  if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST)
+    return false;
+
+  return CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (field)));
+}
+
+/* Return true if FIELD is a non-artificial field with variable size.  */
+
+static bool
+field_has_variable_size (tree field)
+{
+  if (field_is_artificial (field))
+    return false;
+
+  if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST)
+    return false;
+
+  return TREE_CODE (TYPE_SIZE (TREE_TYPE (field))) != INTEGER_CST;
+}
+

 /* qsort comparer for the bit positions of two record components.  */
 
 static int
 /* qsort comparer for the bit positions of two record components.  */
 
 static int


@@ -7031,6 +7335,8 @@ compare_field_bitpos (const PTR rt1, const PTR rt2)
    UNCHECKED_UNION is true if we are building this type for a record with a
    Pragma Unchecked_Union.
 
    UNCHECKED_UNION is true if we are building this type for a record with a
    Pragma Unchecked_Union.
 

+   ARTIFICIAL is true if this is a type that was generated by the compiler.
+

    DEBUG_INFO is true if we need to write debug information about the type.
 
    MAYBE_UNUSED is true if this type may be unused in the end; this doesn't
    DEBUG_INFO is true if we need to write debug information about the type.
 
    MAYBE_UNUSED is true if this type may be unused in the end; this doesn't


@@ -7038,6 +7344,10 @@ compare_field_bitpos (const PTR rt1, const PTR rt2)
 
    REORDER is true if we are permitted to reorder components of this type.
 
 
    REORDER is true if we are permitted to reorder components of this type.
 

+   FIRST_FREE_POS, if nonzero, is the first (lowest) free field position in
+   the outer record type down to this variant level.  It is nonzero only if
+   all the fields down to this level have a rep clause and ALL_REP is false.
+

    P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field
    with a rep clause is to be added; in this case, that is all that should
    be done with such fields.  */
    P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field
    with a rep clause is to be added; in this case, that is all that should
    be done with such fields.  */


@@ -7046,14 +7356,17 @@ static void
 components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
                      tree gnu_field_list, int packed, bool definition,
                      bool cancel_alignment, bool all_rep,
 components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
                      tree gnu_field_list, int packed, bool definition,
                      bool cancel_alignment, bool all_rep,

-                     bool unchecked_union, bool debug_info,
-                     bool maybe_unused, bool reorder,
-                     tree *p_gnu_rep_list)
+                     bool unchecked_union, bool artificial,
+                     bool debug_info, bool maybe_unused, bool reorder,
+                     tree first_free_pos, tree *p_gnu_rep_list)

 {
   bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
   bool layout_with_rep = false;
 {
   bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
   bool layout_with_rep = false;

+  bool has_self_field = false;
+  bool has_aliased_after_self_field = false;

   Node_Id component_decl, variant_part;
   tree gnu_field, gnu_next, gnu_last;
   Node_Id component_decl, variant_part;
   tree gnu_field, gnu_next, gnu_last;

+  tree gnu_rep_part = NULL_TREE;

   tree gnu_variant_part = NULL_TREE;
   tree gnu_rep_list = NULL_TREE;
   tree gnu_var_list = NULL_TREE;
   tree gnu_variant_part = NULL_TREE;
   tree gnu_rep_list = NULL_TREE;
   tree gnu_var_list = NULL_TREE;


@@ -7102,6 +7415,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
                gnu_field_list = gnu_field;
                if (!gnu_last)
                  gnu_last = gnu_field;
                gnu_field_list = gnu_field;
                if (!gnu_last)
                  gnu_last = gnu_field;

+
+               /* And record information for the final layout.  */
+               if (field_has_self_size (gnu_field))
+                 has_self_field = true;
+               else if (has_self_field && field_is_aliased (gnu_field))
+                 has_aliased_after_self_field = true;

              }
          }
 
              }
          }
 


@@ -7127,7 +7446,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
        = concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))),
                       "XVN");
       tree gnu_union_type, gnu_union_name;
        = concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))),
                       "XVN");
       tree gnu_union_type, gnu_union_name;

-      tree gnu_variant_list = NULL_TREE;
+      tree this_first_free_pos, gnu_variant_list = NULL_TREE;

 
       if (TREE_CODE (gnu_name) == TYPE_DECL)
        gnu_name = DECL_NAME (gnu_name);
 
       if (TREE_CODE (gnu_name) == TYPE_DECL)
        gnu_name = DECL_NAME (gnu_name);


@@ -7135,12 +7454,10 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
       gnu_union_name
        = concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
 
       gnu_union_name
        = concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
 

-      /* Reuse an enclosing union if all fields are in the variant part
-        and there is no representation clause on the record, to match
-        the layout of C unions.  There is an associated check below.  */
-      if (!gnu_field_list
-         && TREE_CODE (gnu_record_type) == UNION_TYPE
-         && !TYPE_PACKED (gnu_record_type))
+      /* Reuse the enclosing union if this is an Unchecked_Union whose fields
+        are all in the variant part, to match the layout of C unions.  There
+        is an associated check below.  */
+      if (TREE_CODE (gnu_record_type) == UNION_TYPE)

        gnu_union_type = gnu_record_type;
       else
        {
        gnu_union_type = gnu_record_type;
       else
        {


@@ -7152,6 +7469,29 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
          TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type);
        }
 
          TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type);
        }
 

+      /* If all the fields down to this level have a rep clause, find out
+        whether all the fields at this level also have one.  If so, then
+        compute the new first free position to be passed downward.  */
+      this_first_free_pos = first_free_pos;
+      if (this_first_free_pos)
+       {
+         for (gnu_field = gnu_field_list;
+              gnu_field;
+              gnu_field = DECL_CHAIN (gnu_field))
+           if (DECL_FIELD_OFFSET (gnu_field))
+             {
+               tree pos = bit_position (gnu_field);
+               if (!tree_int_cst_lt (pos, this_first_free_pos))
+                 this_first_free_pos
+                   = size_binop (PLUS_EXPR, pos, DECL_SIZE (gnu_field));
+             }
+           else
+             {
+               this_first_free_pos = NULL_TREE;
+               break;
+             }
+       }
+

       for (variant = First_Non_Pragma (Variants (variant_part));
           Present (variant);
           variant = Next_Non_Pragma (variant))
       for (variant = First_Non_Pragma (Variants (variant_part));
           Present (variant);
           variant = Next_Non_Pragma (variant))


@@ -7173,8 +7513,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
          TYPE_PACKED (gnu_variant_type) = TYPE_PACKED (gnu_record_type);
 
          /* Similarly, if the outer record has a size specified and all
          TYPE_PACKED (gnu_variant_type) = TYPE_PACKED (gnu_record_type);
 
          /* Similarly, if the outer record has a size specified and all

-            fields have record rep clauses, we can propagate the size
-            into the variant part.  */
+            the fields have a rep clause, we can propagate the size.  */

          if (all_rep_and_size)
            {
              TYPE_SIZE (gnu_variant_type) = TYPE_SIZE (gnu_record_type);
          if (all_rep_and_size)
            {
              TYPE_SIZE (gnu_variant_type) = TYPE_SIZE (gnu_record_type);


@@ -7186,20 +7525,25 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
             we aren't sure to really use it at this point, see below.  */
          components_to_record (gnu_variant_type, Component_List (variant),
                                NULL_TREE, packed, definition,
             we aren't sure to really use it at this point, see below.  */
          components_to_record (gnu_variant_type, Component_List (variant),
                                NULL_TREE, packed, definition,

-                               !all_rep_and_size, all_rep,
-                               unchecked_union, debug_info,
-                               true, reorder, &gnu_rep_list);
+                               !all_rep_and_size, all_rep, unchecked_union,
+                               true, debug_info, true, reorder,
+                               this_first_free_pos,
+                               all_rep || this_first_free_pos
+                               ? NULL : &gnu_rep_list);

 
          gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant));
 
          gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant));

-

          Set_Present_Expr (variant, annotate_value (gnu_qual));
 
          Set_Present_Expr (variant, annotate_value (gnu_qual));
 

-         /* If this is an Unchecked_Union and we have exactly one field,
-            use this field directly to match the layout of C unions.  */
-         if (unchecked_union
-             && TYPE_FIELDS (gnu_variant_type)
-             && !DECL_CHAIN (TYPE_FIELDS (gnu_variant_type)))
-           gnu_field = TYPE_FIELDS (gnu_variant_type);
+         /* If this is an Unchecked_Union whose fields are all in the variant
+            part and we have a single field with no representation clause or
+            placed at offset zero, use the field directly to match the layout
+            of C unions.  */
+         if (TREE_CODE (gnu_record_type) == UNION_TYPE
+             && (gnu_field = TYPE_FIELDS (gnu_variant_type)) != NULL_TREE
+             && !DECL_CHAIN (gnu_field)
+             && (!DECL_FIELD_OFFSET (gnu_field)
+                 || integer_zerop (bit_position (gnu_field))))
+           DECL_CONTEXT (gnu_field) = gnu_union_type;

          else
            {
              /* Deal with packedness like in gnat_to_gnu_field.  */
          else
            {
              /* Deal with packedness like in gnat_to_gnu_field.  */


@@ -7270,15 +7614,18 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
          gnu_variant_part
            = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
                                 all_rep ? TYPE_SIZE (gnu_union_type) : 0,
          gnu_variant_part
            = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
                                 all_rep ? TYPE_SIZE (gnu_union_type) : 0,

-                                all_rep ? bitsize_zero_node : 0,
+                                all_rep || this_first_free_pos
+                                ? bitsize_zero_node : 0,

                                 union_field_packed, 0);
 
          DECL_INTERNAL_P (gnu_variant_part) = 1;
                                 union_field_packed, 0);
 
          DECL_INTERNAL_P (gnu_variant_part) = 1;

-         DECL_CHAIN (gnu_variant_part) = gnu_field_list;
-         gnu_field_list = gnu_variant_part;

        }
     }
 
        }
     }
 

+  /* From now on, a zero FIRST_FREE_POS is totally useless.  */
+  if (first_free_pos && integer_zerop (first_free_pos))
+    first_free_pos = NULL_TREE;
+

   /* Scan GNU_FIELD_LIST and see if any fields have rep clauses and, if we are
      permitted to reorder components, self-referential sizes or variable sizes.
      If they do, pull them out and put them onto the appropriate list.  We have
   /* Scan GNU_FIELD_LIST and see if any fields have rep clauses and, if we are
      permitted to reorder components, self-referential sizes or variable sizes.
      If they do, pull them out and put them onto the appropriate list.  We have


@@ -7310,34 +7657,17 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
          continue;
        }
 
          continue;
        }
 

-      if (reorder)
+      if ((reorder || has_aliased_after_self_field)
+         && field_has_self_size (gnu_field))

        {
        {

-         /* Pull out the variant part and put it onto GNU_SELF_LIST.  */
-         if (gnu_field == gnu_variant_part)
-           {
-             MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
-             continue;
-           }
-
-         /* Skip internal fields and fields with fixed size.  */
-         if (!DECL_INTERNAL_P (gnu_field)
-             && !(DECL_SIZE (gnu_field)
-                  && TREE_CODE (DECL_SIZE (gnu_field)) == INTEGER_CST))
-           {
-             tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field));
-
-             if (CONTAINS_PLACEHOLDER_P (type_size))
-               {
-                 MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
-                 continue;
-               }
+         MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
+         continue;
+       }

 
 

-             if (TREE_CODE (type_size) != INTEGER_CST)
-               {
-                 MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
-                 continue;
-               }
-           }
+      if (reorder && field_has_variable_size (gnu_field))
+       {
+         MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
+         continue;

        }
 
       gnu_last = gnu_field;
        }
 
       gnu_last = gnu_field;


@@ -7345,7 +7675,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
 
 #undef MOVE_FROM_FIELD_LIST_TO
 
 
 #undef MOVE_FROM_FIELD_LIST_TO
 

-  /* If permitted, we reorder the components as follows:
+  /* If permitted, we reorder the fields as follows:

 
        1) all fixed length fields,
        2) all fields whose length doesn't depend on discriminants,
 
        1) all fixed length fields,
        2) all fields whose length doesn't depend on discriminants,


@@ -7358,14 +7688,20 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
       = chainon (nreverse (gnu_self_list),
                 chainon (nreverse (gnu_var_list), gnu_field_list));
 
       = chainon (nreverse (gnu_self_list),
                 chainon (nreverse (gnu_var_list), gnu_field_list));
 

-  /* If we have any fields in our rep'ed field list and it is not the case that
-     all the fields in the record have rep clauses and P_REP_LIST is nonzero,
-     set it and ignore these fields.  */
-  if (gnu_rep_list && p_gnu_rep_list && !all_rep)
+  /* Otherwise, if there is an aliased field placed after a field whose length
+     depends on discriminants, we put all the fields of the latter sort, last.
+     We need to do this in case an object of this record type is mutable.  */
+  else if (has_aliased_after_self_field)
+    gnu_field_list = chainon (nreverse (gnu_self_list), gnu_field_list);
+
+  /* If P_REP_LIST is nonzero, this means that we are asked to move the fields
+     in our REP list to the previous level because this level needs them in
+     order to do a correct layout, i.e. avoid having overlapping fields.  */
+  if (p_gnu_rep_list && gnu_rep_list)

     *p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_rep_list);
 
   /* Otherwise, sort the fields by bit position and put them into their own
     *p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_rep_list);
 
   /* Otherwise, sort the fields by bit position and put them into their own

-     record, before the others, if we also have fields without rep clauses.  */
+     record, before the others, if we also have fields without rep clause.  */

   else if (gnu_rep_list)
     {
       tree gnu_rep_type
   else if (gnu_rep_list)
     {
       tree gnu_rep_type


@@ -7393,11 +7729,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
       if (gnu_field_list)
        {
          finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info);
       if (gnu_field_list)
        {
          finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info);

-         gnu_field
-           = create_field_decl (get_identifier ("REP"), gnu_rep_type,
-                                gnu_record_type, NULL_TREE, NULL_TREE, 0, 1);
-         DECL_INTERNAL_P (gnu_field) = 1;
-         gnu_field_list = chainon (gnu_field_list, gnu_field);
+
+         /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields
+            without rep clause are laid out starting from this position.
+            Therefore, we force it as a minimal size on the REP part.  */
+         gnu_rep_part
+           = create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos);

        }
       else
        {
        }
       else
        {


@@ -7406,11 +7743,36 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
        }
     }
 
        }
     }
 

+  /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields without
+     rep clause are laid out starting from this position.  Therefore, if we
+     have not already done so, we create a fake REP part with this size.  */
+  if (first_free_pos && !layout_with_rep && !gnu_rep_part)
+    {
+      tree gnu_rep_type = make_node (RECORD_TYPE);
+      finish_record_type (gnu_rep_type, NULL_TREE, 0, debug_info);
+      gnu_rep_part
+       = create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos);
+    }
+
+  /* Now chain the REP part at the end of the reversed field list.  */
+  if (gnu_rep_part)
+    gnu_field_list = chainon (gnu_field_list, gnu_rep_part);
+
+  /* And the variant part at the beginning.  */
+  if (gnu_variant_part)
+    {
+      DECL_CHAIN (gnu_variant_part) = gnu_field_list;
+      gnu_field_list = gnu_variant_part;
+    }
+

   if (cancel_alignment)
     TYPE_ALIGN (gnu_record_type) = 0;
 
   finish_record_type (gnu_record_type, nreverse (gnu_field_list),
   if (cancel_alignment)
     TYPE_ALIGN (gnu_record_type) = 0;
 
   finish_record_type (gnu_record_type, nreverse (gnu_field_list),

-                     layout_with_rep ? 1 : 0, debug_info && !maybe_unused);
+                     layout_with_rep ? 1 : 0, false);
+  TYPE_ARTIFICIAL (gnu_record_type) = artificial;
+  if (debug_info && !maybe_unused)
+    rest_of_record_type_compilation (gnu_record_type);

 }
 \f
 /* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be
 }
 \f
 /* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be


@@ -7422,23 +7784,26 @@ annotate_value (tree gnu_size)
 {
   TCode tcode;
   Node_Ref_Or_Val ops[3], ret;
 {
   TCode tcode;
   Node_Ref_Or_Val ops[3], ret;

-  struct tree_int_map **h = NULL;
+  struct tree_int_map in;

   int i;
 
   /* See if we've already saved the value for this node.  */
   if (EXPR_P (gnu_size))
     {
   int i;
 
   /* See if we've already saved the value for this node.  */
   if (EXPR_P (gnu_size))
     {

-      struct tree_int_map in;
+      struct tree_int_map *e;
+

       if (!annotate_value_cache)
         annotate_value_cache = htab_create_ggc (512, tree_int_map_hash,
                                                tree_int_map_eq, 0);
       in.base.from = gnu_size;
       if (!annotate_value_cache)
         annotate_value_cache = htab_create_ggc (512, tree_int_map_hash,
                                                tree_int_map_eq, 0);
       in.base.from = gnu_size;

-      h = (struct tree_int_map **)
-           htab_find_slot (annotate_value_cache, &in, INSERT);
+      e = (struct tree_int_map *)
+           htab_find (annotate_value_cache, &in);

 
 

-      if (*h)
-       return (Node_Ref_Or_Val) (*h)->to;
+      if (e)
+       return (Node_Ref_Or_Val) e->to;

     }
     }

+  else
+    in.base.from = NULL_TREE;

 
   /* If we do not return inside this switch, TCODE will be set to the
      code to use for a Create_Node operand and LEN (set above) will be
 
   /* If we do not return inside this switch, TCODE will be set to the
      code to use for a Create_Node operand and LEN (set above) will be


@@ -7539,8 +7904,17 @@ annotate_value (tree gnu_size)
   ret = Create_Node (tcode, ops[0], ops[1], ops[2]);
 
   /* Save the result in the cache.  */
   ret = Create_Node (tcode, ops[0], ops[1], ops[2]);
 
   /* Save the result in the cache.  */

-  if (h)
+  if (in.base.from)

     {
     {

+      struct tree_int_map **h;
+      /* We can't assume the hash table data hasn't moved since the
+        initial look up, so we have to search again.  Allocating and
+        inserting an entry at that point would be an alternative, but
+        then we'd better discard the entry if we decided not to cache
+        it.  */
+      h = (struct tree_int_map **)
+           htab_find_slot (annotate_value_cache, &in, INSERT);
+      gcc_assert (!*h);

       *h = ggc_alloc_tree_int_map ();
       (*h)->base.from = gnu_size;
       (*h)->to = ret;
       *h = ggc_alloc_tree_int_map ();
       (*h)->base.from = gnu_size;
       (*h)->to = ret;


@@ -7796,7 +8170,7 @@ build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list,
          v->type = variant_type;
          v->field = gnu_field;
          v->qual = qual;
          v->type = variant_type;
          v->field = gnu_field;
          v->qual = qual;

-         v->record = NULL_TREE;
+         v->new_type = NULL_TREE;

 
          /* Recurse on the variant subpart of the variant, if any.  */
          variant_subpart = get_variant_part (variant_type);
 
          /* Recurse on the variant subpart of the variant, if any.  */
          variant_subpart = get_variant_part (variant_type);


@@ -8013,9 +8387,7 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
     SET_TYPE_RM_SIZE (gnu_type, size);
 
   /* ...or the Ada size for record and union types.  */
     SET_TYPE_RM_SIZE (gnu_type, size);
 
   /* ...or the Ada size for record and union types.  */

-  else if ((TREE_CODE (gnu_type) == RECORD_TYPE
-           || TREE_CODE (gnu_type) == UNION_TYPE
-           || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
+  else if (RECORD_OR_UNION_TYPE_P (gnu_type)

           && !TYPE_FAT_POINTER_P (gnu_type))
     SET_TYPE_ADA_SIZE (gnu_type, size);
 }
           && !TYPE_FAT_POINTER_P (gnu_type))
     SET_TYPE_ADA_SIZE (gnu_type, size);
 }


@@ -8053,7 +8425,7 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
 
       /* Only do something if the type is not a packed array type and
         doesn't already have the proper size.  */
 
       /* Only do something if the type is not a packed array type and
         doesn't already have the proper size.  */

-      if (TYPE_PACKED_ARRAY_TYPE_P (type)
+      if (TYPE_IS_PACKED_ARRAY_TYPE_P (type)

          || (TYPE_PRECISION (type) == size && biased_p == for_biased))
        break;
 
          || (TYPE_PRECISION (type) == size && biased_p == for_biased))
        break;
 


@@ -8499,6 +8871,24 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type,
   return new_field;
 }
 
   return new_field;
 }
 

+/* Create the REP part of RECORD_TYPE with REP_TYPE.  If MIN_SIZE is nonzero,
+   it is the minimal size the REP_PART must have.  */
+
+static tree
+create_rep_part (tree rep_type, tree record_type, tree min_size)
+{
+  tree field;
+
+  if (min_size && !tree_int_cst_lt (TYPE_SIZE (rep_type), min_size))
+    min_size = NULL_TREE;
+
+  field = create_field_decl (get_identifier ("REP"), rep_type, record_type,
+                            min_size, bitsize_zero_node, 0, 1);
+  DECL_INTERNAL_P (field) = 1;
+
+  return field;
+}
+

 /* Return the REP part of RECORD_TYPE, if any.  Otherwise return NULL.  */
 
 static tree
 /* Return the REP part of RECORD_TYPE, if any.  Otherwise return NULL.  */
 
 static tree


@@ -8507,10 +8897,10 @@ get_rep_part (tree record_type)
   tree field = TYPE_FIELDS (record_type);
 
   /* The REP part is the first field, internal, another record, and its name
   tree field = TYPE_FIELDS (record_type);
 
   /* The REP part is the first field, internal, another record, and its name

-     doesn't start with an underscore (i.e. is not generated by the FE).  */
+     starts with an 'R'.  */

   if (DECL_INTERNAL_P (field)
       && TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE
   if (DECL_INTERNAL_P (field)
       && TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE

-      && IDENTIFIER_POINTER (DECL_NAME (field)) [0] != '_')
+      && IDENTIFIER_POINTER (DECL_NAME (field)) [0] == 'R')

     return field;
 
   return NULL_TREE;
     return field;
 
   return NULL_TREE;


@@ -8553,7 +8943,9 @@ create_variant_part_from (tree old_variant_part,
 
   /* First create the type of the variant part from that of the old one.  */
   new_union_type = make_node (QUAL_UNION_TYPE);
 
   /* First create the type of the variant part from that of the old one.  */
   new_union_type = make_node (QUAL_UNION_TYPE);

-  TYPE_NAME (new_union_type) = DECL_NAME (TYPE_NAME (old_union_type));
+  TYPE_NAME (new_union_type)
+    = concat_name (TYPE_NAME (record_type),
+                  IDENTIFIER_POINTER (DECL_NAME (old_variant_part)));

 
   /* If the position of the variant part is constant, subtract it from the
      size of the type of the parent to get the new size.  This manual CSE
 
   /* If the position of the variant part is constant, subtract it from the
      size of the type of the parent to get the new size.  This manual CSE


@@ -8587,7 +8979,7 @@ create_variant_part_from (tree old_variant_part,
        continue;
 
       /* Retrieve the list of fields already added to the new variant.  */
        continue;
 
       /* Retrieve the list of fields already added to the new variant.  */

-      new_variant = v->record;
+      new_variant = v->new_type;

       field_list = TYPE_FIELDS (new_variant);
 
       /* If the old variant had a variant subpart, we need to create a new
       field_list = TYPE_FIELDS (new_variant);
 
       /* If the old variant had a variant subpart, we need to create a new


@@ -8867,10 +9259,8 @@ rm_size (tree gnu_type)
                  rm_size (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))),
                  DECL_SIZE (TYPE_FIELDS (gnu_type)));
 
                  rm_size (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))),
                  DECL_SIZE (TYPE_FIELDS (gnu_type)));
 

-  /* For record types, we store the size explicitly.  */
-  if ((TREE_CODE (gnu_type) == RECORD_TYPE
-       || TREE_CODE (gnu_type) == UNION_TYPE
-       || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
+  /* For record or union types, we store the size explicitly.  */
+  if (RECORD_OR_UNION_TYPE_P (gnu_type)

       && !TYPE_FAT_POINTER_P (gnu_type)
       && TYPE_ADA_SIZE (gnu_type))
     return TYPE_ADA_SIZE (gnu_type);
       && !TYPE_FAT_POINTER_P (gnu_type)
       && TYPE_ADA_SIZE (gnu_type))
     return TYPE_ADA_SIZE (gnu_type);


@@ -8901,7 +9291,7 @@ create_concat_name (Entity_Id gnat_entity, const char *suffix)
 
   if (suffix)
     {
 
   if (suffix)
     {

-      String_Template temp = {1, strlen (suffix)};
+      String_Template temp = {1, (int) strlen (suffix)};

       Fat_Pointer fp = {suffix, &temp};
       Get_External_Name_With_Suffix (gnat_entity, fp);
     }
       Fat_Pointer fp = {suffix, &temp};
       Get_External_Name_With_Suffix (gnat_entity, fp);
     }