Re: [RFA/DWARF] Add DW_AT_GNAT_descriptive_type support

Re: [RFA/DWARF] Add DW_AT_GNAT_descriptive_type support

[Tom Tromey]

>>>>> "Joel" == Joel Brobecker <brobecker@adacore.com> writes:

Joel> I have taken the time to order the patches to follow the same order
Joel> as if I was to write the patch all over again (gdbtypes updates,
Joel> dwarf2read updates, etc).  Hopefully this will help reading it.

Thanks...  though I don't really want to encourage this sort of thing,
because it will mean people will start expect it from me ;-)

This patch seems pretty reasonable.

Joel> There are still a couple of things that are worth discussing:

Joel>   (a) You'll see that I put a FIXME after modifying the
Joel>   TYPE_CPLUS_SPECIFIC macro.  The comment says it all.  I think
Joel>   that the fix is fine; in fact, we could generalize this approach
Joel>   to all the accessor macros for the type-specific union - I
Joel>   wouldn't see a problem with that, and would make the code more
Joel>   resilient to incorrect field access.  For now, I opted for just
Joel>   fixing this one macro, since C is usually the "universal" "bare"
Joel>   language.  Ada or C++ might be less so: Who would want to use
Joel>   C++ or Ada to display a Fortran array? :-)

The modified macro uses the default if Gnat aux info is available.  It
seem to me that the check should instead be to see if the C++ info is
not available.

Joel>   (b) We need to determine how GCC will tell GDB that it uses the
Joel>   DW_AT_GNAT_descriptive_type attribute.
[...]
Joel>       What's the best way for GCC to tell GDB? At AdaCore, we relied
Joel>       on a hack, where we parsed a special marker in the CU producer
Joel>       attribute.  It's kind of gross, but it served us well.  Any
Joel>       suggestion?
      
How about a new GNU extension attribute in the CU DIE?

Joel> +  if (! HAVE_CPLUS_STRUCT (type))
Joel> +    n_base_classes = 0;
Joel> +  else
Joel> +    n_base_classes = TYPE_N_BASECLASSES (type);

This seems a little weird to me.
Do we need this everywhere we use TYPE_N_BASECLASSES?

Tom

Re: [RFA/DWARF] Add DW_AT_GNAT_descriptive_type support

[Joel Brobecker]

[-- Attachment #1: Type: text/plain, Size: 5685 bytes --]

Thanks for the detailed review, Tom.

> Joel>   (a) You'll see that I put a FIXME after modifying the
> Joel>   TYPE_CPLUS_SPECIFIC macro.  The comment says it all.  I think
> Joel>   that the fix is fine; in fact, we could generalize this approach
> Joel>   to all the accessor macros for the type-specific union - I
> Joel>   wouldn't see a problem with that, and would make the code more
> Joel>   resilient to incorrect field access.  For now, I opted for just
> Joel>   fixing this one macro, since C is usually the "universal" "bare"
> Joel>   language.  Ada or C++ might be less so: Who would want to use
> Joel>   C++ or Ada to display a Fortran array? :-)
> 
> The modified macro uses the default if Gnat aux info is available.  It
> seem to me that the check should instead be to see if the C++ info is
> not available.

Good point. This is a bit of the past coming back at us, where the
initial implementation had no discriminant, just a crude way of checking
whether the type had some gnat-stuff or not.  I have change it to
test for !HAVE_CPLUS_STRUCT.

> Joel>   (b) We need to determine how GCC will tell GDB that it uses the
> Joel>   DW_AT_GNAT_descriptive_type attribute.
> [...]
> Joel>       What's the best way for GCC to tell GDB? At AdaCore, we relied
> Joel>       on a hack, where we parsed a special marker in the CU producer
> Joel>       attribute.  It's kind of gross, but it served us well.  Any
> Joel>       suggestion?
>       
> How about a new GNU extension attribute in the CU DIE?

I think it's a brilliant idea. I'll pass it on to Eric for discussion
with the GCC guys. Thanks!

> Joel> +  if (! HAVE_CPLUS_STRUCT (type))
> Joel> +    n_base_classes = 0;
> Joel> +  else
> Joel> +    n_base_classes = TYPE_N_BASECLASSES (type);
> 
> This seems a little weird to me.
> Do we need this everywhere we use TYPE_N_BASECLASSES?

Yes, but at the same no. Another really good catch.  Yes, because
if the types does not HAVE_CPLUS_STRUCT, then you can technically
not request its TYPE_N_BASECLASSES. However, thanks to the change
above where TYPE_CPLUS_SPECIFIC returns the default cplus-stuff,
and because TYPE_N_BASECLASSES uses TYPE_CPLUS_SPECIFIC to access
the cplus-stuff, TYPE_N_BASECLASSES returns the n_baseclasses value
from the default-cplus stuff, which is zero.

So, I simply removed those changes from the diff.

Here is a new version of the patch.  I only made the two changes above.
Perhaps I should also add a comment besides TYPE_N_BASECLASSES to explain
that it returns 0 if !HAVE_CPLUS_STRUCT, but I think it's fine as it is
now, given the specific comment besides TYPE_CPLUS_SPECIFIC.

