DWARF: describe properly Ada packed arrays

gcc/ada/ChangeLog:

	* gcc-interface/ada-tree.h
	(TYPE_IMPLEMENTS_PACKED_ARRAY_P, TYPE_CAN_HAVE_DEBUG_TYPE_P,
	TYPE_ORIGINAL_PACKED_ARRAY, SET_TYPE_ORIGINAL_PACKED_ARRAY): New
	macros.
	* gcc-interface/decl.c (add_parallel_type_for_packed_array):
	Rename to associate_original_type_to_packed_array.  When
	-fgnat-encodings=minimal, set original packed array type as so
	instead of as a parallel type to the implementation type.  In
	this case, also rename the implementation type to the name of
	the original array type.
	(gnat_to_gnu_entity): Update invocations to
	add_parallel_type_for_packed_array.  Tag ARRAY_TYPE nodes for
	packed arrays with the TYPE_PACKED flag.
	When -fgnat-encodings=minimal:
	  - strip ___XP suffixes in packed arrays' names;
	  - set the debug type for padding records around packed arrays
	    to the packed array;
	  - do not attach ___XUP types as parallel types of constrained
	    array types.
	* gcc-interface/misc.c (gnat_print_type): Update to handle
	orignal packed arrays.
	(gnat_get_debug_type): Update to reject packed arrays
	implementation types.
	(get_array_bit_stride): New.
	(gnat_get_array_descr_info): Add packed arrays handling.
	* gcc-interface/utils.c (maybe_pad_type): When
	-fgnat-encodings=minimal, set the name of the padding type to
	the one of the original packed type, if any.  Fix TYPE_DECL
	peeling around the name of the input type.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@231768 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 252 insertions, 29 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 80c5a39d803..0ad84e2bb76 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,37 @@
 2015-12-17  Pierre-Marie de Rodat  <derodat@adacore.com>
 
