build as needed
[platform/upstream/binutils.git] / gdb / ada-valprint.c
index bef5ff9..6f68fae 100644 (file)
@@ -19,7 +19,6 @@
 
 #include "defs.h"
 #include <ctype.h>
-#include <string.h>
 #include "symtab.h"
 #include "gdbtypes.h"
 #include "expression.h"
 #include "ada-lang.h"
 #include "c-lang.h"
 #include "infcall.h"
-#include "exceptions.h"
 #include "objfiles.h"
 
-static void print_record (struct type *, const gdb_byte *, int,
-                         struct ui_file *,
-                         int,
-                         const struct value *,
-                         const struct value_print_options *);
-
 static int print_field_values (struct type *, const gdb_byte *,
                               int,
                               struct ui_file *, int,
                               const struct value *,
                               const struct value_print_options *,
-                              int, struct type *, int);
-
-static void adjust_type_signedness (struct type *);
-
-static void ada_val_print_1 (struct type *, const gdb_byte *, int, CORE_ADDR,
-                            struct ui_file *, int,
-                            const struct value *,
-                            const struct value_print_options *);
+                              int, struct type *, int,
+                              const struct language_defn *);
 \f
 
 /* Make TYPE unsigned if its range of values includes no negatives.  */
@@ -91,7 +77,7 @@ print_optional_low_bound (struct ui_file *stream, struct type *type,
 
   index_type = TYPE_INDEX_TYPE (type);
 
-  if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
+  while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
     {
       /* We need to know what the base type is, in order to do the
          appropriate check below.  Otherwise, if this is a subrange
@@ -198,9 +184,9 @@ val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
                                               (i * bitsize) / HOST_CHAR_BIT,
                                               (i * bitsize) % HOST_CHAR_BIT,
                                               bitsize, elttype);
-         if (!value_available_contents_eq (v0, value_embedded_offset (v0),
-                                           v1, value_embedded_offset (v1),
-                                           eltlen))
+         if (!value_contents_eq (v0, value_embedded_offset (v0),
+                                 v1, value_embedded_offset (v1),
+                                 eltlen))
            break;
        }
 
@@ -302,32 +288,22 @@ char_at (const gdb_byte *string, int i, int type_len,
                                            type_len, byte_order);
 }
 
-/* Wrapper around memcpy to make it legal argument to ui_file_put.  */
-static void
-ui_memcpy (void *dest, const char *buffer, long len)
-{
-  memcpy (dest, buffer, (size_t) len);
-  ((char *) dest)[len] = '\0';
-}
-
 /* Print a floating-point value of type TYPE, pointed to in GDB by
    VALADDR, on STREAM.  Use Ada formatting conventions: there must be
    a decimal point, and at least one digit before and after the
-   point.  We use GNAT format for NaNs and infinities.  */
+   point.  We use the GNAT format for NaNs and infinities.  */
+
 static void
 ada_print_floating (const gdb_byte *valaddr, struct type *type,
                    struct ui_file *stream)
 {
-  char buffer[64];
   char *s, *result;
   struct ui_file *tmp_stream = mem_fileopen ();
   struct cleanup *cleanups = make_cleanup_ui_file_delete (tmp_stream);
 
   print_floating (valaddr, type, tmp_stream);
-  ui_file_put (tmp_stream, ui_memcpy, buffer);
-  do_cleanups (cleanups);
-
-  result = buffer;
+  result = ui_file_xstrdup (tmp_stream, NULL);
+  make_cleanup (xfree, result);
 
   /* Modify for Ada rules.  */
 
@@ -361,9 +337,11 @@ ada_print_floating (const gdb_byte *valaddr, struct type *type,
        fprintf_filtered (stream, "%s.0", result);
       else
        fprintf_filtered (stream, "%.*s.0%s", (int) (s-result), result, s);
-      return;
     }
-  fprintf_filtered (stream, "%s", result);
+  else
+    fprintf_filtered (stream, "%s", result);
+
+  do_cleanups (cleanups);
 }
 
 void
@@ -550,369 +528,6 @@ ada_printstr (struct ui_file *stream, struct type *type,
            options);
 }
 
-
-/* See val_print for a description of the various parameters of this
-   function; they are identical.  */
-
-void
-ada_val_print (struct type *type, const gdb_byte *valaddr,
-              int embedded_offset, CORE_ADDR address,
-              struct ui_file *stream, int recurse,
-              const struct value *val,
-              const struct value_print_options *options)
-{
-  volatile struct gdb_exception except;
-
-  /* XXX: this catches QUIT/ctrl-c as well.  Isn't that busted?  */
-  TRY_CATCH (except, RETURN_MASK_ALL)
-    {
-      ada_val_print_1 (type, valaddr, embedded_offset, address,
-                      stream, recurse, val, options);
-    }
-}
-
-/* Assuming TYPE is a simple array, print the value of this array located
-   at VALADDR + OFFSET.  See ada_val_print for a description of the various
-   parameters of this function; they are identical.  */
-
-static void
-ada_val_print_array (struct type *type, const gdb_byte *valaddr,
-                    int offset, CORE_ADDR address,
-                    struct ui_file *stream, int recurse,
-                    const struct value *val,
-                    const struct value_print_options *options)
-{
-  /* For an array of chars, print with string syntax.  */
-  if (ada_is_string_type (type)
-      && (options->format == 0 || options->format == 's'))
-    {
-      enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
-      struct type *elttype = TYPE_TARGET_TYPE (type);
-      unsigned int eltlen;
-      unsigned int len;
-
-      /* We know that ELTTYPE cannot possibly be null, because we found
-        that TYPE is a string-like type.  Similarly, the size of ELTTYPE
-        should also be non-null, since it's a character-like type.  */
-      gdb_assert (elttype != NULL);
-      gdb_assert (TYPE_LENGTH (elttype) != 0);
-
-      eltlen = TYPE_LENGTH (elttype);
-      len = TYPE_LENGTH (type) / eltlen;
-
-      if (options->prettyformat_arrays)
-        print_spaces_filtered (2 + 2 * recurse, stream);
-
-      /* If requested, look for the first null char and only print
-         elements up to it.  */
-      if (options->stop_print_at_null)
-        {
-          int temp_len;
-
-          /* Look for a NULL char.  */
-          for (temp_len = 0;
-               (temp_len < len
-                && temp_len < options->print_max
-                && char_at (valaddr + offset,
-                           temp_len, eltlen, byte_order) != 0);
-               temp_len += 1);
-          len = temp_len;
-        }
-
-      printstr (stream, elttype, valaddr + offset, len, 0, eltlen, options);
-    }
-  else
-    {
-      fprintf_filtered (stream, "(");
-      print_optional_low_bound (stream, type, options);
-      if (TYPE_FIELD_BITSIZE (type, 0) > 0)
-        val_print_packed_array_elements (type, valaddr, offset,
-                                        0, stream, recurse, val, options);
-      else
-        val_print_array_elements (type, valaddr, offset, address,
-                                 stream, recurse, val, options, 0);
-      fprintf_filtered (stream, ")");
-    }
-}
-
-/* See the comment on ada_val_print.  This function differs in that it
-   does not catch evaluation errors (leaving that to ada_val_print).  */
-
-static void
-ada_val_print_1 (struct type *type, const gdb_byte *valaddr,
-                int offset, CORE_ADDR address,
-                struct ui_file *stream, int recurse,
-                const struct value *original_value,
-                const struct value_print_options *options)
-{
-  int i;
-  struct type *elttype;
-  int offset_aligned;
-
-  type = ada_check_typedef (type);
-
-  if (ada_is_array_descriptor_type (type)
-      || (ada_is_constrained_packed_array_type (type)
-         && TYPE_CODE (type) != TYPE_CODE_PTR))
-    {
-      struct value *mark = value_mark ();
-      struct value *val;
-
-      val = value_from_contents_and_address (type, valaddr + offset, address);
-      /* If this is a reference, coerce it now.  This helps taking care
-        of the case where ADDRESS is meaningless because original_value
-        was not an lval.  */
-      val = coerce_ref (val);
-      if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
-       val = ada_coerce_to_simple_array_ptr (val);
-      else
-       val = ada_coerce_to_simple_array (val);
-      if (val == NULL)
-       {
-         gdb_assert (TYPE_CODE (type) == TYPE_CODE_TYPEDEF);
-         fprintf_filtered (stream, "0x0");
-       }
-      else
-       ada_val_print_1 (value_type (val),
-                        value_contents_for_printing (val),
-                        value_embedded_offset (val),
-                        value_address (val), stream, recurse,
-                        val, options);
-      value_free_to_mark (mark);
-      return;
-    }
-
-  offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
-  type = printable_val_type (type, valaddr + offset_aligned);
-
-  switch (TYPE_CODE (type))
-    {
-    default:
-      c_val_print (type, valaddr, offset, address, stream,
-                  recurse, original_value, options);
-      break;
-
-    case TYPE_CODE_PTR:
-      {
-       c_val_print (type, valaddr, offset, address,
-                    stream, recurse, original_value, options);
-
-       if (ada_is_tag_type (type))
-         {
-           struct value *val =
-             value_from_contents_and_address (type,
-                                              valaddr + offset_aligned,
-                                              address + offset_aligned);
-           const char *name = ada_tag_name (val);
-
-           if (name != NULL) 
-             fprintf_filtered (stream, " (%s)", name);
-         }
-       return;
-      }
-
-    case TYPE_CODE_INT:
-    case TYPE_CODE_RANGE:
-      if (ada_is_fixed_point_type (type))
-       {
-         LONGEST v = unpack_long (type, valaddr + offset_aligned);
-
-         fprintf_filtered (stream, TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g",
-                           (double) ada_fixed_to_float (type, v));
-         return;
-       }
-      else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
-       {
-         struct type *target_type = TYPE_TARGET_TYPE (type);
-
-         if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
-           {
-             /* Obscure case of range type that has different length from
-                its base type.  Perform a conversion, or we will get a
-                nonsense value.  Actually, we could use the same
-                code regardless of lengths; I'm just avoiding a cast.  */
-             struct value *v1
-               = value_from_contents_and_address (type, valaddr + offset, 0);
-             struct value *v = value_cast (target_type, v1);
-
-             ada_val_print_1 (target_type,
-                              value_contents_for_printing (v),
-                              value_embedded_offset (v), 0,
-                              stream, recurse + 1, v, options);
-           }
-         else
-           ada_val_print_1 (TYPE_TARGET_TYPE (type),
-                            valaddr, offset,
-                            address, stream, recurse,
-                            original_value, options);
-         return;
-       }
-      else
-       {
-         int format = (options->format ? options->format
-                       : options->output_format);
-
-         if (format)
-           {
-             struct value_print_options opts = *options;
-
-             opts.format = format;
-             val_print_scalar_formatted (type, valaddr, offset_aligned,
-                                         original_value, &opts, 0, stream);
-           }
-          else if (ada_is_system_address_type (type))
-            {
-              /* FIXME: We want to print System.Address variables using
-                 the same format as for any access type.  But for some
-                 reason GNAT encodes the System.Address type as an int,
-                 so we have to work-around this deficiency by handling
-                 System.Address values as a special case.  */
-
-             struct gdbarch *gdbarch = get_type_arch (type);
-             struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
-             CORE_ADDR addr = extract_typed_address (valaddr + offset_aligned,
-                                                     ptr_type);
-
-              fprintf_filtered (stream, "(");
-              type_print (type, "", stream, -1);
-              fprintf_filtered (stream, ") ");
-             fputs_filtered (paddress (gdbarch, addr), stream);
-            }
-         else
-           {
-             val_print_type_code_int (type, valaddr + offset_aligned, stream);
-             if (ada_is_character_type (type))
-               {
-                 LONGEST c;
-
-                 fputs_filtered (" ", stream);
-                 c = unpack_long (type, valaddr + offset_aligned);
-                 ada_printchar (c, type, stream);
-               }
-           }
-         return;
-       }
-
-    case TYPE_CODE_ENUM:
-      {
-       unsigned int len;
-       LONGEST val;
-
-       if (options->format)
-         {
-           val_print_scalar_formatted (type, valaddr, offset_aligned,
-                                       original_value, options, 0, stream);
-           break;
-         }
-       len = TYPE_NFIELDS (type);
-       val = unpack_long (type, valaddr + offset_aligned);
-       for (i = 0; i < len; i++)
-         {
-           QUIT;
-           if (val == TYPE_FIELD_ENUMVAL (type, i))
-             {
-               break;
-             }
-         }
-       if (i < len)
-         {
-           const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
-
-           if (name[0] == '\'')
-             fprintf_filtered (stream, "%ld %s", (long) val, name);
-           else
-             fputs_filtered (name, stream);
-         }
-       else
-         {
-           print_longest (stream, 'd', 0, val);
-         }
-       break;
-      }
-
-    case TYPE_CODE_FLT:
-      if (options->format)
-       {
-         c_val_print (type, valaddr, offset, address, stream,
-                      recurse, original_value, options);
-         return;
-       }
-      else
-       ada_print_floating (valaddr + offset, type, stream);
-      break;
-
-    case TYPE_CODE_UNION:
-    case TYPE_CODE_STRUCT:
-      if (ada_is_bogus_array_descriptor (type))
-       {
-         fprintf_filtered (stream, "(...?)");
-         return;
-       }
-      else
-       {
-         print_record (type, valaddr, offset_aligned,
-                       stream, recurse, original_value, options);
-         return;
-       }
-
-    case TYPE_CODE_ARRAY:
-      ada_val_print_array (type, valaddr, offset_aligned,
-                          address, stream, recurse, original_value,
-                          options);
-      return;
-
-    case TYPE_CODE_REF:
-      /* For references, the debugger is expected to print the value as
-         an address if DEREF_REF is null.  But printing an address in place
-         of the object value would be confusing to an Ada programmer.
-         So, for Ada values, we print the actual dereferenced value
-         regardless.  */
-      elttype = check_typedef (TYPE_TARGET_TYPE (type));
-      
-      if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
-        {
-          CORE_ADDR deref_val_int;
-         struct value *deref_val;
-
-         deref_val = coerce_ref_if_computed (original_value);
-         if (deref_val)
-           {
-             if (ada_is_tagged_type (value_type (deref_val), 1))
-               deref_val = ada_tag_value_at_base_address (deref_val);
-
-             common_val_print (deref_val, stream, recurse + 1, options,
-                               current_language);
-             break;
-           }
-
-          deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
-          if (deref_val_int != 0)
-            {
-              deref_val =
-                ada_value_ind (value_from_pointer
-                               (lookup_pointer_type (elttype),
-                                deref_val_int));
-
-             if (ada_is_tagged_type (value_type (deref_val), 1))
-               deref_val = ada_tag_value_at_base_address (deref_val);
-
-              val_print (value_type (deref_val),
-                         value_contents_for_printing (deref_val),
-                         value_embedded_offset (deref_val),
-                         value_address (deref_val), stream, recurse + 1,
-                        deref_val, options, current_language);
-            }
-          else
-            fputs_filtered ("(null)", stream);
-        }
-      else
-        fputs_filtered ("???", stream);
-
-      break;
-    }
-  gdb_flush (stream);
-}
-
 static int
 print_variant_part (struct type *type, int field_num,
                    const gdb_byte *valaddr, int offset,
@@ -920,7 +535,8 @@ print_variant_part (struct type *type, int field_num,
                    const struct value *val,
                    const struct value_print_options *options,
                    int comma_needed,
-                   struct type *outer_type, int outer_offset)
+                   struct type *outer_type, int outer_offset,
+                   const struct language_defn *language)
 {
   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
   int which = ada_which_variant_applies (var_type, outer_type,
@@ -935,79 +551,7 @@ print_variant_part (struct type *type, int field_num,
        offset + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
        stream, recurse, val, options,
-       comma_needed, outer_type, outer_offset);
-}
-
-void
-ada_value_print (struct value *val0, struct ui_file *stream,
-                const struct value_print_options *options)
-{
-  struct value *val = ada_to_fixed_value (val0);
-  CORE_ADDR address = value_address (val);
-  struct type *type = ada_check_typedef (value_type (val));
-  struct value_print_options opts;
-
-  /* If it is a pointer, indicate what it points to.  */
-  if (TYPE_CODE (type) == TYPE_CODE_PTR)
-    {
-      /* Hack:  don't print (char *) for char strings.  Their
-         type is indicated by the quoted string anyway.  */
-      if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
-         || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
-         || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
-       {
-         fprintf_filtered (stream, "(");
-         type_print (type, "", stream, -1);
-         fprintf_filtered (stream, ") ");
-       }
-    }
-  else if (ada_is_array_descriptor_type (type))
-    {
-      /* We do not print the type description unless TYPE is an array
-        access type (this is encoded by the compiler as a typedef to
-        a fat pointer - hence the check against TYPE_CODE_TYPEDEF).  */
-      if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
-        {
-         fprintf_filtered (stream, "(");
-         type_print (type, "", stream, -1);
-         fprintf_filtered (stream, ") ");
-       }
-    }
-  else if (ada_is_bogus_array_descriptor (type))
-    {
-      fprintf_filtered (stream, "(");
-      type_print (type, "", stream, -1);
-      fprintf_filtered (stream, ") (...?)");
-      return;
-    }
-
-  opts = *options;
-  opts.deref_ref = 1;
-  val_print (type, value_contents_for_printing (val),
-            value_embedded_offset (val), address,
-            stream, 0, val, &opts, current_language);
-}
-
-static void
-print_record (struct type *type, const gdb_byte *valaddr,
-             int offset,
-             struct ui_file *stream, int recurse,
-             const struct value *val,
-             const struct value_print_options *options)
-{
-  type = ada_check_typedef (type);
-
-  fprintf_filtered (stream, "(");
-
-  if (print_field_values (type, valaddr, offset,
-                         stream, recurse, val, options,
-                         0, type, offset) != 0 && options->prettyformat)
-    {
-      fprintf_filtered (stream, "\n");
-      print_spaces_filtered (2 * recurse, stream);
-    }
-
-  fprintf_filtered (stream, ")");
+       comma_needed, outer_type, outer_offset, language);
 }
 
 /* Print out fields of value at VALADDR + OFFSET having structure type TYPE.
@@ -1031,7 +575,8 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
                    const struct value *val,
                    const struct value_print_options *options,
                    int comma_needed,
-                   struct type *outer_type, int outer_offset)
+                   struct type *outer_type, int outer_offset,
+                   const struct language_defn *language)
 {
   int i, len;
 
@@ -1050,7 +595,7 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
                                (offset
                                 + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
                                stream, recurse, val, options,
-                               comma_needed, type, offset);
+                               comma_needed, type, offset, language);
          continue;
        }
       else if (ada_is_variant_part (type, i))
@@ -1059,7 +604,7 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
            print_variant_part (type, i, valaddr,
                                offset, stream, recurse, val,
                                options, comma_needed,
-                               outer_type, outer_offset);
+                               outer_type, outer_offset, language);
          continue;
        }
 
@@ -1113,7 +658,7 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
                         value_contents_for_printing (v),
                         value_embedded_offset (v), 0,
                         stream, recurse + 1, v,
-                        &opts, current_language);
+                        &opts, language);
            }
        }
       else
@@ -1121,14 +666,550 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
          struct value_print_options opts = *options;
 
          opts.deref_ref = 0;
-         ada_val_print (TYPE_FIELD_TYPE (type, i),
-                        valaddr,
-                        (offset
-                         + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
-                        0, stream, recurse + 1, val, &opts);
+         val_print (TYPE_FIELD_TYPE (type, i), valaddr,
+                    (offset + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
+                    0, stream, recurse + 1, val, &opts, language);
        }
       annotate_field_end ();
     }
 
   return comma_needed;
 }
+
+/* Implement Ada val_print'ing for the case where TYPE is
+   a TYPE_CODE_ARRAY of characters.  */
+
+static void
+ada_val_print_string (struct type *type, const gdb_byte *valaddr,
+                     int offset, int offset_aligned, CORE_ADDR address,
+                     struct ui_file *stream, int recurse,
+                     const struct value *original_value,
+                     const struct value_print_options *options)
+{
+  enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
+  struct type *elttype = TYPE_TARGET_TYPE (type);
+  unsigned int eltlen;
+  unsigned int len;
+
+  /* We know that ELTTYPE cannot possibly be null, because we assume
+     that we're called only when TYPE is a string-like type.
+     Similarly, the size of ELTTYPE should also be non-null, since
+     it's a character-like type.  */
+  gdb_assert (elttype != NULL);
+  gdb_assert (TYPE_LENGTH (elttype) != 0);
+
+  eltlen = TYPE_LENGTH (elttype);
+  len = TYPE_LENGTH (type) / eltlen;
+
+  if (options->prettyformat_arrays)
+    print_spaces_filtered (2 + 2 * recurse, stream);
+
+  /* If requested, look for the first null char and only print
+     elements up to it.  */
+  if (options->stop_print_at_null)
+    {
+      int temp_len;
+
+      /* Look for a NULL char.  */
+      for (temp_len = 0;
+          (temp_len < len
+           && temp_len < options->print_max
+           && char_at (valaddr + offset_aligned,
+                       temp_len, eltlen, byte_order) != 0);
+          temp_len += 1);
+      len = temp_len;
+    }
+
+  printstr (stream, elttype, valaddr + offset_aligned, len, 0,
+           eltlen, options);
+}
+
+/* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers,
+   thin pointers, etc).  */
+
+static void
+ada_val_print_gnat_array (struct type *type, const gdb_byte *valaddr,
+                         int offset, CORE_ADDR address,
+                         struct ui_file *stream, int recurse,
+                         const struct value *original_value,
+                         const struct value_print_options *options,
+                         const struct language_defn *language)
+{
+  struct value *mark = value_mark ();
+  struct value *val;
+
+  val = value_from_contents_and_address (type, valaddr + offset, address);
+  /* If this is a reference, coerce it now.  This helps taking care
+     of the case where ADDRESS is meaningless because original_value
+     was not an lval.  */
+  val = coerce_ref (val);
+  if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
+    val = ada_coerce_to_simple_array_ptr (val);
+  else
+    val = ada_coerce_to_simple_array (val);
+  if (val == NULL)
+    {
+      gdb_assert (TYPE_CODE (type) == TYPE_CODE_TYPEDEF);
+      fprintf_filtered (stream, "0x0");
+    }
+  else
+    val_print (value_type (val), value_contents_for_printing (val),
+              value_embedded_offset (val), value_address (val),
+              stream, recurse, val, options, language);
+  value_free_to_mark (mark);
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+   a TYPE_CODE_PTR.  */
+
+static void
+ada_val_print_ptr (struct type *type, const gdb_byte *valaddr,
+                  int offset, int offset_aligned, CORE_ADDR address,
+                  struct ui_file *stream, int recurse,
+                  const struct value *original_value,
+                  const struct value_print_options *options,
+                  const struct language_defn *language)
+{
+  val_print (type, valaddr, offset, address, stream, recurse,
+            original_value, options, language_def (language_c));
+
+  if (ada_is_tag_type (type))
+    {
+      struct value *val =
+       value_from_contents_and_address (type,
+                                        valaddr + offset_aligned,
+                                        address + offset_aligned);
+      const char *name = ada_tag_name (val);
+
+      if (name != NULL)
+       fprintf_filtered (stream, " (%s)", name);
+    }
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+   a TYPE_CODE_INT or TYPE_CODE_RANGE.  */
+
+static void
+ada_val_print_num (struct type *type, const gdb_byte *valaddr,
+                  int offset, int offset_aligned, CORE_ADDR address,
+                  struct ui_file *stream, int recurse,
+                  const struct value *original_value,
+                  const struct value_print_options *options,
+                  const struct language_defn *language)
+{
+  if (ada_is_fixed_point_type (type))
+    {
+      LONGEST v = unpack_long (type, valaddr + offset_aligned);
+
+      fprintf_filtered (stream, TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g",
+                       (double) ada_fixed_to_float (type, v));
+      return;
+    }
+  else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
+    {
+      struct type *target_type = TYPE_TARGET_TYPE (type);
+
+      if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
+       {
+         /* Obscure case of range type that has different length from
+            its base type.  Perform a conversion, or we will get a
+            nonsense value.  Actually, we could use the same
+            code regardless of lengths; I'm just avoiding a cast.  */
+         struct value *v1
+           = value_from_contents_and_address (type, valaddr + offset, 0);
+         struct value *v = value_cast (target_type, v1);
+
+         val_print (target_type, value_contents_for_printing (v),
+                    value_embedded_offset (v), 0, stream,
+                    recurse + 1, v, options, language);
+       }
+      else
+       val_print (TYPE_TARGET_TYPE (type), valaddr, offset,
+                  address, stream, recurse, original_value,
+                  options, language);
+      return;
+    }
+  else
+    {
+      int format = (options->format ? options->format
+                   : options->output_format);
+
+      if (format)
+       {
+         struct value_print_options opts = *options;
+
+         opts.format = format;
+         val_print_scalar_formatted (type, valaddr, offset_aligned,
+                                     original_value, &opts, 0, stream);
+       }
+      else if (ada_is_system_address_type (type))
+       {
+         /* FIXME: We want to print System.Address variables using
+            the same format as for any access type.  But for some
+            reason GNAT encodes the System.Address type as an int,
+            so we have to work-around this deficiency by handling
+            System.Address values as a special case.  */
+
+         struct gdbarch *gdbarch = get_type_arch (type);
+         struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
+         CORE_ADDR addr = extract_typed_address (valaddr + offset_aligned,
+                                                 ptr_type);
+
+         fprintf_filtered (stream, "(");
+         type_print (type, "", stream, -1);
+         fprintf_filtered (stream, ") ");
+         fputs_filtered (paddress (gdbarch, addr), stream);
+       }
+      else
+       {
+         val_print_type_code_int (type, valaddr + offset_aligned, stream);
+         if (ada_is_character_type (type))
+           {
+             LONGEST c;
+
+             fputs_filtered (" ", stream);
+             c = unpack_long (type, valaddr + offset_aligned);
+             ada_printchar (c, type, stream);
+           }
+       }
+      return;
+    }
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+   a TYPE_CODE_ENUM.  */
+
+static void
+ada_val_print_enum (struct type *type, const gdb_byte *valaddr,
+                   int offset, int offset_aligned, CORE_ADDR address,
+                   struct ui_file *stream, int recurse,
+                   const struct value *original_value,
+                   const struct value_print_options *options,
+                   const struct language_defn *language)
+{
+  int i;
+  unsigned int len;
+  LONGEST val;
+
+  if (options->format)
+    {
+      val_print_scalar_formatted (type, valaddr, offset_aligned,
+                                 original_value, options, 0, stream);
+      return;
+    }
+
+  len = TYPE_NFIELDS (type);
+  val = unpack_long (type, valaddr + offset_aligned);
+  for (i = 0; i < len; i++)
+    {
+      QUIT;
+      if (val == TYPE_FIELD_ENUMVAL (type, i))
+       break;
+    }
+
+  if (i < len)
+    {
+      const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
+
+      if (name[0] == '\'')
+       fprintf_filtered (stream, "%ld %s", (long) val, name);
+      else
+       fputs_filtered (name, stream);
+    }
+  else
+    print_longest (stream, 'd', 0, val);
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+   a TYPE_CODE_FLT.  */
+
+static void
+ada_val_print_flt (struct type *type, const gdb_byte *valaddr,
+                  int offset, int offset_aligned, CORE_ADDR address,
+                  struct ui_file *stream, int recurse,
+                  const struct value *original_value,
+                  const struct value_print_options *options,
+                  const struct language_defn *language)
+{
+  if (options->format)
+    {
+      val_print (type, valaddr, offset, address, stream, recurse,
+                original_value, options, language_def (language_c));
+      return;
+    }
+
+  ada_print_floating (valaddr + offset, type, stream);
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+   a TYPE_CODE_STRUCT or TYPE_CODE_UNION.  */
+
+static void
+ada_val_print_struct_union
+  (struct type *type, const gdb_byte *valaddr, int offset,
+   int offset_aligned, CORE_ADDR address, struct ui_file *stream,
+   int recurse, const struct value *original_value,
+   const struct value_print_options *options,
+   const struct language_defn *language)
+{
+  if (ada_is_bogus_array_descriptor (type))
+    {
+      fprintf_filtered (stream, "(...?)");
+      return;
+    }
+
+  fprintf_filtered (stream, "(");
+
+  if (print_field_values (type, valaddr, offset_aligned,
+                         stream, recurse, original_value, options,
+                         0, type, offset_aligned, language) != 0
+      && options->prettyformat)
+    {
+      fprintf_filtered (stream, "\n");
+      print_spaces_filtered (2 * recurse, stream);
+    }
+
+  fprintf_filtered (stream, ")");
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+   a TYPE_CODE_ARRAY.  */
+
+static void
+ada_val_print_array (struct type *type, const gdb_byte *valaddr,
+                    int offset, int offset_aligned, CORE_ADDR address,
+                    struct ui_file *stream, int recurse,
+                    const struct value *original_value,
+                    const struct value_print_options *options)
+{
+  /* For an array of characters, print with string syntax.  */
+  if (ada_is_string_type (type)
+      && (options->format == 0 || options->format == 's'))
+    {
+      ada_val_print_string (type, valaddr, offset, offset_aligned,
+                           address, stream, recurse, original_value,
+                           options);
+      return;
+    }
+
+  fprintf_filtered (stream, "(");
+  print_optional_low_bound (stream, type, options);
+  if (TYPE_FIELD_BITSIZE (type, 0) > 0)
+    val_print_packed_array_elements (type, valaddr, offset_aligned,
+                                    0, stream, recurse,
+                                    original_value, options);
+  else
+    val_print_array_elements (type, valaddr, offset_aligned, address,
+                             stream, recurse, original_value,
+                             options, 0);
+  fprintf_filtered (stream, ")");
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+   a TYPE_CODE_REF.  */
+
+static void
+ada_val_print_ref (struct type *type, const gdb_byte *valaddr,
+                  int offset, int offset_aligned, CORE_ADDR address,
+                  struct ui_file *stream, int recurse,
+                  const struct value *original_value,
+                  const struct value_print_options *options,
+                  const struct language_defn *language)
+{
+  /* For references, the debugger is expected to print the value as
+     an address if DEREF_REF is null.  But printing an address in place
+     of the object value would be confusing to an Ada programmer.
+     So, for Ada values, we print the actual dereferenced value
+     regardless.  */
+  struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
+  struct value *deref_val;
+  CORE_ADDR deref_val_int;
+
+  if (TYPE_CODE (elttype) == TYPE_CODE_UNDEF)
+    {
+      fputs_filtered ("<ref to undefined type>", stream);
+      return;
+    }
+
+  deref_val = coerce_ref_if_computed (original_value);
+  if (deref_val)
+    {
+      if (ada_is_tagged_type (value_type (deref_val), 1))
+       deref_val = ada_tag_value_at_base_address (deref_val);
+
+      common_val_print (deref_val, stream, recurse + 1, options,
+                       language);
+      return;
+    }
+
+  deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
+  if (deref_val_int == 0)
+    {
+      fputs_filtered ("(null)", stream);
+      return;
+    }
+
+  deref_val
+    = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype),
+                                        deref_val_int));
+  if (ada_is_tagged_type (value_type (deref_val), 1))
+    deref_val = ada_tag_value_at_base_address (deref_val);
+
+  val_print (value_type (deref_val),
+            value_contents_for_printing (deref_val),
+            value_embedded_offset (deref_val),
+            value_address (deref_val), stream, recurse + 1,
+            deref_val, options, language);
+}
+
+/* See the comment on ada_val_print.  This function differs in that it
+   does not catch evaluation errors (leaving that to ada_val_print).  */
+
+static void
+ada_val_print_1 (struct type *type, const gdb_byte *valaddr,
+                int offset, CORE_ADDR address,
+                struct ui_file *stream, int recurse,
+                const struct value *original_value,
+                const struct value_print_options *options,
+                const struct language_defn *language)
+{
+  int offset_aligned;
+
+  type = ada_check_typedef (type);
+
+  if (ada_is_array_descriptor_type (type)
+      || (ada_is_constrained_packed_array_type (type)
+         && TYPE_CODE (type) != TYPE_CODE_PTR))
+    {
+      ada_val_print_gnat_array (type, valaddr, offset, address,
+                               stream, recurse, original_value,
+                               options, language);
+      return;
+    }
+
+  offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
+  type = printable_val_type (type, valaddr + offset_aligned);
+
+  switch (TYPE_CODE (type))
+    {
+    default:
+      val_print (type, valaddr, offset, address, stream, recurse,
+                original_value, options, language_def (language_c));
+      break;
+
+    case TYPE_CODE_PTR:
+      ada_val_print_ptr (type, valaddr, offset, offset_aligned,
+                        address, stream, recurse, original_value,
+                        options, language);
+      break;
+
+    case TYPE_CODE_INT:
+    case TYPE_CODE_RANGE:
+      ada_val_print_num (type, valaddr, offset, offset_aligned,
+                        address, stream, recurse, original_value,
+                        options, language);
+      break;
+
+    case TYPE_CODE_ENUM:
+      ada_val_print_enum (type, valaddr, offset, offset_aligned,
+                         address, stream, recurse, original_value,
+                         options, language);
+      break;
+
+    case TYPE_CODE_FLT:
+      ada_val_print_flt (type, valaddr, offset, offset_aligned,
+                        address, stream, recurse, original_value,
+                        options, language);
+      break;
+
+    case TYPE_CODE_UNION:
+    case TYPE_CODE_STRUCT:
+      ada_val_print_struct_union (type, valaddr, offset, offset_aligned,
+                                 address, stream, recurse,
+                                 original_value, options, language);
+      break;
+
+    case TYPE_CODE_ARRAY:
+      ada_val_print_array (type, valaddr, offset, offset_aligned,
+                          address, stream, recurse, original_value,
+                          options);
+      return;
+
+    case TYPE_CODE_REF:
+      ada_val_print_ref (type, valaddr, offset, offset_aligned,
+                        address, stream, recurse, original_value,
+                        options, language);
+      break;
+    }
+}
+
+/* See val_print for a description of the various parameters of this
+   function; they are identical.  */
+
+void
+ada_val_print (struct type *type, const gdb_byte *valaddr,
+              int embedded_offset, CORE_ADDR address,
+              struct ui_file *stream, int recurse,
+              const struct value *val,
+              const struct value_print_options *options)
+{
+  volatile struct gdb_exception except;
+
+  /* XXX: this catches QUIT/ctrl-c as well.  Isn't that busted?  */
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      ada_val_print_1 (type, valaddr, embedded_offset, address,
+                      stream, recurse, val, options,
+                      current_language);
+    }
+}
+
+void
+ada_value_print (struct value *val0, struct ui_file *stream,
+                const struct value_print_options *options)
+{
+  struct value *val = ada_to_fixed_value (val0);
+  CORE_ADDR address = value_address (val);
+  struct type *type = ada_check_typedef (value_enclosing_type (val));
+  struct value_print_options opts;
+
+  /* If it is a pointer, indicate what it points to.  */
+  if (TYPE_CODE (type) == TYPE_CODE_PTR)
+    {
+      /* Hack:  don't print (char *) for char strings.  Their
+         type is indicated by the quoted string anyway.  */
+      if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
+         || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
+         || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
+       {
+         fprintf_filtered (stream, "(");
+         type_print (type, "", stream, -1);
+         fprintf_filtered (stream, ") ");
+       }
+    }
+  else if (ada_is_array_descriptor_type (type))
+    {
+      /* We do not print the type description unless TYPE is an array
+        access type (this is encoded by the compiler as a typedef to
+        a fat pointer - hence the check against TYPE_CODE_TYPEDEF).  */
+      if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
+        {
+         fprintf_filtered (stream, "(");
+         type_print (type, "", stream, -1);
+         fprintf_filtered (stream, ") ");
+       }
+    }
+  else if (ada_is_bogus_array_descriptor (type))
+    {
+      fprintf_filtered (stream, "(");
+      type_print (type, "", stream, -1);
+      fprintf_filtered (stream, ") (...?)");
+      return;
+    }
+
+  opts = *options;
+  opts.deref_ref = 1;
+  val_print (type, value_contents_for_printing (val),
+            value_embedded_offset (val), address,
+            stream, 0, val, &opts, current_language);
+}