]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blobdiff - gdb/ada-valprint.c
PR24435, buffer overflow reading dynamic entries
[thirdparty/binutils-gdb.git] / gdb / ada-valprint.c
index 32b85f2394623b123fc5f575d4e0319863dd0284..5d7823d7204186afd43f87b9ec58fa381184d724 100644 (file)
@@ -1,7 +1,6 @@
 /* Support for printing Ada values for GDB, the GNU debugger.
 
-   Copyright (C) 1986, 1988-1989, 1991-1994, 1997, 2001-2012 Free
-   Software Foundation, Inc.
+   Copyright (C) 1986-2019 Free Software Foundation, Inc.
 
    This file is part of GDB.
 
@@ -20,7 +19,6 @@
 
 #include "defs.h"
 #include <ctype.h>
-#include "gdb_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 *);
+#include "target-float.h"
 
 static int print_field_values (struct type *, const gdb_byte *,
                               int,
                               struct ui_file *, int,
-                              const struct value *,
+                              struct value *,
                               const struct value_print_options *,
-                              int, struct type *, int);
-
-static void adjust_type_signedness (struct type *);
-
-static int 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.  */
@@ -92,7 +78,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
@@ -102,14 +88,16 @@ print_optional_low_bound (struct ui_file *stream, struct type *type,
       index_type = TYPE_TARGET_TYPE (index_type);
     }
 