+	* gcc-interface/ada-tree.h
+	(TYPE_IMPLEMENTS_PACKED_ARRAY_P, TYPE_CAN_HAVE_DEBUG_TYPE_P,
+	TYPE_ORIGINAL_PACKED_ARRAY, SET_TYPE_ORIGINAL_PACKED_ARRAY): New
+	macros.
+	* gcc-interface/decl.c (add_parallel_type_for_packed_array):
+	Rename to associate_original_type_to_packed_array.  When
+	-fgnat-encodings=minimal, set original packed array type as so
+	instead of as a parallel type to the implementation type.  In
+	this case, also rename the implementation type to the name of
+	the original array type.
+	(gnat_to_gnu_entity): Update invocations to
+	add_parallel_type_for_packed_array.  Tag ARRAY_TYPE nodes for
+	packed arrays with the TYPE_PACKED flag.
+	When -fgnat-encodings=minimal:
+	  - strip ___XP suffixes in packed arrays' names;
+	  - set the debug type for padding records around packed arrays
+	    to the packed array;
+	  - do not attach ___XUP types as parallel types of constrained
+	    array types.
+	* gcc-interface/misc.c (gnat_print_type): Update to handle
+	orignal packed arrays.
+	(gnat_get_debug_type): Update to reject packed arrays
+	implementation types.
+	(get_array_bit_stride): New.
+	(gnat_get_array_descr_info): Add packed arrays handling.
+	* gcc-interface/utils.c (maybe_pad_type): When
+	-fgnat-encodings=minimal, set the name of the padding type to
+	the one of the original packed type, if any.  Fix TYPE_DECL
+	peeling around the name of the input type.
+
+2015-12-17  Pierre-Marie de Rodat  <derodat@adacore.com>
+
 	* gcc-interface/misc.c (gnat_get_type_bias): New.
 	(LANG_HOOKS_GET_TYPE_BIAS): Redefine macro to implement the
 	get_type_bias language hook.
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 709fdc27061..830062791b9 100644
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -187,6 +187,17 @@ do {							 \
    alignment value the type ought to have.  */
 #define TYPE_MAX_ALIGN(NODE) (TYPE_PRECISION (RECORD_OR_UNION_CHECK (NODE)))
 
+/* True for types that implement a packed array and for original packed array
+   types.  */
+#define TYPE_IMPLEMENTS_PACKED_ARRAY_P(NODE) \
+  ((TREE_CODE (NODE) == ARRAY_TYPE && TYPE_PACKED (NODE))		      \
+    || (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_PACKED_ARRAY_TYPE_P (NODE))) \
+
+/* True for types that can hold a debug type.  */
+#define TYPE_CAN_HAVE_DEBUG_TYPE_P(NODE)  \
+ (!TYPE_IMPLEMENTS_PACKED_ARRAY_P (NODE)  \
+  && TYPE_DEBUG_TYPE (NODE) != NULL_TREE)
+
 /* For an UNCONSTRAINED_ARRAY_TYPE, this is the record containing both the
    template and the object.
 
@@ -374,6 +385,21 @@ do {						   \
 #define SET_TYPE_SCALE_FACTOR(NODE, X) \
   SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
 
+/* For types with TYPE_CAN_HAVE_DEBUG_TYPE_P, this is the type to use in
+   debugging information.  */
+#define TYPE_DEBUG_TYPE(NODE) \
+  GET_TYPE_LANG_SPECIFIC2(NODE)
+#define SET_TYPE_DEBUG_TYPE(NODE, X) \
+  SET_TYPE_LANG_SPECIFIC2(NODE, X)
+
+/* For types with TYPE_IMPLEMENTS_PACKED_ARRAY_P, this is the original packed
+   array type.  Note that this predicate is trou for original packed array
+   types, so these cannot have a debug type.  */
+#define TYPE_ORIGINAL_PACKED_ARRAY(NODE) \
+  GET_TYPE_LANG_SPECIFIC2(NODE)
+#define SET_TYPE_ORIGINAL_PACKED_ARRAY(NODE, X) \
+  SET_TYPE_LANG_SPECIFIC2(NODE, X)
+
 
 /* Flags added to decl nodes.  */
 
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 287898ffb94..7058ef0809f 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -195,7 +195,7 @@ static tree get_rep_part (tree);
 static tree create_variant_part_from (tree, vec<variant_desc> , tree,
 				      tree, vec<subst_pair> );
 static void copy_and_substitute_in_size (tree, tree, vec<subst_pair> );
-static void add_parallel_type_for_packed_array (tree, Entity_Id);
+static void associate_original_type_to_packed_array (tree, Entity_Id);
 static const char *get_entity_char (Entity_Id);
 
 /* The relevant constituents of a subprogram binding to a GCC builtin.  Used
@@ -1806,9 +1806,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       TYPE_STUB_DECL (gnu_type)
 	= create_type_stub_decl (gnu_entity_name, gnu_type);
 
-      /* For a packed array, make the original array type a parallel type.  */
+      /* For a packed array, make the original array type a parallel/debug
+	 type.  */
       if (debug_info_p && Is_Packed_Array_Impl_Type (gnat_entity))
-	add_parallel_type_for_packed_array (gnu_type, gnat_entity);
+	associate_original_type_to_packed_array (gnu_type, gnat_entity);
 
     discrete_type:
 
@@ -1841,6 +1842,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			    UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
 	  TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
 
+	  /* Strip the ___XP suffix for standard DWARF.  */
+	  if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
+	    gnu_entity_name = TYPE_NAME (gnu_type);
+
 	  /* Create a stripped-down declaration, mainly for debugging.  */
 	  create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
 			    gnat_entity);
@@ -1885,8 +1890,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	  if (debug_info_p)
 	    {
-	      /* Make the original array type a parallel type.  */
-	      add_parallel_type_for_packed_array (gnu_type, gnat_entity);
+	      /* Make the original array type a parallel/debug type.  */
+	      associate_original_type_to_packed_array (gnu_type, gnat_entity);
+
+	      /* Since GNU_TYPE is a padding type around the packed array
+		 implementation type, the padded type is its debug type.  */
+	      if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
+		SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type);
 
 	      rest_of_record_type_compilation (gnu_type);
 	    }
@@ -2241,6 +2251,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	TYPE_CONVENTION_FORTRAN_P (tem) = convention_fortran_p;
 
+	/* Tag top-level ARRAY_TYPE nodes for packed arrays and their
+	   implementation types as such so that the debug information back-end
+	   can output the appropriate description for them.  */
+	TYPE_PACKED (tem)
+	  = (Is_Packed (gnat_entity)
+	     || Is_Packed_Array_Impl_Type (gnat_entity));
+
 	if (Treat_As_Volatile (gnat_entity))
 	  tem = change_qualified_type (tem, TYPE_QUAL_VOLATILE);
 
@@ -2603,6 +2620,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
 	    }
 