gdb/ChangeLog:

        Add support for DW_AT_GNAT_descriptive_type.
        * gdbtypes.h (enum type_specific_kind): New enum.
        (struct main_type) [type_specific_field]: New component.
        [type_specific]: Add new component "gnat_stuff".
        (struct gnat_aux_type): New type.
        (INIT_CPLUS_SPECIFIC): Also set TYPE_SPECIFIC_FIELD (type).
        (HAVE_CPLUS_STRUCT): Also check TYPE_SPECIFIC_FIELD (type).
        (gnat_aux_default, allocate_gnat_aux_type): Add declaration.
        (INIT_GNAT_SPECIFIC, ALLOCATE_GNAT_AUX_TYPE, HAVE_GNAT_AUX_INFO)
        (TYPE_SPECIFIC_FIELD): New macros.
        (TYPE_CPLUS_SPECIFIC): Return cplus_struct_default if the given
        type does not hold any cplus-specific data.
        (TYPE_RAW_CPLUS_SPECIFIC): New macro.
        (TYPE_GNAT_SPECIFIC, TYPE_DESCRIPTIVE_TYPE): New macros.
        (TYPE_IS_OPAQUE): Use HAVE_CPLUS_STRUCT to check if type has
        cplus-specific data.
        * gdbtypes.c (allocate_cplus_struct_type): Minor stylistic rewrite.
        Set new component TYPE_SPECIFIC_FIELD (type).
        (gnat_aux_default): New constant.
        (allocate_gnat_aux_type): New function.
        (init_type): Add initialization the type-specific stuff for
        TYPE_CODE_FLT and TYPE_CODE_FUNC types.
        (print_gnat_stuff): New function.
        (recursive_dump_type): Use HAVE_CPLUS_STRUCT to check for cplus-
        specific data.  Adjust code that prints the contents of the
        type-specific union using the TYPE_SPECIFIC_FIELD value.
        * dwarf2read.c (dwarf2_attach_fields_to_type): Do not allocate
        the type cplus stuff for Ada types.
        (dwarf2_add_member_fn, dwarf2_attach_fn_fields_to_type):
        Error out if these routines are called with an Ada type.
        (read_structure_type, read_array_type, read_subrange_type):
        Add call to set_descriptive_type.
        (set_die_type): Initialize the gnat-specific data if necessary.
        (need_gnat_info, die_descriptive_type, set_descriptive_type):
        New functions.
        * ada-lang.c (decode_constrained_packed_array_type): Use
        decode_constrained_packed_array_type instead of doing a standard
        lookup to locate a parallel type.
        (find_parallel_type_by_descriptive_type): New function.
        (ada_find_parallel_type_with_name): New function.
        (ada_find_parallel_type): Reimplement using
        ada_find_parallel_type_with_name.
        * ada-valprint.c (print_field_values): Use HAVE_CPLUS_STRUCT
        to check if type has a cplus stuff.
        * linespec.c (total_number_of_methods): Likewise.
        * mdebugread.c (new_type): Likewise.

gdb/testsuite/ChangeLog:

        * gdb.base/maint.exp: Adjust the expected output for the
        "maint print type" test. Use gdb_test_multiple instead of
        gdb_sent/gdb_expect.

Tested on x86_64-linux. No regression, just one expected change.
I think this addresses both of Tom's comments, but I'm going to wait
a little for confirmation and/or last second objections.

-- 
Joel

