gdb/ada-valprint.c

   1 /* Support for printing Ada values for GDB, the GNU debugger.
   2
   3    Copyright (C) 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1997, 2001, 2002,
   4    2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
   5
   6    This file is part of GDB.
   7
   8    This program is free software; you can redistribute it and/or modify
   9    it under the terms of the GNU General Public License as published by
  10    the Free Software Foundation; either version 3 of the License, or
  11    (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public License
  19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21 #include <ctype.h>
  22 #include "defs.h"
  23 #include "gdb_string.h"
  24 #include "symtab.h"
  25 #include "gdbtypes.h"
  26 #include "expression.h"
  27 #include "value.h"
  28 #include "demangle.h"
  29 #include "valprint.h"
  30 #include "language.h"
  31 #include "annotate.h"
  32 #include "ada-lang.h"
  33 #include "c-lang.h"
  34 #include "infcall.h"
  35 #include "exceptions.h"
  36 #include "objfiles.h"
  37
  38 /* Encapsulates arguments to ada_val_print.  */
  39 struct ada_val_print_args
  40 {
  41   struct type *type;
  42   const gdb_byte *valaddr0;
  43   int embedded_offset;
  44   CORE_ADDR address;
  45   struct ui_file *stream;
  46   int recurse;
  47   const struct value_print_options *options;
  48 };
  49
  50 static void print_record (struct type *, const gdb_byte *, struct ui_file *,
  51                           int, const struct value_print_options *);
  52
  53 static int print_field_values (struct type *, const gdb_byte *,
  54                                struct ui_file *, int,
  55                                const struct value_print_options *,
  56                                int, struct type *,
  57                                const gdb_byte *);
  58
  59 static void adjust_type_signedness (struct type *);
  60
  61 static int ada_val_print_stub (void *args0);
  62
  63 static int ada_val_print_1 (struct type *, const gdb_byte *, int, CORE_ADDR,
  64                             struct ui_file *, int,
  65                             const struct value_print_options *);
  66 \f
  67
  68 /* Make TYPE unsigned if its range of values includes no negatives.  */
  69 static void
  70 adjust_type_signedness (struct type *type)
  71 {
  72   if (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
  73       && TYPE_LOW_BOUND (type) >= 0)
  74     TYPE_UNSIGNED (type) = 1;
  75 }
  76
  77 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
  78    if non-standard (i.e., other than 1 for numbers, other than lower bound
  79    of index type for enumerated type).  Returns 1 if something printed,
  80    otherwise 0.  */
  81
  82 static int
  83 print_optional_low_bound (struct ui_file *stream, struct type *type,
  84                           const struct value_print_options *options)
  85 {
  86   struct type *index_type;
  87   long low_bound;
  88   long high_bound;
  89
  90   if (options->print_array_indexes)
  91     return 0;
  92
  93   if (!get_array_bounds (type, &low_bound, &high_bound))
  94     return 0;
  95
  96   /* If this is an empty array, then don't print the lower bound.
  97      That would be confusing, because we would print the lower bound,
  98      followed by... nothing!  */
  99   if (low_bound > high_bound)
 100     return 0;
 101
 102   index_type = TYPE_INDEX_TYPE (type);
 103
 104   if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
 105     {
 106       /* We need to know what the base type is, in order to do the
 107          appropriate check below.  Otherwise, if this is a subrange
 108          of an enumerated type, where the underlying value of the
 109          first element is typically 0, we might test the low bound
 110          against the wrong value.  */
 111       index_type = TYPE_TARGET_TYPE (index_type);
 112     }
 113
 114   switch (TYPE_CODE (index_type))
 115     {
 116     case TYPE_CODE_BOOL:
 117       if (low_bound == 0)
 118         return 0;
 119       break;
 120     case TYPE_CODE_ENUM:
 121       if (low_bound == TYPE_FIELD_BITPOS (index_type, 0))
 122         return 0;
 123       break;
 124     case TYPE_CODE_UNDEF:
 125       index_type = builtin_type_int32;
 126       /* FALL THROUGH */
 127     default:
 128       if (low_bound == 1)
 129         return 0;
 130       break;
 131     }
 132
 133   ada_print_scalar (index_type, (LONGEST) low_bound, stream);
 134   fprintf_filtered (stream, " => ");
 135   return 1;
 136 }
 137
 138 /*  Version of val_print_array_elements for GNAT-style packed arrays.
 139     Prints elements of packed array of type TYPE at bit offset
 140     BITOFFSET from VALADDR on STREAM.  Formats according to OPTIONS and
 141     separates with commas.  RECURSE is the recursion (nesting) level.
 142     TYPE must have been decoded (as by ada_coerce_to_simple_array).  */
 143
 144 static void
 145 val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
 146                                  int bitoffset, struct ui_file *stream,
 147                                  int recurse,
 148                                  const struct value_print_options *options)
 149 {
 150   unsigned int i;
 151   unsigned int things_printed = 0;
 152   unsigned len;
 153   struct type *elttype, *index_type;
 154   unsigned eltlen;
 155   unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
 156   struct value *mark = value_mark ();
 157   LONGEST low = 0;
 158
 159   elttype = TYPE_TARGET_TYPE (type);
 160   eltlen = TYPE_LENGTH (check_typedef (elttype));
 161   index_type = TYPE_INDEX_TYPE (type);
 162
 163   {
 164     LONGEST high;
 165     if (get_discrete_bounds (index_type, &low, &high) < 0)
 166       len = 1;
 167     else
 168       len = high - low + 1;
 169   }
 170
 171   i = 0;
 172   annotate_array_section_begin (i, elttype);
 173
 174   while (i < len && things_printed < options->print_max)
 175     {
 176       struct value *v0, *v1;
 177       int i0;
 178
 179       if (i != 0)
 180         {
 181           if (options->prettyprint_arrays)
 182             {
 183               fprintf_filtered (stream, ",\n");
 184               print_spaces_filtered (2 + 2 * recurse, stream);
 185             }
 186           else
 187             {
 188               fprintf_filtered (stream, ", ");
 189             }
 190         }
 191       wrap_here (n_spaces (2 + 2 * recurse));
 192       maybe_print_array_index (index_type, i + low, stream, options);
 193
 194       i0 = i;
 195       v0 = ada_value_primitive_packed_val (NULL, valaddr,
 196                                            (i0 * bitsize) / HOST_CHAR_BIT,
 197                                            (i0 * bitsize) % HOST_CHAR_BIT,
 198                                            bitsize, elttype);
 199       while (1)
 200         {
 201           i += 1;
 202           if (i >= len)
 203             break;
 204           v1 = ada_value_primitive_packed_val (NULL, valaddr,
 205                                                (i * bitsize) / HOST_CHAR_BIT,
 206                                                (i * bitsize) % HOST_CHAR_BIT,
 207                                                bitsize, elttype);
 208           if (memcmp (value_contents (v0), value_contents (v1), eltlen) != 0)
 209             break;
 210         }
 211
 212       if (i - i0 > options->repeat_count_threshold)
 213         {
 214           struct value_print_options opts = *options;
 215           opts.deref_ref = 0;
 216           val_print (elttype, value_contents (v0), 0, 0, stream,
 217                      recurse + 1, &opts, current_language);
 218           annotate_elt_rep (i - i0);
 219           fprintf_filtered (stream, _(" <repeats %u times>"), i - i0);
 220           annotate_elt_rep_end ();
 221
 222         }
 223       else
 224         {
 225           int j;
 226           struct value_print_options opts = *options;
 227           opts.deref_ref = 0;
 228           for (j = i0; j < i; j += 1)
 229             {
 230               if (j > i0)
 231                 {
 232                   if (options->prettyprint_arrays)
 233                     {
 234                       fprintf_filtered (stream, ",\n");
 235                       print_spaces_filtered (2 + 2 * recurse, stream);
 236                     }
 237                   else
 238                     {
 239                       fprintf_filtered (stream, ", ");
 240                     }
 241                   wrap_here (n_spaces (2 + 2 * recurse));
 242                   maybe_print_array_index (index_type, j + low,
 243                                            stream, options);
 244                 }
 245               val_print (elttype, value_contents (v0), 0, 0, stream,
 246                          recurse + 1, &opts, current_language);
 247               annotate_elt ();
 248             }
 249         }
 250       things_printed += i - i0;
 251     }
 252   annotate_array_section_end ();
 253   if (i < len)
 254     {
 255       fprintf_filtered (stream, "...");
 256     }
 257
 258   value_free_to_mark (mark);
 259 }
 260
 261 static struct type *
 262 printable_val_type (struct type *type, const gdb_byte *valaddr)
 263 {
 264   return ada_to_fixed_type (ada_aligned_type (type), valaddr, 0, NULL, 1);
 265 }
 266
 267 /* Print the character C on STREAM as part of the contents of a literal
 268    string whose delimiter is QUOTER.  TYPE_LEN is the length in bytes
 269    (1 or 2) of the character.  */
 270
 271 void
 272 ada_emit_char (int c, struct type *type, struct ui_file *stream,
 273                int quoter, int type_len)
 274 {
 275   if (type_len != 2)
 276     type_len = 1;
 277
 278   c &= (1 << (type_len * TARGET_CHAR_BIT)) - 1;
 279
 280   if (isascii (c) && isprint (c))
 281     {
 282       if (c == quoter && c == '"')
 283         fprintf_filtered (stream, "\"\"");
 284       else
 285         fprintf_filtered (stream, "%c", c);
 286     }
 287   else
 288     fprintf_filtered (stream, "[\"%0*x\"]", type_len * 2, c);
 289 }
 290
 291 /* Character #I of STRING, given that TYPE_LEN is the size in bytes (1
 292    or 2) of a character.  */
 293
 294 static int
 295 char_at (const gdb_byte *string, int i, int type_len)
 296 {
 297   if (type_len == 1)
 298     return string[i];
 299   else
 300     return (int) extract_unsigned_integer (string + 2 * i, 2);
 301 }
 302
 303 /* Wrapper around memcpy to make it legal argument to ui_file_put */
 304 static void
 305 ui_memcpy (void *dest, const char *buffer, long len)
 306 {
 307   memcpy (dest, buffer, (size_t) len);
 308   ((char *) dest)[len] = '\0';
 309 }
 310
 311 /* Print a floating-point value of type TYPE, pointed to in GDB by
 312    VALADDR, on STREAM.  Use Ada formatting conventions: there must be
 313    a decimal point, and at least one digit before and after the
 314    point.  We use GNAT format for NaNs and infinities.  */
 315 static void
 316 ada_print_floating (const gdb_byte *valaddr, struct type *type,
 317                     struct ui_file *stream)
 318 {
 319   char buffer[64];
 320   char *s, *result;
 321   int len;
 322   struct ui_file *tmp_stream = mem_fileopen ();
 323   struct cleanup *cleanups = make_cleanup_ui_file_delete (tmp_stream);
 324
 325   print_floating (valaddr, type, tmp_stream);
 326   ui_file_put (tmp_stream, ui_memcpy, buffer);
 327   do_cleanups (cleanups);
 328
 329   result = buffer;
 330   len = strlen (result);
 331
 332   /* Modify for Ada rules.  */
 333
 334   s = strstr (result, "inf");
 335   if (s == NULL)
 336     s = strstr (result, "Inf");
 337   if (s == NULL)
 338     s = strstr (result, "INF");
 339   if (s != NULL)
 340     strcpy (s, "Inf");
 341
 342   if (s == NULL)
 343     {
 344       s = strstr (result, "nan");
 345       if (s == NULL)
 346         s = strstr (result, "NaN");
 347       if (s == NULL)
 348         s = strstr (result, "Nan");
 349       if (s != NULL)
 350         {
 351           s[0] = s[2] = 'N';
 352           if (result[0] == '-')
 353             result += 1;
 354         }
 355     }
 356
 357   if (s == NULL && strchr (result, '.') == NULL)
 358     {
 359       s = strchr (result, 'e');
 360       if (s == NULL)
 361         fprintf_filtered (stream, "%s.0", result);
 362       else
 363         fprintf_filtered (stream, "%.*s.0%s", (int) (s-result), result, s);
 364       return;
 365     }
 366   fprintf_filtered (stream, "%s", result);
 367 }
 368
 369 void
 370 ada_printchar (int c, struct type *type, struct ui_file *stream)
 371 {
 372   fputs_filtered ("'", stream);
 373   ada_emit_char (c, type, stream, '\'', 1);
 374   fputs_filtered ("'", stream);
 375 }
 376
 377 /* [From print_type_scalar in typeprint.c].   Print VAL on STREAM in a
 378    form appropriate for TYPE.  */
 379
 380 void
 381 ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
 382 {
 383   unsigned int i;
 384   unsigned len;
 385
 386   type = ada_check_typedef (type);
 387
 388   switch (TYPE_CODE (type))
 389     {
 390
 391     case TYPE_CODE_ENUM:
 392       len = TYPE_NFIELDS (type);
 393       for (i = 0; i < len; i++)
 394         {
 395           if (TYPE_FIELD_BITPOS (type, i) == val)
 396             {
 397               break;
 398             }
 399         }
 400       if (i < len)
 401         {
 402           fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 403         }
 404       else
 405         {
 406           print_longest (stream, 'd', 0, val);
 407         }
 408       break;
 409
 410     case TYPE_CODE_INT:
 411       print_longest (stream, TYPE_UNSIGNED (type) ? 'u' : 'd', 0, val);
 412       break;
 413
 414     case TYPE_CODE_CHAR:
 415       LA_PRINT_CHAR ((unsigned char) val, type, stream);
 416       break;
 417
 418     case TYPE_CODE_BOOL:
 419       fprintf_filtered (stream, val ? "true" : "false");
 420       break;
 421
 422     case TYPE_CODE_RANGE:
 423       ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
 424       return;
 425
 426     case TYPE_CODE_UNDEF:
 427     case TYPE_CODE_PTR:
 428     case TYPE_CODE_ARRAY:
 429     case TYPE_CODE_STRUCT:
 430     case TYPE_CODE_UNION:
 431     case TYPE_CODE_FUNC:
 432     case TYPE_CODE_FLT:
 433     case TYPE_CODE_VOID:
 434     case TYPE_CODE_SET:
 435     case TYPE_CODE_STRING:
 436     case TYPE_CODE_ERROR:
 437     case TYPE_CODE_MEMBERPTR:
 438     case TYPE_CODE_METHODPTR:
 439     case TYPE_CODE_METHOD:
 440     case TYPE_CODE_REF:
 441       warning (_("internal error: unhandled type in ada_print_scalar"));
 442       break;
 443
 444     default:
 445       error (_("Invalid type code in symbol table."));
 446     }
 447   gdb_flush (stream);
 448 }
 449
 450 /* Print the character string STRING, printing at most LENGTH characters.
 451    Printing stops early if the number hits print_max; repeat counts
 452    are printed as appropriate.  Print ellipses at the end if we
 453    had to stop before printing LENGTH characters, or if
 454    FORCE_ELLIPSES.   TYPE_LEN is the length (1 or 2) of the character type.
 455  */
 456
 457 static void
 458 printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
 459           unsigned int length, int force_ellipses, int type_len,
 460           const struct value_print_options *options)
 461 {
 462   unsigned int i;
 463   unsigned int things_printed = 0;
 464   int in_quotes = 0;
 465   int need_comma = 0;
 466
 467   if (length == 0)
 468     {
 469       fputs_filtered ("\"\"", stream);
 470       return;
 471     }
 472
 473   for (i = 0; i < length && things_printed < options->print_max; i += 1)
 474     {
 475       /* Position of the character we are examining
 476          to see whether it is repeated.  */
 477       unsigned int rep1;
 478       /* Number of repetitions we have detected so far.  */
 479       unsigned int reps;
 480
 481       QUIT;
 482
 483       if (need_comma)
 484         {
 485           fputs_filtered (", ", stream);
 486           need_comma = 0;
 487         }
 488
 489       rep1 = i + 1;
 490       reps = 1;
 491       while (rep1 < length
 492              && char_at (string, rep1, type_len) == char_at (string, i,
 493                                                              type_len))
 494         {
 495           rep1 += 1;
 496           reps += 1;
 497         }
 498
 499       if (reps > options->repeat_count_threshold)
 500         {
 501           if (in_quotes)
 502             {
 503               if (options->inspect_it)
 504                 fputs_filtered ("\\\", ", stream);
 505               else
 506                 fputs_filtered ("\", ", stream);
 507               in_quotes = 0;
 508             }
 509           fputs_filtered ("'", stream);
 510           ada_emit_char (char_at (string, i, type_len), elttype, stream, '\'',
 511                          type_len);
 512           fputs_filtered ("'", stream);
 513           fprintf_filtered (stream, _(" <repeats %u times>"), reps);
 514           i = rep1 - 1;
 515           things_printed += options->repeat_count_threshold;
 516           need_comma = 1;
 517         }
 518       else
 519         {
 520           if (!in_quotes)
 521             {
 522               if (options->inspect_it)
 523                 fputs_filtered ("\\\"", stream);
 524               else
 525                 fputs_filtered ("\"", stream);
 526               in_quotes = 1;
 527             }
 528           ada_emit_char (char_at (string, i, type_len), elttype, stream, '"',
 529                          type_len);
 530           things_printed += 1;
 531         }
 532     }
 533
 534   /* Terminate the quotes if necessary.  */
 535   if (in_quotes)
 536     {
 537       if (options->inspect_it)
 538         fputs_filtered ("\\\"", stream);
 539       else
 540         fputs_filtered ("\"", stream);
 541     }
 542
 543   if (force_ellipses || i < length)
 544     fputs_filtered ("...", stream);
 545 }
 546
 547 void
 548 ada_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
 549               unsigned int length, int force_ellipses,
 550               const struct value_print_options *options)
 551 {
 552   printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
 553             options);
 554 }
 555
 556
 557 /* Print data of type TYPE located at VALADDR (within GDB), which came from
 558    the inferior at address ADDRESS, onto stdio stream STREAM according to
 559    OPTIONS.  The data at VALADDR is in target byte order.
 560
 561    If the data is printed as a string, returns the number of string characters
 562    printed.
 563
 564    RECURSE indicates the amount of indentation to supply before
 565    continuation lines; this amount is roughly twice the value of RECURSE.  */
 566
 567 int
 568 ada_val_print (struct type *type, const gdb_byte *valaddr0,
 569                int embedded_offset, CORE_ADDR address,
 570                struct ui_file *stream, int recurse,
 571                const struct value_print_options *options)
 572 {
 573   struct ada_val_print_args args;
 574   args.type = type;
 575   args.valaddr0 = valaddr0;
 576   args.embedded_offset = embedded_offset;
 577   args.address = address;
 578   args.stream = stream;
 579   args.recurse = recurse;
 580   args.options = options;
 581
 582   return catch_errors (ada_val_print_stub, &args, NULL, RETURN_MASK_ALL);
 583 }
 584
 585 /* Helper for ada_val_print; used as argument to catch_errors to
 586    unmarshal the arguments to ada_val_print_1, which does the work.  */
 587 static int
 588 ada_val_print_stub (void *args0)
 589 {
 590   struct ada_val_print_args *argsp = (struct ada_val_print_args *) args0;
 591   return ada_val_print_1 (argsp->type, argsp->valaddr0,
 592                           argsp->embedded_offset, argsp->address,
 593                           argsp->stream, argsp->recurse, argsp->options);
 594 }
 595
 596 /* Assuming TYPE is a simple array, print the value of this array located
 597    at VALADDR.  See ada_val_print for a description of the various
 598    parameters of this function; they are identical.  The semantics
 599    of the return value is also identical to ada_val_print.  */
 600
 601 static int
 602 ada_val_print_array (struct type *type, const gdb_byte *valaddr,
 603                      CORE_ADDR address, struct ui_file *stream, int recurse,
 604                      const struct value_print_options *options)
 605 {
 606   struct type *elttype = TYPE_TARGET_TYPE (type);
 607   unsigned int eltlen;
 608   unsigned int len;
 609   int result = 0;
 610
 611   if (elttype == NULL)
 612     eltlen = 0;
 613   else
 614     eltlen = TYPE_LENGTH (elttype);
 615   if (eltlen == 0)
 616     len = 0;
 617   else
 618     len = TYPE_LENGTH (type) / eltlen;
 619
 620   /* For an array of chars, print with string syntax.  */
 621   if (ada_is_string_type (type)
 622       && (options->format == 0 || options->format == 's'))
 623     {
 624       if (options->prettyprint_arrays)
 625         print_spaces_filtered (2 + 2 * recurse, stream);
 626
 627       /* If requested, look for the first null char and only print
 628          elements up to it.  */
 629       if (options->stop_print_at_null)
 630         {
 631           int temp_len;
 632
 633           /* Look for a NULL char.  */
 634           for (temp_len = 0;
 635                (temp_len < len
 636                 && temp_len < options->print_max
 637                 && char_at (valaddr, temp_len, eltlen) != 0);
 638                temp_len += 1);
 639           len = temp_len;
 640         }
 641
 642       printstr (stream, elttype, valaddr, len, 0, eltlen, options);
 643       result = len;
 644     }
 645   else
 646     {
 647       fprintf_filtered (stream, "(");
 648       print_optional_low_bound (stream, type, options);
 649       if (TYPE_FIELD_BITSIZE (type, 0) > 0)
 650         val_print_packed_array_elements (type, valaddr, 0, stream,
 651                                          recurse, options);
 652       else
 653         val_print_array_elements (type, valaddr, address, stream,
 654                                   recurse, options, 0);
 655       fprintf_filtered (stream, ")");
 656     }
 657
 658   return result;
 659 }
 660
 661 /* See the comment on ada_val_print.  This function differs in that it
 662    does not catch evaluation errors (leaving that to ada_val_print).  */
 663
 664 static int
 665 ada_val_print_1 (struct type *type, const gdb_byte *valaddr0,
 666                  int embedded_offset, CORE_ADDR address,
 667                  struct ui_file *stream, int recurse,
 668                  const struct value_print_options *options)
 669 {
 670   unsigned int len;
 671   int i;
 672   struct type *elttype;
 673   unsigned int eltlen;
 674   LONGEST val;
 675   const gdb_byte *valaddr = valaddr0 + embedded_offset;
 676
 677   type = ada_check_typedef (type);
 678
 679   if (ada_is_array_descriptor_type (type) || ada_is_packed_array_type (type))
 680     {
 681       int retn;
 682       struct value *mark = value_mark ();
 683       struct value *val;
 684       val = value_from_contents_and_address (type, valaddr, address);
 685       val = ada_coerce_to_simple_array_ptr (val);
 686       if (val == NULL)
 687         {
 688           fprintf_filtered (stream, "(null)");
 689           retn = 0;
 690         }
 691       else
 692         retn = ada_val_print_1 (value_type (val), value_contents (val), 0,
 693                                 value_address (val), stream, recurse, options);
 694       value_free_to_mark (mark);
 695       return retn;
 696     }
 697
 698   valaddr = ada_aligned_value_addr (type, valaddr);
 699   embedded_offset -= valaddr - valaddr0 - embedded_offset;
 700   type = printable_val_type (type, valaddr);
 701
 702   switch (TYPE_CODE (type))
 703     {
 704     default:
 705       return c_val_print (type, valaddr0, embedded_offset, address, stream,
 706                           recurse, options);
 707
 708     case TYPE_CODE_PTR:
 709       {
 710         int ret = c_val_print (type, valaddr0, embedded_offset, address,
 711                                stream, recurse, options);
 712         if (ada_is_tag_type (type))
 713           {
 714             struct value *val =
 715               value_from_contents_and_address (type, valaddr, address);
 716             const char *name = ada_tag_name (val);
 717             if (name != NULL)
 718               fprintf_filtered (stream, " (%s)", name);
 719             return 0;
 720         }
 721         return ret;
 722       }
 723
 724     case TYPE_CODE_INT:
 725     case TYPE_CODE_RANGE:
 726       if (ada_is_fixed_point_type (type))
 727         {
 728           LONGEST v = unpack_long (type, valaddr);
 729           int len = TYPE_LENGTH (type);
 730
 731           fprintf_filtered (stream, len < 4 ? "%.11g" : "%.17g",
 732                             (double) ada_fixed_to_float (type, v));
 733           return 0;
 734         }
 735       else if (ada_is_vax_floating_type (type))
 736         {
 737           struct value *val =
 738             value_from_contents_and_address (type, valaddr, address);
 739           struct value *func = ada_vax_float_print_function (type);
 740           if (func != 0)
 741             {
 742               CORE_ADDR addr;
 743               addr = value_as_address (call_function_by_hand (func, 1, &val));
 744               val_print_string (builtin_type_true_char,
 745                                 addr, -1, stream, options);
 746               return 0;
 747             }
 748           /* No special printing function.  Do as best we can.  */
 749         }
 750       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
 751         {
 752           struct type *target_type = TYPE_TARGET_TYPE (type);
 753           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
 754             {
 755               /* Obscure case of range type that has different length from
 756                  its base type.  Perform a conversion, or we will get a
 757                  nonsense value.  Actually, we could use the same
 758                  code regardless of lengths; I'm just avoiding a cast.  */
 759               struct value *v = value_cast (target_type,
 760                                             value_from_contents_and_address
 761                                             (type, valaddr, 0));
 762               return ada_val_print_1 (target_type, value_contents (v), 0, 0,
 763                                       stream, recurse + 1, options);
 764             }
 765           else
 766             return ada_val_print_1 (TYPE_TARGET_TYPE (type),
 767                                     valaddr0, embedded_offset,
 768                                     address, stream, recurse, options);
 769         }
 770       else
 771         {
 772           int format = (options->format ? options->format
 773                         : options->output_format);
 774           if (format)
 775             {
 776               struct value_print_options opts = *options;
 777               opts.format = format;
 778               print_scalar_formatted (valaddr, type, &opts, 0, stream);
 779             }
 780           else if (ada_is_system_address_type (type)
 781                    && TYPE_OBJFILE (type) != NULL)
 782             {
 783               /* FIXME: We want to print System.Address variables using
 784                  the same format as for any access type.  But for some
 785                  reason GNAT encodes the System.Address type as an int,
 786                  so we have to work-around this deficiency by handling
 787                  System.Address values as a special case.
 788
 789                  We do this only for System.Address types defined in an
 790                  objfile.  For the built-in version of System.Address we
 791                  have installed the proper type to begin with.  */
 792
 793               struct gdbarch *gdbarch = get_objfile_arch (TYPE_OBJFILE (type));
 794               struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
 795
 796               fprintf_filtered (stream, "(");
 797               type_print (type, "", stream, -1);
 798               fprintf_filtered (stream, ") ");
 799               fputs_filtered (paddress (extract_typed_address
 800                                         (valaddr, ptr_type)),
 801                               stream);
 802             }
 803           else
 804             {
 805               val_print_type_code_int (type, valaddr, stream);
 806               if (ada_is_character_type (type))
 807                 {
 808                   fputs_filtered (" ", stream);
 809                   ada_printchar ((unsigned char) unpack_long (type, valaddr),
 810                                  type, stream);
 811                 }
 812             }
 813           return 0;
 814         }
 815
 816     case TYPE_CODE_ENUM:
 817       if (options->format)
 818         {
 819           print_scalar_formatted (valaddr, type, options, 0, stream);
 820           break;
 821         }
 822       len = TYPE_NFIELDS (type);
 823       val = unpack_long (type, valaddr);
 824       for (i = 0; i < len; i++)
 825         {
 826           QUIT;
 827           if (val == TYPE_FIELD_BITPOS (type, i))
 828             {
 829               break;
 830             }
 831         }
 832       if (i < len)
 833         {
 834           const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
 835           if (name[0] == '\'')
 836             fprintf_filtered (stream, "%ld %s", (long) val, name);
 837           else
 838             fputs_filtered (name, stream);
 839         }
 840       else
 841         {
 842           print_longest (stream, 'd', 0, val);
 843         }
 844       break;
 845
 846     case TYPE_CODE_FLAGS:
 847       if (options->format)
 848         print_scalar_formatted (valaddr, type, options, 0, stream);
 849       else
 850         val_print_type_code_flags (type, valaddr, stream);
 851       break;
 852
 853     case TYPE_CODE_FLT:
 854       if (options->format)
 855         return c_val_print (type, valaddr0, embedded_offset, address, stream,
 856                             recurse, options);
 857       else
 858         ada_print_floating (valaddr0 + embedded_offset, type, stream);
 859       break;
 860
 861     case TYPE_CODE_UNION:
 862     case TYPE_CODE_STRUCT:
 863       if (ada_is_bogus_array_descriptor (type))
 864         {
 865           fprintf_filtered (stream, "(...?)");
 866           return 0;
 867         }
 868       else
 869         {
 870           print_record (type, valaddr, stream, recurse, options);
 871           return 0;
 872         }
 873
 874     case TYPE_CODE_ARRAY:
 875       return ada_val_print_array (type, valaddr, address, stream,
 876                                   recurse, options);
 877
 878     case TYPE_CODE_REF:
 879       /* For references, the debugger is expected to print the value as
 880          an address if DEREF_REF is null.  But printing an address in place
 881          of the object value would be confusing to an Ada programmer.
 882          So, for Ada values, we print the actual dereferenced value
 883          regardless.  */
 884       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 885
 886       if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 887         {
 888           LONGEST deref_val_int = (LONGEST) unpack_pointer (type, valaddr);
 889           if (deref_val_int != 0)
 890             {
 891               struct value *deref_val =
 892                 ada_value_ind (value_from_longest
 893                                (lookup_pointer_type (elttype),
 894                                 deref_val_int));
 895               val_print (value_type (deref_val),
 896                          value_contents (deref_val), 0,
 897                          value_address (deref_val), stream, recurse + 1,
 898                          options, current_language);
 899             }
 900           else
 901             fputs_filtered ("(null)", stream);
 902         }
 903       else
 904         fputs_filtered ("???", stream);
 905
 906       break;
 907     }
 908   gdb_flush (stream);
 909   return 0;
 910 }
 911
 912 static int
 913 print_variant_part (struct type *type, int field_num, const gdb_byte *valaddr,
 914                     struct ui_file *stream, int recurse,
 915                     const struct value_print_options *options, int comma_needed,
 916                     struct type *outer_type, const gdb_byte *outer_valaddr)
 917 {
 918   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
 919   int which = ada_which_variant_applies (var_type, outer_type, outer_valaddr);
 920
 921   if (which < 0)
 922     return 0;
 923   else
 924     return print_field_values
 925       (TYPE_FIELD_TYPE (var_type, which),
 926        valaddr + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
 927        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
 928        stream, recurse, options,
 929        comma_needed, outer_type, outer_valaddr);
 930 }
 931
 932 int
 933 ada_value_print (struct value *val0, struct ui_file *stream,
 934                  const struct value_print_options *options)
 935 {
 936   const gdb_byte *valaddr = value_contents (val0);
 937   CORE_ADDR address = value_address (val0);
 938   struct type *type =
 939     ada_to_fixed_type (value_type (val0), valaddr, address, NULL, 1);
 940   struct value *val =
 941     value_from_contents_and_address (type, valaddr, address);
 942   struct value_print_options opts;
 943
 944   /* If it is a pointer, indicate what it points to.  */
 945   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 946     {
 947       /* Hack:  don't print (char *) for char strings.  Their
 948          type is indicated by the quoted string anyway.  */
 949       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
 950           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT
 951           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
 952         {
 953           fprintf_filtered (stream, "(");
 954           type_print (type, "", stream, -1);
 955           fprintf_filtered (stream, ") ");
 956         }
 957     }
 958   else if (ada_is_array_descriptor_type (type))
 959     {
 960       fprintf_filtered (stream, "(");
 961       type_print (type, "", stream, -1);
 962       fprintf_filtered (stream, ") ");
 963     }
 964   else if (ada_is_bogus_array_descriptor (type))
 965     {
 966       fprintf_filtered (stream, "(");
 967       type_print (type, "", stream, -1);
 968       fprintf_filtered (stream, ") (...?)");
 969       return 0;
 970     }
 971
 972   opts = *options;
 973   opts.deref_ref = 1;
 974   return (val_print (type, value_contents (val), 0, address,
 975                      stream, 0, &opts, current_language));
 976 }
 977
 978 static void
 979 print_record (struct type *type, const gdb_byte *valaddr,
 980               struct ui_file *stream, int recurse,
 981               const struct value_print_options *options)
 982 {
 983   type = ada_check_typedef (type);
 984
 985   fprintf_filtered (stream, "(");
 986
 987   if (print_field_values (type, valaddr, stream, recurse, options,
 988                           0, type, valaddr) != 0 && options->pretty)
 989     {
 990       fprintf_filtered (stream, "\n");
 991       print_spaces_filtered (2 * recurse, stream);
 992     }
 993
 994   fprintf_filtered (stream, ")");
 995 }
 996
 997 /* Print out fields of value at VALADDR having structure type TYPE.
 998
 999    TYPE, VALADDR, STREAM, RECURSE, and OPTIONS have the
1000    same meanings as in ada_print_value and ada_val_print.
1001
1002    OUTER_TYPE and OUTER_VALADDR give type and address of enclosing record
1003    (used to get discriminant values when printing variant parts).
1004
1005    COMMA_NEEDED is 1 if fields have been printed at the current recursion
1006    level, so that a comma is needed before any field printed by this
1007    call.
1008
1009    Returns 1 if COMMA_NEEDED or any fields were printed.  */
1010
1011 static int
1012 print_field_values (struct type *type, const gdb_byte *valaddr,
1013                     struct ui_file *stream, int recurse,
1014                     const struct value_print_options *options,
1015                     int comma_needed,
1016                     struct type *outer_type, const gdb_byte *outer_valaddr)
1017 {
1018   int i, len;
1019
1020   len = TYPE_NFIELDS (type);
1021
1022   for (i = 0; i < len; i += 1)
1023     {
1024       if (ada_is_ignored_field (type, i))
1025         continue;
1026
1027       if (ada_is_wrapper_field (type, i))
1028         {
1029           comma_needed =
1030             print_field_values (TYPE_FIELD_TYPE (type, i),
1031                                 valaddr
1032                                 + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1033                                 stream, recurse, options,
1034                                 comma_needed, type, valaddr);
1035           continue;
1036         }
1037       else if (ada_is_variant_part (type, i))
1038         {
1039           comma_needed =
1040             print_variant_part (type, i, valaddr,
1041                                 stream, recurse, options, comma_needed,
1042                                 outer_type, outer_valaddr);
1043           continue;
1044         }
1045
1046       if (comma_needed)
1047         fprintf_filtered (stream, ", ");
1048       comma_needed = 1;
1049
1050       if (options->pretty)
1051         {
1052           fprintf_filtered (stream, "\n");
1053           print_spaces_filtered (2 + 2 * recurse, stream);
1054         }
1055       else
1056         {
1057           wrap_here (n_spaces (2 + 2 * recurse));
1058         }
1059       if (options->inspect_it)
1060         {
1061           if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
1062             fputs_filtered ("\"( ptr \"", stream);
1063           else
1064             fputs_filtered ("\"( nodef \"", stream);
1065           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1066                                    language_cplus, DMGL_NO_OPTS);
1067           fputs_filtered ("\" \"", stream);
1068           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1069                                    language_cplus, DMGL_NO_OPTS);
1070           fputs_filtered ("\") \"", stream);
1071         }
1072       else
1073         {
1074           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1075           fprintf_filtered (stream, "%.*s",
1076                             ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1077                             TYPE_FIELD_NAME (type, i));
1078           annotate_field_name_end ();
1079           fputs_filtered (" => ", stream);
1080           annotate_field_value ();
1081         }
1082
1083       if (TYPE_FIELD_PACKED (type, i))
1084         {
1085           struct value *v;
1086
1087           /* Bitfields require special handling, especially due to byte
1088              order problems.  */
1089           if (TYPE_CPLUS_SPECIFIC (type) != NULL
1090               && TYPE_FIELD_IGNORE (type, i))
1091             {
1092               fputs_filtered (_("<optimized out or zero length>"), stream);
1093             }
1094           else
1095             {
1096               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1097               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1098               struct value_print_options opts;
1099
1100               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1101               v = ada_value_primitive_packed_val (NULL, valaddr,
1102                                                   bit_pos / HOST_CHAR_BIT,
1103                                                   bit_pos % HOST_CHAR_BIT,
1104                                                   bit_size,
1105                                                   TYPE_FIELD_TYPE (type, i));
1106               opts = *options;
1107               opts.deref_ref = 0;
1108               val_print (TYPE_FIELD_TYPE (type, i), value_contents (v), 0, 0,
1109                          stream, recurse + 1, &opts, current_language);
1110             }
1111         }
1112       else
1113         {
1114           struct value_print_options opts = *options;
1115           opts.deref_ref = 0;
1116           ada_val_print (TYPE_FIELD_TYPE (type, i),
1117                          valaddr + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1118                          0, 0, stream, recurse + 1, &opts);
1119         }
1120       annotate_field_end ();
1121     }
1122
1123   return comma_needed;
1124 }