+	  /* Strip the ___XP suffix for standard DWARF.  */
+	  if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL
+	      && Is_Packed_Array_Impl_Type (gnat_entity))
+	    {
+	      Entity_Id gnat_original_array_type
+		= Underlying_Type (Original_Array_Type (gnat_entity));
+
+	      gnu_entity_name
+		= get_entity_name (gnat_original_array_type);
+	    }
+
 	  /* Attach the TYPE_STUB_DECL in case we have a parallel type.  */
 	  TYPE_STUB_DECL (gnu_type)
 	    = create_type_stub_decl (gnu_entity_name, gnu_type);
@@ -2677,17 +2705,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    }
 
 	  /* If this is a packed array type, make the original array type a
-	     parallel type.  Otherwise, do it for the base array type if it
-	     isn't artificial to make sure it is kept in the debug info.  */
+	     parallel/debug type.  Otherwise, if such GNAT encodings are
+	     required, do it for the base array type if it isn't artificial to
+	     make sure it is kept in the debug info.  */
 	  if (debug_info_p)
 	    {
 	      if (Is_Packed_Array_Impl_Type (gnat_entity))
-		add_parallel_type_for_packed_array (gnu_type, gnat_entity);
+		associate_original_type_to_packed_array (gnu_type,
+							 gnat_entity);
 	      else
 		{
 		  tree gnu_base_decl
 		    = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, 0);
-		  if (!DECL_ARTIFICIAL (gnu_base_decl))
+		  if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL
+		      && !DECL_ARTIFICIAL (gnu_base_decl))
 		    add_parallel_type (gnu_type,
 				       TREE_TYPE (TREE_TYPE (gnu_base_decl)));
 		}
@@ -2698,6 +2729,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    = (Is_Packed_Array_Impl_Type (gnat_entity)
 	       && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
 
+	/* Tag top-level ARRAY_TYPE nodes for packed arrays and their
+	   implementation types as such so that the debug information back-end
+	   can output the appropriate description for them.  */
+	  TYPE_PACKED (gnu_type)
+	    = (Is_Packed (gnat_entity)
+	       || Is_Packed_Array_Impl_Type (gnat_entity));
+
 	  /* If the size is self-referential and the maximum size doesn't
 	     overflow, use it.  */
 	  if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
@@ -2754,6 +2792,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				      NULL_TREE, 0);
 	      this_made_decl = true;
 	      gnu_type = TREE_TYPE (gnu_decl);
+
 	      save_gnu_tree (gnat_entity, NULL_TREE, false);
 
 	      gnu_inner = gnu_type;
@@ -8832,12 +8871,14 @@ copy_and_substitute_in_size (tree new_type, tree old_type,
   TYPE_SIZE_UNIT (new_type) = variable_size (TYPE_SIZE_UNIT (new_type));
 }
 
-/* Add a parallel type to GNU_TYPE, the translation of GNAT_ENTITY, which is
-   the implementation type of a packed array type (Is_Packed_Array_Impl_Type).
-   The parallel type is the original array type if it has been translated.  */
+/* Associate to GNU_TYPE, the translation of GNAT_ENTITY, which is
+   the implementation type of a packed array type (Is_Packed_Array_Impl_Type),
+   the original array type if it has been translated.  This association is a
+   parallel type for GNAT encodings or a debug type for standard DWARF.  Note
+   that for standard DWARF, we also want to get the original type name.  */
 
 static void
-add_parallel_type_for_packed_array (tree gnu_type, Entity_Id gnat_entity)
+associate_original_type_to_packed_array (tree gnu_type, Entity_Id gnat_entity)
 {
   Entity_Id gnat_original_array_type
     = Underlying_Type (Original_Array_Type (gnat_entity));
@@ -8851,7 +8892,18 @@ add_parallel_type_for_packed_array (tree gnu_type, Entity_Id gnat_entity)
   if (TYPE_IS_DUMMY_P (gnu_original_array_type))
     return;
 
-  add_parallel_type (gnu_type, gnu_original_array_type);
+  if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
+    {
+      tree original_name = TYPE_NAME (gnu_original_array_type);
+
+      if (TREE_CODE (original_name) == TYPE_DECL)
+	original_name = DECL_NAME (original_name);
+
+      SET_TYPE_ORIGINAL_PACKED_ARRAY (gnu_type, gnu_original_array_type);
+      TYPE_NAME (gnu_type) = original_name;
+    }
+  else
+    add_parallel_type (gnu_type, gnu_original_array_type);
 }
 
 /* Given a type T, a FIELD_DECL F, and a replacement value R, return a
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index 269960f917d..adaea7f6465 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -528,9 +528,12 @@ gnat_print_type (FILE *file, tree node, int indent)
       break;
     }
 
-  if (TYPE_DEBUG_TYPE (node) != NULL_TREE)
-    print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node),
-		      indent + 4);
+  if (TYPE_CAN_HAVE_DEBUG_TYPE_P (node) && TYPE_DEBUG_TYPE (node) != NULL_TREE)
+    print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), indent + 4);
+  else if (TYPE_IMPLEMENTS_PACKED_ARRAY_P (node)
+	   && TYPE_ORIGINAL_PACKED_ARRAY (node) != NULL_TREE)
+    print_node_brief (file, "original packed array",
+		      TYPE_ORIGINAL_PACKED_ARRAY (node), indent + 4);
 }
 
 /* Return the name to be printed for DECL.  */