[-- Attachment #2: at-descriptive-type.diff --]
[-- Type: text/x-diff, Size: 28921 bytes --]

commit ed92ab4e39caeb4b17232496294d6804bda40ea6
Author: Joel Brobecker <brobecker@adacore.com>
Date:   Tue Sep 29 10:57:00 2009 -0700

    Add support for DW_AT_GNAT_descriptive_type.
    
    include/ChangeLog: (already checked in)
    
            * dwarf2.h (enum dwarf_attribute): Add DW_AT_GNAT_descriptive_type.
    
    gdb/ChangeLog:
    
            Add support for DW_AT_GNAT_descriptive_type.
            * gdbtypes.h (enum type_specific_kind): New enum.
            (struct main_type) [type_specific_field]: New component.
            [type_specific]: Add new component "gnat_stuff".
            (struct gnat_aux_type): New type.
            (INIT_CPLUS_SPECIFIC): Also set TYPE_SPECIFIC_FIELD (type).
            (HAVE_CPLUS_STRUCT): Also check TYPE_SPECIFIC_FIELD (type).
            (gnat_aux_default, allocate_gnat_aux_type): Add declaration.
            (INIT_GNAT_SPECIFIC, ALLOCATE_GNAT_AUX_TYPE, HAVE_GNAT_AUX_INFO)
            (TYPE_SPECIFIC_FIELD): New macros.
            (TYPE_CPLUS_SPECIFIC): Return cplus_struct_default if the given
            type does not hold any cplus-specific data.
            (TYPE_RAW_CPLUS_SPECIFIC): New macro.
            (TYPE_GNAT_SPECIFIC, TYPE_DESCRIPTIVE_TYPE): New macros.
            (TYPE_IS_OPAQUE): Use HAVE_CPLUS_STRUCT to check if type has
            cplus-specific data.
            * gdbtypes.c (allocate_cplus_struct_type): Minor stylistic rewrite.
            Set new component TYPE_SPECIFIC_FIELD (type).
            (gnat_aux_default): New constant.
            (allocate_gnat_aux_type): New function.
            (init_type): Add initialization the type-specific stuff for
            TYPE_CODE_FLT and TYPE_CODE_FUNC types.
            (print_gnat_stuff): New function.
            (recursive_dump_type): Use HAVE_CPLUS_STRUCT to check for cplus-
            specific data.  Adjust code that prints the contents of the
            type-specific union using the TYPE_SPECIFIC_FIELD value.
            * dwarf2read.c (dwarf2_attach_fields_to_type): Do not allocate
            the type cplus stuff for Ada types.
            (dwarf2_add_member_fn, dwarf2_attach_fn_fields_to_type):
            Error out if these routines are called with an Ada type.
            (read_structure_type, read_array_type, read_subrange_type):
            Add call to set_descriptive_type.
            (set_die_type): Initialize the gnat-specific data if necessary.
            (need_gnat_info, die_descriptive_type, set_descriptive_type):
            New functions.
            * ada-lang.c (decode_constrained_packed_array_type): Use
            decode_constrained_packed_array_type instead of doing a standard
            lookup to locate a parallel type.
            (find_parallel_type_by_descriptive_type): New function.
            (ada_find_parallel_type_with_name): New function.
            (ada_find_parallel_type): Reimplement using
            ada_find_parallel_type_with_name.
            * ada-valprint.c (print_field_values): Use HAVE_CPLUS_STRUCT
            to check if type has a cplus stuff.
            * linespec.c (total_number_of_methods): Likewise.
            * mdebugread.c (new_type): Likewise.
    
    gdb/testsuite/ChangeLog:
    
            * gdb.base/maint.exp: Adjust the expected output for the
            "maint print type" test. Use gdb_test_multiple instead of
            gdb_sent/gdb_expect.

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index b101d58..317c8d3 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -157,6 +157,9 @@ static struct type *ada_lookup_struct_elt_type (struct type *, char *,
 
 static struct value *evaluate_subexp_type (struct expression *, int *);
 
+static struct type *ada_find_parallel_type_with_name (struct type *,
+                                                      const char *);
+
 static int is_dynamic_field (struct type *, int);
 
 static struct type *to_fixed_variant_branch_type (struct type *,
@@ -1874,13 +1877,13 @@ decode_constrained_packed_array_type (struct type *type)
   memcpy (name, raw_name, tail - raw_name);
   name[tail - raw_name] = '\000';
 
-  sym = standard_lookup (name, get_selected_block (0), VAR_DOMAIN);
-  if (sym == NULL || SYMBOL_TYPE (sym) == NULL)
+  shadow_type = ada_find_parallel_type_with_name (type, name);
+
+  if (shadow_type == NULL)
     {
       lim_warning (_("could not find bounds information on packed array"));
       return NULL;
     }
-  shadow_type = SYMBOL_TYPE (sym);
   CHECK_TYPEDEF (shadow_type);
 
   if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
@@ -6666,31 +6669,90 @@ ada_type_name (struct type *type)
     return TYPE_TAG_NAME (type);
 }
 
-/* Find a parallel type to TYPE whose name is formed by appending
+/* Search the list of "descriptive" types associated to TYPE for a type
+   whose name is NAME.  */
+
+static struct type *
+find_parallel_type_by_descriptive_type (struct type *type, const char *name)
+{
+  struct type *result;
+
+  /* If there no descriptive-type info, then there is no parallel type
+     to be found.  */
+  if (!HAVE_GNAT_AUX_INFO (type))
+    return NULL;
+
+  result = TYPE_DESCRIPTIVE_TYPE (type);
+  while (result != NULL)
+    {
+      char *result_name = ada_type_name (result);
+
+      if (result_name == NULL)
+        {
+          warning (_("unexpected null name on descriptive type"));
+          return NULL;
+        }
+
+      /* If the names match, stop.  */
+      if (strcmp (result_name, name) == 0)
+	break;
+
+      /* Otherwise, look at the next item on the list, if any.  */
+      if (HAVE_GNAT_AUX_INFO (result))
+	result = TYPE_DESCRIPTIVE_TYPE (result);
+      else
+	result = NULL;
+    }
+
+  /* If we didn't find a match, see whether this is a packed array.  With
+     older compilers, the descriptive type information is either absent or
+     irrelevant when it comes to packed arrays so the above lookup fails.
+     Fall back to using a parallel lookup by name in this case.  */
+  if (result == NULL && ada_is_packed_array_type (type))
+    return ada_find_any_type (name);
+
+  return result;
+}
+
+/* Find a parallel type to TYPE with the specified NAME, using the
+   descriptive type taken from the debugging information, if available,
+   and otherwise using the (slower) name-based method.  */
+
+static struct type *
+ada_find_parallel_type_with_name (struct type *type, const char *name)
+{
+  struct type *result = NULL;
+
+  if (HAVE_GNAT_AUX_INFO (type))
+    result = find_parallel_type_by_descriptive_type (type, name);
+  else
+    result = ada_find_any_type (name);
+
+  return result;
+}
+
+/* Same as above, but specify the name of the parallel type by appending
    SUFFIX to the name of TYPE.  */
 
 struct type *
 ada_find_parallel_type (struct type *type, const char *suffix)
 {
-  static char *name;
-  static size_t name_len = 0;
+  char *name, *typename = ada_type_name (type);
   int len;
-  char *typename = ada_type_name (type);
 
   if (typename == NULL)
     return NULL;
 
   len = strlen (typename);
 
-  GROW_VECT (name, name_len, len + strlen (suffix) + 1);
+  name = (char *) alloca (len + strlen (suffix) + 1);
 
   strcpy (name, typename);
   strcpy (name + len, suffix);
 
-  return ada_find_any_type (name);
+  return ada_find_parallel_type_with_name (type, name);
 }
 
-
 /* If TYPE is a variable-size record type, return the corresponding template
    type describing its fields.  Otherwise, return NULL.  */
 
diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c
index 4f644b8..1c8bfc6 100644
--- a/gdb/ada-valprint.c
+++ b/gdb/ada-valprint.c
@@ -1077,8 +1077,7 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
 
 	  /* Bitfields require special handling, especially due to byte
 	     order problems.  */
-	  if (TYPE_CPLUS_SPECIFIC (type) != NULL
-	      && TYPE_FIELD_IGNORE (type, i))
+	  if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
 	    {
 	      fputs_filtered (_("<optimized out or zero length>"), stream);
 	    }
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 7623035..9a493de 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -926,6 +926,13 @@ static void dwarf2_const_value_data (struct attribute *attr,
 
 static struct type *die_type (struct die_info *, struct dwarf2_cu *);
 
+static int need_gnat_info (struct dwarf2_cu *);
+
+static struct type *die_descriptive_type (struct die_info *, struct dwarf2_cu *);
+
+static void set_descriptive_type (struct type *, struct die_info *,
+				  struct dwarf2_cu *);
+
 static struct type *die_containing_type (struct die_info *,
 					 struct dwarf2_cu *);
 
@@ -4564,7 +4571,7 @@ dwarf2_attach_fields_to_type (struct field_info *fip, struct type *type,
     TYPE_ALLOC (type, sizeof (struct field) * nfields);
   memset (TYPE_FIELDS (type), 0, sizeof (struct field) * nfields);
 
-  if (fip->non_public_fields)
+  if (fip->non_public_fields && cu->language != language_ada)
     {
       ALLOCATE_CPLUS_STRUCT_TYPE (type);
 
@@ -4583,7 +4590,7 @@ dwarf2_attach_fields_to_type (struct field_info *fip, struct type *type,
 
   /* If the type has baseclasses, allocate and clear a bit vector for
      TYPE_FIELD_VIRTUAL_BITS.  */
-  if (fip->nbaseclasses)
+  if (fip->nbaseclasses && cu->language != language_ada)
     {
       int num_bytes = B_BYTES (fip->nbaseclasses);
       unsigned char *pointer;
@@ -4617,11 +4624,13 @@ dwarf2_attach_fields_to_type (struct field_info *fip, struct type *type,
       switch (fieldp->accessibility)
 	{
 	case DW_ACCESS_private:
-	  SET_TYPE_FIELD_PRIVATE (type, nfields);
+	  if (cu->language != language_ada)
+	    SET_TYPE_FIELD_PRIVATE (type, nfields);
 	  break;
 
 	case DW_ACCESS_protected:
-	  SET_TYPE_FIELD_PROTECTED (type, nfields);
+	  if (cu->language != language_ada)
+	    SET_TYPE_FIELD_PROTECTED (type, nfields);
 	  break;
 
 	case DW_ACCESS_public:
@@ -4641,6 +4650,8 @@ dwarf2_attach_fields_to_type (struct field_info *fip, struct type *type,
 	    {
 	    case DW_VIRTUALITY_virtual:
 	    case DW_VIRTUALITY_pure_virtual:
+	      if (cu->language == language_ada)
+		error ("unexpected virtuality in component of Ada type");
 	      SET_TYPE_FIELD_VIRTUAL (type, nfields);
 	      break;
 	    }
@@ -4664,6 +4675,9 @@ dwarf2_add_member_fn (struct field_info *fip, struct die_info *die,
   struct nextfnfield *new_fnfield;
   struct type *this_type;
 
+  if (cu->language == language_ada)
+    error ("unexpected member function in Ada type");
+
   /* Get name of member function.  */
   fieldname = dwarf2_name (die, cu);
   if (fieldname == NULL)
@@ -4837,6 +4851,9 @@ dwarf2_attach_fn_fields_to_type (struct field_info *fip, struct type *type,
   int total_length = 0;
   int i;
 
+  if (cu->language == language_ada)
+    error ("unexpected member functions in Ada type");
+
   ALLOCATE_CPLUS_STRUCT_TYPE (type);
   TYPE_FN_FIELDLISTS (type) = (struct fn_fieldlist *)
     TYPE_ALLOC (type, sizeof (struct fn_fieldlist) * fip->nfnfields);
@@ -5038,6 +5055,8 @@ read_structure_type (struct die_info *die, struct dwarf2_cu *cu)
   if (die_is_declaration (die, cu))
     TYPE_STUB (type) = 1;
 
+  set_descriptive_type (type, die, cu);
+
   /* We need to add the type field to the die immediately so we don't
      infinitely recurse when dealing with pointers to the structure
      type within the structure itself. */
@@ -5451,6 +5470,8 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu)
   if (name)
     TYPE_NAME (type) = name;
   
+  set_descriptive_type (type, die, cu);
+
   do_cleanups (back_to);
 
   /* Install the type in the die. */
@@ -6113,6 +6134,8 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
   if (attr)
     TYPE_LENGTH (range_type) = DW_UNSND (attr);
 
+  set_descriptive_type (range_type, die, cu);
+
   return set_die_type (die, range_type, cu);
 }
   
@@ -8768,6 +8791,61 @@ die_type (struct die_info *die, struct dwarf2_cu *cu)
   return type;
 }
 
+/* True iff CU's producer generates GNAT Ada auxiliary information
+   that allows to find parallel types through that information instead
+   of having to do expensive parallel lookups by type name.  */
+
+static int
+need_gnat_info (struct dwarf2_cu *cu)
+{
+  /* Assume that the Ada compiler was GNAT, which always produces
+     the auxiliary information.  */
+  return (cu->language == language_ada);
+}
+
+
+/* Return the auxiliary type of the die in question using its
+   DW_AT_GNAT_descriptive_type attribute.  Returns NULL if the
+   attribute is not present.  */
+
+static struct type *
+die_descriptive_type (struct die_info *die, struct dwarf2_cu *cu)
+{
+  struct type *type;
+  struct attribute *type_attr;
+  struct die_info *type_die;
+
+  type_attr = dwarf2_attr (die, DW_AT_GNAT_descriptive_type, cu);
+  if (!type_attr)
+    return NULL;
+
+  type_die = follow_die_ref (die, type_attr, &cu);
+  type = tag_type_to_type (type_die, cu);
+  if (!type)
+    {
+      dump_die_for_error (type_die);
+      error (_("Dwarf Error: Problem turning type die at offset into gdb type [in module %s]"),
+		      cu->objfile->name);
+    }
+  return type;
+}
+
+/* If DIE has a descriptive_type attribute, then set the TYPE's
+   descriptive type accordingly.  */
+
+static void
+set_descriptive_type (struct type *type, struct die_info *die,
+		      struct dwarf2_cu *cu)
+{
+  struct type *descriptive_type = die_descriptive_type (die, cu);
+
+  if (descriptive_type)
+    {
+      ALLOCATE_GNAT_AUX_TYPE (type);
+      TYPE_DESCRIPTIVE_TYPE (type) = descriptive_type;
+    }
+}
+
 /* Return the containing type of the die in question using its
    DW_AT_containing_type attribute.  */
 
@@ -11724,6 +11802,19 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
 {
   struct dwarf2_offset_and_type **slot, ofs;
 
+  /* For Ada types, make sure that the gnat-specific data is always
+     initialized (if not already set).  There are a few types where
+     we should not be doing so, because the type-specific area is
+     already used to hold some other piece of info (eg: TYPE_CODE_FLT
+     where the type-specific area is used to store the floatformat).
+     But this is not a problem, because the gnat-specific information
+     is actually not needed for these types.  */
+  if (need_gnat_info (cu)
+      && TYPE_CODE (type) != TYPE_CODE_FUNC
+      && TYPE_CODE (type) != TYPE_CODE_FLT
+      && !HAVE_GNAT_AUX_INFO (type))
+    INIT_GNAT_SPECIFIC (type);
+
   if (cu->type_hash == NULL)
     {
       gdb_assert (cu->per_cu != NULL);
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 255f04a..6a01aeb 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1717,14 +1717,32 @@ const struct cplus_struct_type cplus_struct_default;
 void
 allocate_cplus_struct_type (struct type *type)
 {
-  if (!HAVE_CPLUS_STRUCT (type))
-    {
-      TYPE_CPLUS_SPECIFIC (type) = (struct cplus_struct_type *)
-	TYPE_ALLOC (type, sizeof (struct cplus_struct_type));
-      *(TYPE_CPLUS_SPECIFIC (type)) = cplus_struct_default;
-    }
+  if (HAVE_CPLUS_STRUCT (type))
+    /* Structure was already allocated.  Nothing more to do.  */
+    return;
+
+  TYPE_SPECIFIC_FIELD (type) = TYPE_SPECIFIC_CPLUS_STUFF;
+  TYPE_RAW_CPLUS_SPECIFIC (type) = (struct cplus_struct_type *)
+    TYPE_ALLOC (type, sizeof (struct cplus_struct_type));
+  *(TYPE_RAW_CPLUS_SPECIFIC (type)) = cplus_struct_default;
 }
 
+const struct gnat_aux_type gnat_aux_default =
+  { NULL };
+
+/* Set the TYPE's type-specific kind to TYPE_SPECIFIC_GNAT_STUFF,
+   and allocate the associated gnat-specific data.  The gnat-specific
+   data is also initialized to gnat_aux_default.  */
+void
+allocate_gnat_aux_type (struct type *type)
+{
+  TYPE_SPECIFIC_FIELD (type) = TYPE_SPECIFIC_GNAT_STUFF;
+  TYPE_GNAT_SPECIFIC (type) = (struct gnat_aux_type *)
+    TYPE_ALLOC (type, sizeof (struct gnat_aux_type));
+  *(TYPE_GNAT_SPECIFIC (type)) = gnat_aux_default;
+}
+
+
 /* Helper function to initialize the standard scalar types.
 
    If NAME is non-NULL, then we make a copy of the string pointed
@@ -1777,10 +1795,19 @@ init_type (enum type_code code, int length, int flags,
   if (name && strcmp (name, "char") == 0)
     TYPE_NOSIGN (type) = 1;
 
-  if (code == TYPE_CODE_STRUCT || code == TYPE_CODE_UNION
-      || code == TYPE_CODE_NAMESPACE)
+  switch (code)
     {
-      INIT_CPLUS_SPECIFIC (type);
+      case TYPE_CODE_STRUCT:
+      case TYPE_CODE_UNION:
+      case TYPE_CODE_NAMESPACE:
+        INIT_CPLUS_SPECIFIC (type);
+        break;
+      case TYPE_CODE_FLT:
+        TYPE_SPECIFIC_FIELD (type) = TYPE_SPECIFIC_FLOATFORMAT;
+        break;
+      case TYPE_CODE_FUNC:
+        TYPE_SPECIFIC_FIELD (type) = TYPE_SPECIFIC_CALLING_CONVENTION;
+        break;
     }
   return type;
 }
@@ -2495,6 +2522,17 @@ print_cplus_stuff (struct type *type, int spaces)
     }
 }
 
+/* Print the contents of the TYPE's type_specific union, assuming that
+   its type-specific kind is TYPE_SPECIFIC_GNAT_STUFF.  */
+
+static void
+print_gnat_stuff (struct type *type, int spaces)
+{
+  struct type *descriptive_type = TYPE_DESCRIPTIVE_TYPE (type);
+
+  recursive_dump_type (descriptive_type, spaces + 2);
+}
+
 static struct obstack dont_print_type_obstack;
 
 void
@@ -2506,7 +2544,7 @@ recursive_dump_type (struct type *type, int spaces)
     obstack_begin (&dont_print_type_obstack, 0);
 
   if (TYPE_NFIELDS (type) > 0
-      || (TYPE_CPLUS_SPECIFIC (type) && TYPE_NFN_FIELDS (type) > 0))
+      || (HAVE_CPLUS_STRUCT (type) && TYPE_NFN_FIELDS (type) > 0))
     {
       struct type **first_dont_print
 	= (struct type **) obstack_base (&dont_print_type_obstack);
@@ -2775,55 +2813,55 @@ recursive_dump_type (struct type *type, int spaces)
     }
   printfi_filtered (spaces, "vptr_fieldno %d\n", 
 		    TYPE_VPTR_FIELDNO (type));
-  switch (TYPE_CODE (type))
-    {
-    case TYPE_CODE_STRUCT:
-      printfi_filtered (spaces, "cplus_stuff ");
-      gdb_print_host_address (TYPE_CPLUS_SPECIFIC (type), 
-			      gdb_stdout);
-      puts_filtered ("\n");
-      print_cplus_stuff (type, spaces);
-      break;
 
-    case TYPE_CODE_FLT:
-      printfi_filtered (spaces, "floatformat ");
-      if (TYPE_FLOATFORMAT (type) == NULL)
-	puts_filtered ("(null)");
-      else
-	{
-	  puts_filtered ("{ ");
-	  if (TYPE_FLOATFORMAT (type)[0] == NULL
-	      || TYPE_FLOATFORMAT (type)[0]->name == NULL)
-	    puts_filtered ("(null)");
-	  else
-	    puts_filtered (TYPE_FLOATFORMAT (type)[0]->name);
-
-	  puts_filtered (", ");
-	  if (TYPE_FLOATFORMAT (type)[1] == NULL
-	      || TYPE_FLOATFORMAT (type)[1]->name == NULL)
-	    puts_filtered ("(null)");
-	  else
-	    puts_filtered (TYPE_FLOATFORMAT (type)[1]->name);
+  switch (TYPE_SPECIFIC_FIELD (type))
+    {
+      case TYPE_SPECIFIC_CPLUS_STUFF:
+	printfi_filtered (spaces, "cplus_stuff ");
+	gdb_print_host_address (TYPE_CPLUS_SPECIFIC (type), 
+				gdb_stdout);
+	puts_filtered ("\n");
+	print_cplus_stuff (type, spaces);
+	break;
 
-	  puts_filtered (" }");
-	}
-      puts_filtered ("\n");
-      break;
+      case TYPE_SPECIFIC_GNAT_STUFF:
+	printfi_filtered (spaces, "gnat_stuff ");
+	gdb_print_host_address (TYPE_GNAT_SPECIFIC (type), gdb_stdout);
+	puts_filtered ("\n");
+	print_gnat_stuff (type, spaces);
+	break;
 
-    default:
-      /* We have to pick one of the union types to be able print and
-         test the value.  Pick cplus_struct_type, even though we know
-         it isn't any particular one.  */
-      printfi_filtered (spaces, "type_specific ");
-      gdb_print_host_address (TYPE_CPLUS_SPECIFIC (type), gdb_stdout);
-      if (TYPE_CPLUS_SPECIFIC (type) != NULL)
-	{
-	  printf_filtered (_(" (unknown data form)"));
-	}
-      printf_filtered ("\n");
-      break;
+      case TYPE_SPECIFIC_FLOATFORMAT:
+	printfi_filtered (spaces, "floatformat ");
+	if (TYPE_FLOATFORMAT (type) == NULL)
+	  puts_filtered ("(null)");
+	else
+	  {
+	    puts_filtered ("{ ");
+	    if (TYPE_FLOATFORMAT (type)[0] == NULL
+		|| TYPE_FLOATFORMAT (type)[0]->name == NULL)
+	      puts_filtered ("(null)");
+	    else
+	      puts_filtered (TYPE_FLOATFORMAT (type)[0]->name);
+
+	    puts_filtered (", ");
+	    if (TYPE_FLOATFORMAT (type)[1] == NULL
+		|| TYPE_FLOATFORMAT (type)[1]->name == NULL)
+	      puts_filtered ("(null)");
+	    else
+	      puts_filtered (TYPE_FLOATFORMAT (type)[1]->name);
+
+	    puts_filtered (" }");
+	  }
+	puts_filtered ("\n");
+	break;
 
+      case TYPE_SPECIFIC_CALLING_CONVENTION:
+	printfi_filtered (spaces, "calling_convention %d\n",
+                          TYPE_CALLING_CONVENTION (type));
+	break;
     }
+
   if (spaces == 0)
     obstack_free (&dont_print_type_obstack, NULL);
 }
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 7ef0b1d..f329b1e 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -340,6 +340,26 @@ enum field_loc_kind
     FIELD_LOC_KIND_DWARF_BLOCK	/* dwarf_block */
   };
 
+/* A discriminant to determine which field in the main_type.type_specific
+   union is being used, if any.
+
+   For types such as TYPE_CODE_FLT or TYPE_CODE_FUNC, the use of this
+   discriminant is really redundant, as we know from the type code
+   which field is going to be used.  As such, it would be possible to
+   reduce the size of this enum in order to save a bit or two for
+   other fields of struct main_type.  But, since we still have extra
+   room , and for the sake of clarity and consistency, we treat all fields
+   of the union the same way.  */
+
+enum type_specific_kind
+{
+  TYPE_SPECIFIC_NONE,
+  TYPE_SPECIFIC_CPLUS_STUFF,
+  TYPE_SPECIFIC_GNAT_STUFF,
+  TYPE_SPECIFIC_FLOATFORMAT,
+  TYPE_SPECIFIC_CALLING_CONVENTION
+};
+
 /* This structure is space-critical.
    Its layout has been tweaked to reduce the space used.  */
 
@@ -367,6 +387,10 @@ struct main_type
   unsigned int flag_fixed_instance : 1;
   unsigned int flag_objfile_owned : 1;
 
+  /* A discriminant telling us which field of the type_specific union
+     is being used for this type, if any.  */
+  ENUM_BITFIELD(type_specific_kind) type_specific_field : 3;
+
   /* Number of fields described for this type.  This field appears at
      this location because it packs nicely here.  */
 
@@ -554,6 +578,10 @@ struct main_type
 
     struct cplus_struct_type *cplus_stuff;
 
+    /* GNAT_STUFF is for types for which the GNAT Ada compiler
+       provides additional information.  */
+    struct gnat_aux_type *gnat_stuff;
+
     /* FLOATFORMAT is for TYPE_CODE_FLT.  It is a pointer to two
        floatformat objects that describe the floating-point value
        that resides within the type.  The first is for big endian
@@ -825,6 +853,15 @@ struct badness_vector
     int *rank;
   };
 
+/* GNAT Ada-specific information for various Ada types.  */
+struct gnat_aux_type
+  {
+    /* Parallel type used to encode information about dynamic types
+       used in Ada (such as variant records, variable-size array,
+       etc).  */
+    struct type* descriptive_type;
+  };
+
 /* The default value of TYPE_CPLUS_SPECIFIC(T) points to the
    this shared static structure. */
 
@@ -833,10 +870,27 @@ extern const struct cplus_struct_type cplus_struct_default;
 extern void allocate_cplus_struct_type (struct type *);
 
 #define INIT_CPLUS_SPECIFIC(type) \
-  (TYPE_CPLUS_SPECIFIC(type)=(struct cplus_struct_type*)&cplus_struct_default)
+  (TYPE_SPECIFIC_FIELD (type) = TYPE_SPECIFIC_CPLUS_STUFF, \
+   TYPE_RAW_CPLUS_SPECIFIC (type) = (struct cplus_struct_type*) &cplus_struct_default)
+
 #define ALLOCATE_CPLUS_STRUCT_TYPE(type) allocate_cplus_struct_type (type)
+
 #define HAVE_CPLUS_STRUCT(type) \
-  (TYPE_CPLUS_SPECIFIC(type) != &cplus_struct_default)
+  (TYPE_SPECIFIC_FIELD (type) == TYPE_SPECIFIC_CPLUS_STUFF \
+   && TYPE_RAW_CPLUS_SPECIFIC (type) !=  &cplus_struct_default)
+
+extern const struct gnat_aux_type gnat_aux_default;
+
+extern void allocate_gnat_aux_type (struct type *);
+
+#define INIT_GNAT_SPECIFIC(type) \
+  (TYPE_SPECIFIC_FIELD (type) = TYPE_SPECIFIC_GNAT_STUFF, \
+   TYPE_GNAT_SPECIFIC (type) = (struct gnat_aux_type *) &gnat_aux_default)
+#define ALLOCATE_GNAT_AUX_TYPE(type) allocate_gnat_aux_type (type)
+/* A macro that returns non-zero if the type-specific data should be
+   read as "gnat-stuff".  */
+#define HAVE_GNAT_AUX_INFO(type) \
+  (TYPE_SPECIFIC_FIELD (type) == TYPE_SPECIFIC_GNAT_STUFF)
 
 #define TYPE_INSTANCE_FLAGS(thistype) (thistype)->instance_flags
 #define TYPE_MAIN_TYPE(thistype) (thistype)->main_type
@@ -890,9 +944,22 @@ extern void allocate_cplus_struct_type (struct type *);
 #define TYPE_NFN_FIELDS_TOTAL(thistype) TYPE_CPLUS_SPECIFIC(thistype)->nfn_fields_total
 #define TYPE_NTEMPLATE_ARGS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->ntemplate_args
 #define TYPE_DECLARED_TYPE(thistype) TYPE_CPLUS_SPECIFIC(thistype)->declared_type
+#define TYPE_SPECIFIC_FIELD(thistype) \
+  TYPE_MAIN_TYPE(thistype)->type_specific_field
 #define	TYPE_TYPE_SPECIFIC(thistype) TYPE_MAIN_TYPE(thistype)->type_specific
-#define TYPE_CPLUS_SPECIFIC(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.cplus_stuff
+/* We need this tap-dance with the TYPE_RAW_SPECIFIC because of the case
+   where we're trying to print an Ada array using the C language.
+   In that case, there is no "cplus_stuff", but the C language assumes
+   that there is.  What we do, in that case, is pretend that there is
+   an implicit one which is the default cplus stuff.  */
+#define TYPE_CPLUS_SPECIFIC(thistype) \
+   (!HAVE_CPLUS_STRUCT(thistype) \
+    ? (struct cplus_struct_type*)&cplus_struct_default \
+    : TYPE_RAW_CPLUS_SPECIFIC(thistype))
+#define TYPE_RAW_CPLUS_SPECIFIC(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.cplus_stuff
 #define TYPE_FLOATFORMAT(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.floatformat
+#define TYPE_GNAT_SPECIFIC(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.gnat_stuff
+#define TYPE_DESCRIPTIVE_TYPE(thistype) TYPE_GNAT_SPECIFIC(thistype)->descriptive_type
 #define TYPE_CALLING_CONVENTION(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.calling_convention
 #define TYPE_BASECLASS(thistype,index) TYPE_FIELD_TYPE(thistype, index)
 #define TYPE_N_BASECLASSES(thistype) TYPE_CPLUS_SPECIFIC(thistype)->n_baseclasses
@@ -1004,7 +1071,7 @@ extern void allocate_cplus_struct_type (struct type *);
 #define TYPE_IS_OPAQUE(thistype) (((TYPE_CODE (thistype) == TYPE_CODE_STRUCT) ||        \
                                    (TYPE_CODE (thistype) == TYPE_CODE_UNION))        && \
                                   (TYPE_NFIELDS (thistype) == 0)                     && \
-                                  (TYPE_CPLUS_SPECIFIC (thistype) && (TYPE_NFN_FIELDS (thistype) == 0)) && \
+                                  (HAVE_CPLUS_STRUCT (thistype) && (TYPE_NFN_FIELDS (thistype) == 0)) && \
                                   (TYPE_STUB (thistype) || !TYPE_STUB_SUPPORTED (thistype)))
 
 struct builtin_type
diff --git a/gdb/linespec.c b/gdb/linespec.c
index 138f0d8..74902b6 100644
--- a/gdb/linespec.c
+++ b/gdb/linespec.c
@@ -186,7 +186,7 @@ total_number_of_methods (struct type *type)
   int count;
 
   CHECK_TYPEDEF (type);
-  if (TYPE_CPLUS_SPECIFIC (type) == NULL)
+  if (! HAVE_CPLUS_STRUCT (type))
     return 0;
   count = TYPE_NFN_FIELDS_TOTAL (type);
 
diff --git a/gdb/mdebugread.c b/gdb/mdebugread.c
index fc28637..28d52a4 100644
--- a/gdb/mdebugread.c
+++ b/gdb/mdebugread.c
@@ -4800,7 +4800,7 @@ new_type (char *name)
 
   t = alloc_type (current_objfile);
   TYPE_NAME (t) = name;
-  TYPE_CPLUS_SPECIFIC (t) = (struct cplus_struct_type *) &cplus_struct_default;
+  INIT_CPLUS_SPECIFIC (t);
   return t;
 }
 \f
diff --git a/gdb/testsuite/gdb.base/maint.exp b/gdb/testsuite/gdb.base/maint.exp
index 45d2a73..6cff013 100644
--- a/gdb/testsuite/gdb.base/maint.exp
+++ b/gdb/testsuite/gdb.base/maint.exp
@@ -397,13 +397,12 @@ gdb_expect  {
         timeout         { fail "(timeout) maint print symbols" }
         }
 
-send_gdb "maint print type argc\n"
-gdb_expect  {
-        -re "type node $hex\r\nname .int. \\($hex\\)\r\ntagname .<NULL>. \\($hex\\)\r\ncode $hex \\(TYPE_CODE_INT\\)\r\nlength \[24\]\r\nobjfile $hex\r\ntarget_type $hex\r\npointer_type $hex\r\nreference_type $hex\r\ntype_chain $hex\r\ninstance_flags $hex\r\nflags\r\nnfields 0 $hex\r\nvptr_basetype $hex\r\nvptr_fieldno -1\r\ntype_specific $hex\r\n$gdb_prompt $"\
-                        { pass "maint print type" }
-        -re ".*$gdb_prompt $"       { fail "maint print type" }
-        timeout         { fail "(timeout) maint print type" }
-        }
+set msg "maint print type"
+gdb_test_multiple "maint print type argc" $msg {
+    -re "type node $hex\r\nname .int. \\($hex\\)\r\ntagname .<NULL>. \\($hex\\)\r\ncode $hex \\(TYPE_CODE_INT\\)\r\nlength \[24\]\r\nobjfile $hex\r\ntarget_type $hex\r\npointer_type $hex\r\nreference_type $hex\r\ntype_chain $hex\r\ninstance_flags $hex\r\nflags\r\nnfields 0 $hex\r\nvptr_basetype $hex\r\nvptr_fieldno -1\r\n$gdb_prompt $" {
+        pass $msg
+    }
+}
 
 if [istarget "hppa*-*-11*"] {
     setup_xfail hppa*-*-*11* CLLbs14860

Re: [RFA/DWARF] Add DW_AT_GNAT_descriptive_type support

[Tom Tromey]

>>>>> "Joel" == Joel Brobecker <brobecker@adacore.com> writes:

Joel> Tested on x86_64-linux. No regression, just one expected change.
Joel> I think this addresses both of Tom's comments, but I'm going to wait
Joel> a little for confirmation and/or last second objections.

FWIW, I skimmed through it and nothing jumped out at me.

Tom

Re: [RFA/DWARF] Add DW_AT_GNAT_descriptive_type support

[Joel Brobecker]

> FWIW, I skimmed through it and nothing jumped out at me.

Thanks, Tom. Patch now checked in. I'll ask Eric to work on the GCC
side.  For the record, I switched the implementation of need_gnat_info
to always returning zero:

  /* FIXME: brobecker/2010-10-12: As of now, only the AdaCore version
     of GNAT produces this auxiliary information, without any indication
     that it is produced.  Part of enhancing the FSF version of GNAT
     to produce that information will be to put in place an indicator
     that we can use in order to determine whether the descriptive type
     info is available or not.  One suggestion that has been made is
     to use a new attribute, attached to the CU die.  For now, assume
     that the descriptive type info is not available.  */
  return 0;

This will be adjusted later on, when support is added to GCC.

-- 
Joel

Re: [RFA/DWARF] Add DW_AT_GNAT_descriptive_type support

[Jan Kratochvil]

On Thu, 24 Dec 2009 23:39:43 -1000, Jan Kratochvil wrote:
> There is DW_TAG_array_type(DW_TAG_subrange_type->DW_AT_type) for this purpose
> IMHO.  But yes, you have said it is possible to do it the DWARF way.
> 
> 
> On Fri, 25 Dec 2009 05:06:46 +0100, Joel Brobecker wrote:
> > But this effort seems to be always stalled in favor of other, more urgent
> > ones.  It's an effort that is actually dear to me, since I very much dislike
> > this encoding.
> 
> OK, np, fine with me, fully understood.  I just missed some note about the
> reasons for this patch.


On Mon, 11 Jan 2010 19:52:58 -1000, Joel Brobecker wrote:
> This will be adjusted later on, when support is added to GCC.


The regression today and some recent talk suggested me to revive this thread.

People developing non-Ada GDB code sometimes accidentally cause Ada
regressions but the current Ada debug info (at least as encoded in DWARF) is
unreadable for me, despite I tried.

Is there some Ada-specific `readelf -wi'-like tool to be able to read it?

And why not to implement whole Ada properly in DWARF, with few extensions
proposed at <dwarf-discuss@lists.dwarfstd.org> when/if needed?  As AdaCore
supplies both the compiler and the debugger I see no need to be bound by STABS
you noted before.

As Ada regressions are AFAIK not acceptable for FSF GDB check-ins there should
be a way to make them troubleshootable by non-Ada developers.


Thanks,
Jan

Re: [RFA/DWARF] Add DW_AT_GNAT_descriptive_type support

[Joel Brobecker]

> People developing non-Ada GDB code sometimes accidentally cause Ada
> regressions but the current Ada debug info (at least as encoded in DWARF) is
> unreadable for me, despite I tried.
> 
> Is there some Ada-specific `readelf -wi'-like tool to be able to read it?

Unfortunately not. In order to understand the debugging info, you need
to read the GNAT encoding spec in exp_dbug.ads (in the compiler
sources).

> And why not to implement whole Ada properly in DWARF, with few extensions
> proposed at <dwarf-discuss@lists.dwarfstd.org> when/if needed?  As AdaCore
> supplies both the compiler and the debugger I see no need to be bound by STABS
> you noted before.

We simply do not have the resources, and we don't project to have these
resources any time soon. Also, we are still stuck with stabs for a while,
as we haven't been able to transition to DWARF on some of the platforms
that AdaCore supports (Eg: AIX, Tru64, some versions of LynxOS, HP/UX). 
We've identified some encodings that should be easy to express in pure
DWARF, and these changes are in the queue, but the rest won't be done
any time soon, I'm afraid.

> As Ada regressions are AFAIK not acceptable for FSF GDB check-ins
> there should be a way to make them troubleshootable by non-Ada
> developers.

I only expect the contributors to do their best: If they notice
some regressions in gdb.ada with their patch, then try seeing if
it's an obvious problem, but otherwise just ask either Paul or myself.
I'm completely overworked these days, but I will always make room
to help out. I understand that the Ada part can be obscure, so
I don't expect more than that. And if someone introduces a regression,
then oh well, I'll notice it eventually, and then go on to fix it.

-- 
Joel