+  /* Don't print the lower bound if it's the default one.  */
   switch (TYPE_CODE (index_type))
     {
     case TYPE_CODE_BOOL:
+    case TYPE_CODE_CHAR:
       if (low_bound == 0)
        return 0;
       break;
     case TYPE_CODE_ENUM:
-      if (low_bound == TYPE_FIELD_BITPOS (index_type, 0))
+      if (low_bound == TYPE_FIELD_ENUMVAL (index_type, 0))
        return 0;
       break;
     case TYPE_CODE_UNDEF:
@@ -137,29 +125,61 @@ val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
                                 int offset,
                                 int bitoffset, struct ui_file *stream,
                                 int recurse,
-                                const struct value *val,
+                                struct value *val,
                                 const struct value_print_options *options)
 {
   unsigned int i;
   unsigned int things_printed = 0;
   unsigned len;
   struct type *elttype, *index_type;
-  unsigned eltlen;
   unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
   struct value *mark = value_mark ();
   LONGEST low = 0;
 
   elttype = TYPE_TARGET_TYPE (type);
-  eltlen = TYPE_LENGTH (check_typedef (elttype));
   index_type = TYPE_INDEX_TYPE (type);
 
   {
     LONGEST high;
+    struct type *base_index_type;
 
     if (get_discrete_bounds (index_type, &low, &high) < 0)
       len = 1;
     else
       len = high - low + 1;
+
+    if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
+        base_index_type = TYPE_TARGET_TYPE (index_type);
+      else
+        base_index_type = index_type;
+
+    if (TYPE_CODE (base_index_type) == TYPE_CODE_ENUM)
+      {
+        LONGEST low_pos, high_pos;
+
+        /* Non-contiguous enumerations types can by used as index types
+           so the array length is computed from the positions of the
+           first and last literal in the enumeration type, and not from
+           the values of these literals.  */
+
+        if (!discrete_position (base_index_type, low, &low_pos)
+          || !discrete_position (base_index_type, high, &high_pos))
+          {
+            warning (_("unable to get positions in array, use bounds instead"));
+            low_pos = low;
+            high_pos = high;
+          }
+
+        /* The array length should normally be HIGH_POS - LOW_POS + 1.
+           But in Ada we allow LOW_POS to be greater than HIGH_POS for
+           empty arrays.  In that situation, the array length is just zero,
+           not negative!  */
+
+        if (low_pos > high_pos)
+          len = 0;
+        else
+          len = high_pos - low_pos + 1;
+      }
   }
 
   i = 0;
@@ -172,7 +192,7 @@ val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
 
       if (i != 0)
        {
-         if (options->prettyprint_arrays)
+         if (options->prettyformat_arrays)
            {
              fprintf_filtered (stream, ",\n");
              print_spaces_filtered (2 + 2 * recurse, stream);
@@ -199,9 +219,12 @@ 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 (TYPE_LENGTH (check_typedef (value_type (v0)))
+             != TYPE_LENGTH (check_typedef (value_type (v1))))
+           break;
+         if (!value_contents_eq (v0, value_embedded_offset (v0),
+                                 v1, value_embedded_offset (v1),
+                                 TYPE_LENGTH (check_typedef (value_type (v0)))))
            break;
        }
 
@@ -210,7 +233,7 @@ val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
          struct value_print_options opts = *options;
 
          opts.deref_ref = 0;
-         val_print (elttype, value_contents_for_printing (v0),
+         val_print (elttype,
                     value_embedded_offset (v0), 0, stream,
                     recurse + 1, v0, &opts, current_language);
          annotate_elt_rep (i - i0);
@@ -228,7 +251,7 @@ val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
            {
              if (j > i0)
                {
-                 if (options->prettyprint_arrays)
+                 if (options->prettyformat_arrays)
                    {
                      fprintf_filtered (stream, ",\n");
                      print_spaces_filtered (2 + 2 * recurse, stream);
@@ -241,7 +264,7 @@ val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
                  maybe_print_array_index (index_type, j + low,
                                           stream, options);
                }
-             val_print (elttype, value_contents_for_printing (v0),
+             val_print (elttype,
                         value_embedded_offset (v0), 0, stream,
                         recurse + 1, v0, &opts, current_language);
              annotate_elt ();
@@ -303,70 +326,58 @@ 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;
-  int len;
-  struct ui_file *tmp_stream = mem_fileopen ();
-  struct cleanup *cleanups = make_cleanup_ui_file_delete (tmp_stream);
+  string_file tmp_stream;
 
-  print_floating (valaddr, type, tmp_stream);
-  ui_file_put (tmp_stream, ui_memcpy, buffer);
-  do_cleanups (cleanups);
+  print_floating (valaddr, type, &tmp_stream);
 
-  result = buffer;
-  len = strlen (result);
+  std::string &s = tmp_stream.string ();
+  size_t skip_count = 0;
 
   /* Modify for Ada rules.  */
 
-  s = strstr (result, "inf");
-  if (s == NULL)
-    s = strstr (result, "Inf");
-  if (s == NULL)
-    s = strstr (result, "INF");
-  if (s != NULL)
-    strcpy (s, "Inf");
+  size_t pos = s.find ("inf");
+  if (pos == std::string::npos)
+    pos = s.find ("Inf");
+  if (pos == std::string::npos)
+    pos = s.find ("INF");
+  if (pos != std::string::npos)
+    s.replace (pos, 3, "Inf");
 
-  if (s == NULL)
+  if (pos == std::string::npos)
     {
-      s = strstr (result, "nan");
-      if (s == NULL)
-       s = strstr (result, "NaN");
-      if (s == NULL)
-       s = strstr (result, "Nan");
-      if (s != NULL)
+      pos = s.find ("nan");
+      if (pos == std::string::npos)
+       pos = s.find ("NaN");
+      if (pos == std::string::npos)
+       pos = s.find ("Nan");
+      if (pos != std::string::npos)
        {
-         s[0] = s[2] = 'N';
-         if (result[0] == '-')
-           result += 1;
+         s[pos] = s[pos + 2] = 'N';
+         if (s[0] == '-')
+           skip_count = 1;
        }
     }
 
-  if (s == NULL && strchr (result, '.') == NULL)
+  if (pos == std::string::npos
+      && s.find ('.') == std::string::npos)
     {
-      s = strchr (result, 'e');
-      if (s == NULL)
-       fprintf_filtered (stream, "%s.0", result);
+      pos = s.find ('e');
+      if (pos == std::string::npos)
+       fprintf_filtered (stream, "%s.0", s.c_str ());
       else
-       fprintf_filtered (stream, "%.*s.0%s", (int) (s-result), result, s);
-      return;
+       fprintf_filtered (stream, "%.*s.0%s", (int) pos, s.c_str (), &s[pos]);
     }
-  fprintf_filtered (stream, "%s", result);
+  else
+    fprintf_filtered (stream, "%s", &s[skip_count]);
 }
 
 void
@@ -402,7 +413,7 @@ ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
       len = TYPE_NFIELDS (type);
       for (i = 0; i < len; i++)
        {
-         if (TYPE_FIELD_BITPOS (type, i) == val)
+         if (TYPE_FIELD_ENUMVAL (type, i) == val)
            {
              break;
            }
@@ -454,7 +465,6 @@ ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
     default:
       error (_("Invalid type code in symbol table."));
     }
-  gdb_flush (stream);
 }
 
 /* Print the character string STRING, printing at most LENGTH characters.
@@ -510,10 +520,7 @@ printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
        {
          if (in_quotes)
            {
-             if (options->inspect_it)
-               fputs_filtered ("\\\", ", stream);
-             else
-               fputs_filtered ("\", ", stream);
+             fputs_filtered ("\", ", stream);
              in_quotes = 0;
            }
          fputs_filtered ("'", stream);
@@ -529,10 +536,7 @@ printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
        {
          if (!in_quotes)
            {
-             if (options->inspect_it)
-               fputs_filtered ("\\\"", stream);
-             else
-               fputs_filtered ("\"", stream);
+             fputs_filtered ("\"", stream);
              in_quotes = 1;
            }
          ada_emit_char (char_at (string, i, type_len, byte_order),
@@ -543,12 +547,7 @@ printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
 
   /* Terminate the quotes if necessary.  */
   if (in_quotes)
-    {
-      if (options->inspect_it)
-       fputs_filtered ("\\\"", stream);
-      else
-       fputs_filtered ("\"", stream);
-    }
+    fputs_filtered ("\"", stream);
 
   if (force_ellipses || i < length)
     fputs_filtered ("...", stream);
@@ -564,388 +563,15 @@ 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.  The semantics of the return value is
-   also identical to val_print.  */
-
-int
-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;
-  int result = 0;
-
-  /* XXX: this catches QUIT/ctrl-c as well.  Isn't that busted?  */
-  TRY_CATCH (except, RETURN_MASK_ALL)
-    {
-      result = ada_val_print_1 (type, valaddr, embedded_offset, address,
-                               stream, recurse, val, options);
-    }
-
-  if (except.reason < 0)
-    result = 0;
-
-  return result;
-}
-
-/* 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.  The semantics
-   of the return value is also identical to ada_val_print.  */
-
-static int
-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)
-{
-  int result = 0;
-
-  /* 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->prettyprint_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);
-      result = len;
-    }
-  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, ")");
-    }
-
-  return result;
-}
-
-/* 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 int
-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)
-{
-  unsigned int len;
-  int i;
-  struct type *elttype;
-  LONGEST val;
-  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))
-    {
-      int retn;
-      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");
-         retn = 0;
-       }
-      else
-       retn = 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 retn;
-    }
-
-  offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
-  type = printable_val_type (type, valaddr + offset_aligned);
-
-  switch (TYPE_CODE (type))
-    {
-    default:
-      return c_val_print (type, valaddr, offset, address, stream,
-                         recurse, original_value, options);
-
-    case TYPE_CODE_PTR:
-      {
-       int ret = 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 0;
-       }
-       return ret;
-      }
-
-    case TYPE_CODE_INT:
-    case TYPE_CODE_RANGE:
-      if (ada_is_fixed_point_type (type))
-       {
-         LONGEST v = unpack_long (type, valaddr + offset_aligned);
-         int len = TYPE_LENGTH (type);
-
-         fprintf_filtered (stream, len < 4 ? "%.11g" : "%.17g",
-                           (double) ada_fixed_to_float (type, v));
-         return 0;
-       }
-      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);
-
-             return ada_val_print_1 (target_type,
-                                     value_contents_for_printing (v),
-                                     value_embedded_offset (v), 0,
-                                     stream, recurse + 1, v, options);
-           }
-         else
-           return ada_val_print_1 (TYPE_TARGET_TYPE (type),
-                                   valaddr, offset,
-                                   address, stream, recurse,
-                                   original_value, options);
-       }
-      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 0;
-       }
-
-    case TYPE_CODE_ENUM:
-      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_BITPOS (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_FLAGS:
-      if (options->format)
-       val_print_scalar_formatted (type, valaddr, offset_aligned,
-                                   original_value, options, 0, stream);
-      else
-       val_print_type_code_flags (type, valaddr + offset_aligned, stream);
-      break;
-
-    case TYPE_CODE_FLT:
-      if (options->format)
-       return c_val_print (type, valaddr, offset, address, stream,
-                           recurse, original_value, options);
-      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 0;
-       }
-      else
-       {
-         print_record (type, valaddr, offset_aligned,
-                       stream, recurse, original_value, options);
-         return 0;
-       }
-
-    case TYPE_CODE_ARRAY:
-      return ada_val_print_array (type, valaddr, offset_aligned,
-                                 address, stream, recurse, original_value,
-                                 options);
-
-    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)
-           {
-             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)
-            {
-              struct value *deref_val =
-                ada_value_ind (value_from_pointer
-                               (lookup_pointer_type (elttype),
-                                deref_val_int));
-
-              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);
-  return 0;
-}
-
 static int
 print_variant_part (struct type *type, int field_num,
                    const gdb_byte *valaddr, int offset,
                    struct ui_file *stream, int recurse,
-                   const struct value *val,
+                   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,
@@ -960,79 +586,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->pretty)
-    {
-      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.
@@ -1053,10 +607,11 @@ print_record (struct type *type, const gdb_byte *valaddr,
 static int
 print_field_values (struct type *type, const gdb_byte *valaddr,
                    int offset, struct ui_file *stream, int recurse,
-                   const struct value *val,
+                   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;
 
@@ -1075,7 +630,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))
@@ -1084,7 +639,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;
        }
 
@@ -1092,7 +647,7 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
        fprintf_filtered (stream, ", ");
       comma_needed = 1;
 
-      if (options->pretty)
+      if (options->prettyformat)
        {
          fprintf_filtered (stream, "\n");
          print_spaces_filtered (2 + 2 * recurse, stream);
@@ -1101,34 +656,17 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
        {
          wrap_here (n_spaces (2 + 2 * recurse));
        }
-      if (options->inspect_it)
-       {
-         if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
-           fputs_filtered ("\"( ptr \"", stream);
-         else
-           fputs_filtered ("\"( nodef \"", stream);
-         fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
-                                  language_cplus, DMGL_NO_OPTS);
-         fputs_filtered ("\" \"", stream);
-         fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
-                                  language_cplus, DMGL_NO_OPTS);
-         fputs_filtered ("\") \"", stream);
-       }
-      else
-       {
-         annotate_field_begin (TYPE_FIELD_TYPE (type, i));
-         fprintf_filtered (stream, "%.*s",
-                           ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
-                           TYPE_FIELD_NAME (type, i));
-         annotate_field_name_end ();
-         fputs_filtered (" => ", stream);
-         annotate_field_value ();
-       }
+
+      annotate_field_begin (TYPE_FIELD_TYPE (type, i));
+      fprintf_filtered (stream, "%.*s",
+                       ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
+                       TYPE_FIELD_NAME (type, i));
+      annotate_field_name_end ();
+      fputs_filtered (" => ", stream);
+      annotate_field_value ();
 
       if (TYPE_FIELD_PACKED (type, i))
        {
-         struct value *v;
-
          /* Bitfields require special handling, especially due to byte
             order problems.  */
          if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
@@ -1137,6 +675,7 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
            }
          else
            {
+             struct value *v;
              int bit_pos = TYPE_FIELD_BITPOS (type, i);
              int bit_size = TYPE_FIELD_BITSIZE (type, i);
              struct value_print_options opts;
@@ -1150,10 +689,9 @@ print_field_values (struct type *type, const gdb_byte *valaddr,
              opts = *options;
              opts.deref_ref = 0;
              val_print (TYPE_FIELD_TYPE (type, i),
-                        value_contents_for_printing (v),
                         value_embedded_offset (v), 0,
                         stream, recurse + 1, v,
-                        &opts, current_language);
+                        &opts, language);
            }
        }
       else
@@ -1161,14 +699,569 @@ 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),
+                    (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,
+                     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,
+                         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_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,
+                  struct value *original_value,
+                  const struct value_print_options *options,
+                  const struct language_defn *language)
+{
+  val_print (type, 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,
+                  struct value *original_value,
+                  const struct value_print_options *options,
+                  const struct language_defn *language)
+{
+  if (ada_is_fixed_point_type (type))
+    {
+      struct value *scale = ada_scaling_factor (type);
+      struct value *v = value_from_contents (type, valaddr + offset_aligned);
+      v = value_cast (value_type (scale), v);
+      v = value_binop (v, scale, BINOP_MUL);
+
+      const char *fmt = TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g";
+      std::string str
+       = target_float_to_string (value_contents (v), value_type (v), fmt);
+      fputs_filtered (str.c_str (), stream);
+      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_embedded_offset (v), 0, stream,
+                    recurse + 1, v, options, language);
+       }
+      else
+       val_print (TYPE_TARGET_TYPE (type), 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, 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_scalar_formatted (type, offset_aligned,
+                                     original_value, options, 0, 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,
+                   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, 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,
+                  struct value *original_value,
+                  const struct value_print_options *options,
+                  const struct language_defn *language)
+{
+  if (options->format)
+    {
+      val_print (type, 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, 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,
+                    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, 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,
+                  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);
+
+  /* Make sure that the object does not have an unreasonable size
+     before trying to print it.  This can happen for instance with
+     references to dynamic objects whose contents is uninitialized
+     (Eg: an array whose bounds are not set yet).  */
+  ada_ensure_varsize_limit (value_type (deref_val));
+
+  if (value_lazy (deref_val))
+    value_fetch_lazy (deref_val);
+
+  val_print (value_type (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,
+                int offset, CORE_ADDR address,
+                struct ui_file *stream, int recurse,
+                struct value *original_value,
+                const struct value_print_options *options,
+                const struct language_defn *language)
+{
+  int offset_aligned;
+  const gdb_byte *valaddr = value_contents_for_printing (original_value);
+
+  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);
+  type = resolve_dynamic_type (type, valaddr + offset_aligned,
+                              address + offset_aligned);
+
+  switch (TYPE_CODE (type))
+    {
+    default:
+      val_print (type, 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,
+              int embedded_offset, CORE_ADDR address,
+              struct ui_file *stream, int recurse,
+              struct value *val,
+              const struct value_print_options *options)
+{
+  try
+    {
+      ada_val_print_1 (type, embedded_offset, address,
+                      stream, recurse, val, options,
+                      current_language);
+    }
+  catch (const gdb_exception_error &except)
+    {
+      fprintf_filtered (stream, _("<error reading variable: %s>"),
+                       except.what ());
+    }
+}
+
+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_embedded_offset (val), address,
+            stream, 0, val, &opts, current_language);
+}