@@ -578,7 +581,18 @@ gnat_descriptive_type (const_tree type)
 static tree
 gnat_get_debug_type (const_tree type)
 {
-  return TYPE_DEBUG_TYPE (type);
+  if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type))
+    {
+      type = TYPE_DEBUG_TYPE (type);
+      /* ??? Kludge: the get_debug_type language hook is processed after the
+	 array descriptor language hook, so if there is an array behind this
+	 type, the latter is supposed to handle it.  Still, we can get here
+	 with a type we are not supposed to handle (when the DWARF back-end
+	 processes the type of a variable), so keep this guard.  */
+      if (type != NULL_TREE && !TYPE_IMPLEMENTS_PACKED_ARRAY_P (type))
+	return const_cast<tree> (type);
+    }
+  return NULL_TREE;
 }
 
 /* Provide information in INFO for debugging output about the TYPE fixed-point
@@ -732,17 +746,21 @@ gnat_type_max_size (const_tree gnu_type)
   return max_unitsize;
 }
 
+static tree get_array_bit_stride (tree comp_type);
+
 /* Provide information in INFO for debug output about the TYPE array type.
    Return whether TYPE is handled.  */
 
 static bool
-gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
+gnat_get_array_descr_info (const_tree const_type,
+			   struct array_descr_info *info)
 {
   bool convention_fortran_p;
   bool is_array = false;
   bool is_fat_ptr = false;
+  bool is_packed_array = false;
 
-  const tree type_ = const_cast<tree> (type);
+  tree type = const_cast<tree> (const_type);
 
   const_tree first_dimen = NULL_TREE;
   const_tree last_dimen = NULL_TREE;
@@ -756,6 +774,20 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
   tree thinptr_template_expr = NULL_TREE;
   tree thinptr_bound_field = NULL_TREE;
 
+  /* ??? Kludge: see gnat_get_debug_type.  */
+  if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type)
+      && TYPE_DEBUG_TYPE (type) != NULL_TREE)
+    type = TYPE_DEBUG_TYPE (type);
+
+  /* If we have an implementation type for a packed array, get the orignial
+     array type.  */
+  if (TYPE_IMPLEMENTS_PACKED_ARRAY_P (type)
+      && TYPE_ORIGINAL_PACKED_ARRAY (type) != NULL_TREE)
+    {
+      is_packed_array = true;
+      type = TYPE_ORIGINAL_PACKED_ARRAY (type);
+    }
+
   /* First pass: gather all information about this array except everything
      related to dimensions.  */
 
@@ -772,10 +804,10 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
   else if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL
 	   && TYPE_IS_FAT_POINTER_P (type))
     {
-      const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type_);
+      const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type);
 
       /* This will be our base object address.  */
-      const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_);
+      const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
 
       /* We assume below that maybe_unconstrained_array returns an INDIRECT_REF
 	 node.  */
@@ -803,7 +835,7 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
       /* This will be our base object address.  Note that we assume that
 	 pointers to these will actually point to the array field (thin
 	 pointers are shifted).  */
-      const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_);
+      const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
       const tree placeholder_addr
         = build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr);
 
@@ -838,6 +870,8 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
   /* Second pass: compute the remaining information: dimensions and
      corresponding bounds.  */
 
+  if (TYPE_PACKED (first_dimen))
+    is_packed_array = true;
   /* If this array has fortran convention, it's arranged in column-major
      order, so our view here has reversed dimensions.  */
   convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen);
@@ -937,13 +971,13 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
   info->allocated = NULL_TREE;
   info->associated = NULL_TREE;
 
-  /* When arrays contain dynamically-sized elements, we usually wrap them in
-     padding types, or we create constrained types for them.  Then, if such
-     types are stripped in the debugging information output, the debugger needs
-     a way to know the size that is reserved for each element.  This is why we
-     emit a stride in such situations.  */
   if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
     {
+      /* When arrays contain dynamically-sized elements, we usually wrap them
+	 in padding types, or we create constrained types for them.  Then, if
+	 such types are stripped in the debugging information output, the
+	 debugger needs a way to know the size that is reserved for each
+	 element.  This is why we emit a stride in such situations.  */
       tree source_element_type = info->element_type;
 
       while (1)
@@ -962,11 +996,80 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
 	  info->stride = TYPE_SIZE_UNIT (info->element_type);
 	  info->stride_in_bits = false;
 	}
+
+      /* We need to specify a bit stride when it does not correspond to the
+	 natural size of the contained elements.  ??? Note that we do not
+	 support packed records and nested packed arrays.  */
+      else if (is_packed_array)
+	{
+	  info->stride = get_array_bit_stride (info->element_type);
+	  info->stride_in_bits = true;
+	}
     }
 
   return true;
 }
 
+/* Given the component type COMP_TYPE of a packed array, return an expression
+   that computes the bit stride of this packed array.  Return NULL_TREE when
+   unsuccessful.  */
+
+static tree
+get_array_bit_stride (tree comp_type)
+{
+  struct array_descr_info info;
+  tree stride;
+
+  /* Simple case: the array contains an integral type: return its RM size.  */
+  if (INTEGRAL_TYPE_P (comp_type))
+    return TYPE_RM_SIZE (comp_type);
+
+  /* Otherwise, see if this is an array we can analyze.  */
+  memset (&info, 0, sizeof (info));
+  if (!gnat_get_array_descr_info (comp_type, &info)
+      || info.stride == NULL_TREE)
+    /* If it's not, give it up.  */
+    return NULL_TREE;
+
+  /* Otherwise, the array stride is the inner array's stride multiplied by the
+     number of elements it contains.  Note that if the inner array is not
+     packed, then the stride is "natural" and thus does not deserve an
+     attribute.  */
+  stride = info.stride;
+  if (!info.stride_in_bits)
+    {
+      stride = fold_convert (bitsizetype, stride);
+      stride = build_binary_op (MULT_EXPR, bitsizetype,
+				stride, build_int_cstu (bitsizetype, 8));
+    }
+
+  for (int i = 0; i < info.ndimensions; ++i)
+    {
+      tree count;
+
+      if (info.dimen[i].lower_bound == NULL_TREE
+	  || info.dimen[i].upper_bound == NULL_TREE)
+	return NULL_TREE;
+
+      /* Put in count an expression that computes the length of this
+	 dimension.  */
+      count = build_binary_op (MINUS_EXPR, sbitsizetype,
+			       fold_convert (sbitsizetype,
+					     info.dimen[i].upper_bound),
+			       fold_convert (sbitsizetype,
+					     info.dimen[i].lower_bound)),
+      count = build_binary_op (PLUS_EXPR, sbitsizetype,
+			       count, build_int_cstu (sbitsizetype, 1));
+      count = build_binary_op (MAX_EXPR, sbitsizetype,
+			       count,
+			       build_int_cstu (sbitsizetype, 0));
+      count = fold_convert (bitsizetype, count);
+      stride = build_binary_op (MULT_EXPR, bitsizetype, stride, count);
+    }
+
+  return stride;
+}
+
 /* GNU_TYPE is a subtype of an integral type.  Set LOWVAL to the low bound
    and HIGHVAL to the high bound, respectively.  */
 
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 1816f3a9a26..be3565a503f 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1281,7 +1281,17 @@ maybe_pad_type (tree type, tree size, unsigned int align,
   if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
     SET_TYPE_DEBUG_TYPE (record, type);
 
-  if (Present (gnat_entity))
+  /* ??? Kludge: padding types around packed array implementation types will be
+     considered as root types in the array descriptor language hook (see
+     gnat_get_array_descr_info). Give them the original packed array type
+     name so that the one coming from sources appears in the debugging
+     information.  */
+  if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL
+      && TYPE_IMPLEMENTS_PACKED_ARRAY_P (type)
+      && TYPE_ORIGINAL_PACKED_ARRAY (type) != NULL_TREE)
+    TYPE_NAME (record)
+      = TYPE_NAME (TYPE_ORIGINAL_PACKED_ARRAY (type));
+  else if (Present (gnat_entity))
     TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
 
   TYPE_ALIGN (record) = align ? align : orig_align;