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 = NULL;
 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, if non-NULL.  If TYPE is NULL, print VAL
 379    like a default signed integer.  */
 380
 381 void
 382 ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
 383 {
 384   unsigned int i;
 385   unsigned len;
 386
 387   if (!type)
 388     {
 389       print_longest (stream, 'd', 0, val);
 390       return;
 391     }
 392
 393   type = ada_check_typedef (type);
 394
 395   switch (TYPE_CODE (type))
 396     {
 397
 398     case TYPE_CODE_ENUM:
 399       len = TYPE_NFIELDS (type);
 400       for (i = 0; i < len; i++)
 401         {
 402           if (TYPE_FIELD_BITPOS (type, i) == val)
 403             {
 404               break;
 405             }
 406         }
 407       if (i < len)
 408         {
 409           fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 410         }
 411       else
 412         {
 413           print_longest (stream, 'd', 0, val);
 414         }
 415       break;
 416
 417     case TYPE_CODE_INT:
 418       print_longest (stream, TYPE_UNSIGNED (type) ? 'u' : 'd', 0, val);
 419       break;
 420
 421     case TYPE_CODE_CHAR:
 422       LA_PRINT_CHAR ((unsigned char) val, type, stream);
 423       break;
 424
 425     case TYPE_CODE_BOOL:
 426       fprintf_filtered (stream, val ? "true" : "false");
 427       break;
 428
 429     case TYPE_CODE_RANGE:
 430       ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
 431       return;
 432
 433     case TYPE_CODE_UNDEF:
 434     case TYPE_CODE_PTR:
 435     case TYPE_CODE_ARRAY:
 436     case TYPE_CODE_STRUCT:
 437     case TYPE_CODE_UNION:
 438     case TYPE_CODE_FUNC:
 439     case TYPE_CODE_FLT:
 440     case TYPE_CODE_VOID:
 441     case TYPE_CODE_SET:
 442     case TYPE_CODE_STRING:
 443     case TYPE_CODE_ERROR:
 444     case TYPE_CODE_MEMBERPTR:
 445     case TYPE_CODE_METHODPTR:
 446     case TYPE_CODE_METHOD:
 447     case TYPE_CODE_REF:
 448       warning (_("internal error: unhandled type in ada_print_scalar"));
 449       break;
 450
 451     default:
 452       error (_("Invalid type code in symbol table."));
 453     }
 454   gdb_flush (stream);
 455 }
 456
 457 /* Print the character string STRING, printing at most LENGTH characters.
 458    Printing stops early if the number hits print_max; repeat counts
 459    are printed as appropriate.  Print ellipses at the end if we
 460    had to stop before printing LENGTH characters, or if
 461    FORCE_ELLIPSES.   TYPE_LEN is the length (1 or 2) of the character type.
 462  */
 463
 464 static void
 465 printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
 466           unsigned int length, int force_ellipses, int type_len,
 467           const struct value_print_options *options)
 468 {
 469   unsigned int i;
 470   unsigned int things_printed = 0;
 471   int in_quotes = 0;
 472   int need_comma = 0;
 473
 474   if (length == 0)
 475     {
 476       fputs_filtered ("\"\"", stream);
 477       return;
 478     }
 479
 480   for (i = 0; i < length && things_printed < options->print_max; i += 1)
 481     {
 482       /* Position of the character we are examining
 483          to see whether it is repeated.  */
 484       unsigned int rep1;
 485       /* Number of repetitions we have detected so far.  */
 486       unsigned int reps;
 487
 488       QUIT;
 489
 490       if (need_comma)
 491         {
 492           fputs_filtered (", ", stream);
 493           need_comma = 0;
 494         }
 495
 496       rep1 = i + 1;
 497       reps = 1;
 498       while (rep1 < length
 499              && char_at (string, rep1, type_len) == char_at (string, i,
 500                                                              type_len))
 501         {
 502           rep1 += 1;
 503           reps += 1;
 504         }
 505
 506       if (reps > options->repeat_count_threshold)
 507         {
 508           if (in_quotes)
 509             {
 510               if (options->inspect_it)
 511                 fputs_filtered ("\\\", ", stream);
 512               else
 513                 fputs_filtered ("\", ", stream);
 514               in_quotes = 0;
 515             }
 516           fputs_filtered ("'", stream);
 517           ada_emit_char (char_at (string, i, type_len), elttype, stream, '\'',
 518                          type_len);
 519           fputs_filtered ("'", stream);
 520           fprintf_filtered (stream, _(" <repeats %u times>"), reps);
 521           i = rep1 - 1;
 522           things_printed += options->repeat_count_threshold;
 523           need_comma = 1;
 524         }
 525       else
 526         {
 527           if (!in_quotes)
 528             {
 529               if (options->inspect_it)
 530                 fputs_filtered ("\\\"", stream);
 531               else
 532                 fputs_filtered ("\"", stream);
 533               in_quotes = 1;
 534             }
 535           ada_emit_char (char_at (string, i, type_len), elttype, stream, '"',
 536                          type_len);
 537           things_printed += 1;
 538         }
 539     }
 540
 541   /* Terminate the quotes if necessary.  */
 542   if (in_quotes)
 543     {
 544       if (options->inspect_it)
 545         fputs_filtered ("\\\"", stream);
 546       else
 547         fputs_filtered ("\"", stream);
 548     }
 549
 550   if (force_ellipses || i < length)
 551     fputs_filtered ("...", stream);
 552 }
 553
 554 void
 555 ada_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
 556               unsigned int length, int force_ellipses,
 557               const struct value_print_options *options)
 558 {
 559   printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
 560             options);
 561 }
 562
 563
 564 /* Print data of type TYPE located at VALADDR (within GDB), which came from
 565    the inferior at address ADDRESS, onto stdio stream STREAM according to
 566    OPTIONS.  The data at VALADDR is in target byte order.
 567
 568    If the data is printed as a string, returns the number of string characters
 569    printed.
 570
 571    RECURSE indicates the amount of indentation to supply before
 572    continuation lines; this amount is roughly twice the value of RECURSE.  */
 573
 574 int
 575 ada_val_print (struct type *type, const gdb_byte *valaddr0,
 576                int embedded_offset, CORE_ADDR address,
 577                struct ui_file *stream, int recurse,
 578                const struct value_print_options *options)
 579 {
 580   struct ada_val_print_args args;
 581   args.type = type;
 582   args.valaddr0 = valaddr0;
 583   args.embedded_offset = embedded_offset;
 584   args.address = address;
 585   args.stream = stream;
 586   args.recurse = recurse;
 587   args.options = options;
 588
 589   return catch_errors (ada_val_print_stub, &args, NULL, RETURN_MASK_ALL);
 590 }
 591
 592 /* Helper for ada_val_print; used as argument to catch_errors to
 593    unmarshal the arguments to ada_val_print_1, which does the work.  */
 594 static int
 595 ada_val_print_stub (void *args0)
 596 {
 597   struct ada_val_print_args *argsp = (struct ada_val_print_args *) args0;
 598   return ada_val_print_1 (argsp->type, argsp->valaddr0,
 599                           argsp->embedded_offset, argsp->address,
 600                           argsp->stream, argsp->recurse, argsp->options);
 601 }
 602
 603 /* Assuming TYPE is a simple array, print the value of this array located
 604    at VALADDR.  See ada_val_print for a description of the various
 605    parameters of this function; they are identical.  The semantics
 606    of the return value is also identical to ada_val_print.  */
 607
 608 static int
 609 ada_val_print_array (struct type *type, const gdb_byte *valaddr,
 610                      CORE_ADDR address, struct ui_file *stream, int recurse,
 611                      const struct value_print_options *options)
 612 {
 613   struct type *elttype = TYPE_TARGET_TYPE (type);
 614   unsigned int eltlen;
 615   unsigned int len;
 616   int result = 0;
 617
 618   if (elttype == NULL)
 619     eltlen = 0;
 620   else
 621     eltlen = TYPE_LENGTH (elttype);
 622   if (eltlen == 0)
 623     len = 0;
 624   else
 625     len = TYPE_LENGTH (type) / eltlen;
 626
 627   /* For an array of chars, print with string syntax.  */
 628   if (ada_is_string_type (type)
 629       && (options->format == 0 || options->format == 's'))
 630     {
 631       if (options->prettyprint_arrays)
 632         print_spaces_filtered (2 + 2 * recurse, stream);
 633
 634       /* If requested, look for the first null char and only print
 635          elements up to it.  */
 636       if (options->stop_print_at_null)
 637         {
 638           int temp_len;
 639
 640           /* Look for a NULL char.  */
 641           for (temp_len = 0;
 642                (temp_len < len
 643                 && temp_len < options->print_max
 644                 && char_at (valaddr, temp_len, eltlen) != 0);
 645                temp_len += 1);
 646           len = temp_len;
 647         }
 648
 649       printstr (stream, elttype, valaddr, len, 0, eltlen, options);
 650       result = len;
 651     }
 652   else
 653     {
 654       fprintf_filtered (stream, "(");
 655       print_optional_low_bound (stream, type, options);
 656       if (TYPE_FIELD_BITSIZE (type, 0) > 0)
 657         val_print_packed_array_elements (type, valaddr, 0, stream,
 658                                          recurse, options);
 659       else
 660         val_print_array_elements (type, valaddr, address, stream,
 661                                   recurse, options, 0);
 662       fprintf_filtered (stream, ")");
 663     }
 664
 665   return result;
 666 }
 667
 668 /* See the comment on ada_val_print.  This function differs in that it
 669    does not catch evaluation errors (leaving that to ada_val_print).  */
 670
 671 static int
 672 ada_val_print_1 (struct type *type, const gdb_byte *valaddr0,
 673                  int embedded_offset, CORE_ADDR address,
 674                  struct ui_file *stream, int recurse,
 675                  const struct value_print_options *options)
 676 {
 677   unsigned int len;
 678   int i;
 679   struct type *elttype;
 680   unsigned int eltlen;
 681   LONGEST val;
 682   const gdb_byte *valaddr = valaddr0 + embedded_offset;
 683
 684   type = ada_check_typedef (type);
 685
 686   if (ada_is_array_descriptor_type (type) || ada_is_packed_array_type (type))
 687     {
 688       int retn;
 689       struct value *mark = value_mark ();
 690       struct value *val;
 691       val = value_from_contents_and_address (type, valaddr, address);
 692       val = ada_coerce_to_simple_array_ptr (val);
 693       if (val == NULL)
 694         {
 695           fprintf_filtered (stream, "(null)");
 696           retn = 0;
 697         }
 698       else
 699         retn = ada_val_print_1 (value_type (val), value_contents (val), 0,
 700                                 value_address (val), stream, recurse, options);
 701       value_free_to_mark (mark);
 702       return retn;
 703     }
 704
 705   valaddr = ada_aligned_value_addr (type, valaddr);
 706   embedded_offset -= valaddr - valaddr0 - embedded_offset;
 707   type = printable_val_type (type, valaddr);
 708
 709   switch (TYPE_CODE (type))
 710     {
 711     default:
 712       return c_val_print (type, valaddr0, embedded_offset, address, stream,
 713                           recurse, options);
 714
 715     case TYPE_CODE_PTR:
 716       {
 717         int ret = c_val_print (type, valaddr0, embedded_offset, address,
 718                                stream, recurse, options);
 719         if (ada_is_tag_type (type))
 720           {
 721             struct value *val =
 722               value_from_contents_and_address (type, valaddr, address);
 723             const char *name = ada_tag_name (val);
 724             if (name != NULL)
 725               fprintf_filtered (stream, " (%s)", name);
 726             return 0;
 727         }
 728         return ret;
 729       }
 730
 731     case TYPE_CODE_INT:
 732     case TYPE_CODE_RANGE:
 733       if (ada_is_fixed_point_type (type))
 734         {
 735           LONGEST v = unpack_long (type, valaddr);
 736           int len = TYPE_LENGTH (type);
 737
 738           fprintf_filtered (stream, len < 4 ? "%.11g" : "%.17g",
 739                             (double) ada_fixed_to_float (type, v));
 740           return 0;
 741         }
 742       else if (ada_is_vax_floating_type (type))
 743         {
 744           struct value *val =
 745             value_from_contents_and_address (type, valaddr, address);
 746           struct value *func = ada_vax_float_print_function (type);
 747           if (func != 0)
 748             {
 749               struct gdbarch *gdbarch = get_type_arch (type);
 750               CORE_ADDR addr;
 751               addr = value_as_address (call_function_by_hand (func, 1, &val));
 752               val_print_string (builtin_type (gdbarch)->builtin_true_char,
 753                                 addr, -1, stream, options);
 754               return 0;
 755             }
 756           /* No special printing function.  Do as best we can.  */
 757         }
 758       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
 759         {
 760           struct type *target_type = TYPE_TARGET_TYPE (type);
 761           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
 762             {
 763               /* Obscure case of range type that has different length from
 764                  its base type.  Perform a conversion, or we will get a
 765                  nonsense value.  Actually, we could use the same
 766                  code regardless of lengths; I'm just avoiding a cast.  */
 767               struct value *v = value_cast (target_type,
 768                                             value_from_contents_and_address
 769                                             (type, valaddr, 0));
 770               return ada_val_print_1 (target_type, value_contents (v), 0, 0,
 771                                       stream, recurse + 1, options);
 772             }
 773           else
 774             return ada_val_print_1 (TYPE_TARGET_TYPE (type),
 775                                     valaddr0, embedded_offset,
 776                                     address, stream, recurse, options);
 777         }
 778       else
 779         {
 780           int format = (options->format ? options->format
 781                         : options->output_format);
 782           if (format)
 783             {
 784               struct value_print_options opts = *options;
 785               opts.format = format;
 786               print_scalar_formatted (valaddr, type, &opts, 0, stream);
 787             }
 788           else if (ada_is_system_address_type (type))
 789             {
 790               /* FIXME: We want to print System.Address variables using
 791                  the same format as for any access type.  But for some
 792                  reason GNAT encodes the System.Address type as an int,
 793                  so we have to work-around this deficiency by handling
 794                  System.Address values as a special case.  */
 795
 796               struct gdbarch *gdbarch = get_type_arch (type);
 797               struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
 798
 799               fprintf_filtered (stream, "(");
 800               type_print (type, "", stream, -1);
 801               fprintf_filtered (stream, ") ");
 802               fputs_filtered (paddress (extract_typed_address
 803                                         (valaddr, ptr_type)),
 804                               stream);
 805             }
 806           else
 807             {
 808               val_print_type_code_int (type, valaddr, stream);
 809               if (ada_is_character_type (type))
 810                 {
 811                   fputs_filtered (" ", stream);
 812                   ada_printchar ((unsigned char) unpack_long (type, valaddr),
 813                                  type, stream);
 814                 }
 815             }
 816           return 0;
 817         }
 818
 819     case TYPE_CODE_ENUM:
 820       if (options->format)
 821         {
 822           print_scalar_formatted (valaddr, type, options, 0, stream);
 823           break;
 824         }
 825       len = TYPE_NFIELDS (type);
 826       val = unpack_long (type, valaddr);
 827       for (i = 0; i < len; i++)
 828         {
 829           QUIT;
 830           if (val == TYPE_FIELD_BITPOS (type, i))
 831             {
 832               break;
 833             }
 834         }
 835       if (i < len)
 836         {
 837           const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
 838           if (name[0] == '\'')
 839             fprintf_filtered (stream, "%ld %s", (long) val, name);
 840           else
 841             fputs_filtered (name, stream);
 842         }
 843       else
 844         {
 845           print_longest (stream, 'd', 0, val);
 846         }
 847       break;
 848
 849     case TYPE_CODE_FLAGS:
 850       if (options->format)
 851         print_scalar_formatted (valaddr, type, options, 0, stream);
 852       else
 853         val_print_type_code_flags (type, valaddr, stream);
 854       break;
 855
 856     case TYPE_CODE_FLT:
 857       if (options->format)
 858         return c_val_print (type, valaddr0, embedded_offset, address, stream,
 859                             recurse, options);
 860       else
 861         ada_print_floating (valaddr0 + embedded_offset, type, stream);
 862       break;
 863
 864     case TYPE_CODE_UNION:
 865     case TYPE_CODE_STRUCT:
 866       if (ada_is_bogus_array_descriptor (type))
 867         {
 868           fprintf_filtered (stream, "(...?)");
 869           return 0;
 870         }
 871       else
 872         {
 873           print_record (type, valaddr, stream, recurse, options);
 874           return 0;
 875         }
 876
 877     case TYPE_CODE_ARRAY:
 878       return ada_val_print_array (type, valaddr, address, stream,
 879                                   recurse, options);
 880
 881     case TYPE_CODE_REF:
 882       /* For references, the debugger is expected to print the value as
 883          an address if DEREF_REF is null.  But printing an address in place
 884          of the object value would be confusing to an Ada programmer.
 885          So, for Ada values, we print the actual dereferenced value
 886          regardless.  */
 887       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 888
 889       if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 890         {
 891           LONGEST deref_val_int = (LONGEST) unpack_pointer (type, valaddr);
 892           if (deref_val_int != 0)
 893             {
 894               struct value *deref_val =
 895                 ada_value_ind (value_from_longest
 896                                (lookup_pointer_type (elttype),
 897                                 deref_val_int));
 898               val_print (value_type (deref_val),
 899                          value_contents (deref_val), 0,
 900                          value_address (deref_val), stream, recurse + 1,
 901                          options, current_language);
 902             }
 903           else
 904             fputs_filtered ("(null)", stream);
 905         }
 906       else
 907         fputs_filtered ("???", stream);
 908
 909       break;
 910     }
 911   gdb_flush (stream);
 912   return 0;
 913 }
 914
 915 static int
 916 print_variant_part (struct type *type, int field_num, const gdb_byte *valaddr,
 917                     struct ui_file *stream, int recurse,
 918                     const struct value_print_options *options, int comma_needed,
 919                     struct type *outer_type, const gdb_byte *outer_valaddr)
 920 {
 921   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
 922   int which = ada_which_variant_applies (var_type, outer_type, outer_valaddr);
 923
 924   if (which < 0)
 925     return 0;
 926   else
 927     return print_field_values
 928       (TYPE_FIELD_TYPE (var_type, which),
 929        valaddr + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
 930        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
 931        stream, recurse, options,
 932        comma_needed, outer_type, outer_valaddr);
 933 }
 934
 935 int
 936 ada_value_print (struct value *val0, struct ui_file *stream,
 937                  const struct value_print_options *options)
 938 {
 939   const gdb_byte *valaddr = value_contents (val0);
 940   CORE_ADDR address = value_address (val0);
 941   struct type *type =
 942     ada_to_fixed_type (value_type (val0), valaddr, address, NULL, 1);
 943   struct value *val =
 944     value_from_contents_and_address (type, valaddr, address);
 945   struct value_print_options opts;
 946
 947   /* If it is a pointer, indicate what it points to.  */
 948   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 949     {
 950       /* Hack:  don't print (char *) for char strings.  Their
 951          type is indicated by the quoted string anyway.  */
 952       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
 953           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT
 954           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
 955         {
 956           fprintf_filtered (stream, "(");
 957           type_print (type, "", stream, -1);
 958           fprintf_filtered (stream, ") ");
 959         }
 960     }
 961   else if (ada_is_array_descriptor_type (type))
 962     {
 963       fprintf_filtered (stream, "(");
 964       type_print (type, "", stream, -1);
 965       fprintf_filtered (stream, ") ");
 966     }
 967   else if (ada_is_bogus_array_descriptor (type))
 968     {
 969       fprintf_filtered (stream, "(");
 970       type_print (type, "", stream, -1);
 971       fprintf_filtered (stream, ") (...?)");
 972       return 0;
 973     }
 974
 975   opts = *options;
 976   opts.deref_ref = 1;
 977   return (val_print (type, value_contents (val), 0, address,
 978                      stream, 0, &opts, current_language));
 979 }
 980
 981 static void
 982 print_record (struct type *type, const gdb_byte *valaddr,
 983               struct ui_file *stream, int recurse,
 984               const struct value_print_options *options)
 985 {
 986   type = ada_check_typedef (type);
 987
 988   fprintf_filtered (stream, "(");
 989
 990   if (print_field_values (type, valaddr, stream, recurse, options,
 991                           0, type, valaddr) != 0 && options->pretty)
 992     {
 993       fprintf_filtered (stream, "\n");
 994       print_spaces_filtered (2 * recurse, stream);
 995     }
 996
 997   fprintf_filtered (stream, ")");
 998 }
 999
1000 /* Print out fields of value at VALADDR having structure type TYPE.
1001
1002    TYPE, VALADDR, STREAM, RECURSE, and OPTIONS have the
1003    same meanings as in ada_print_value and ada_val_print.
1004
1005    OUTER_TYPE and OUTER_VALADDR give type and address of enclosing record
1006    (used to get discriminant values when printing variant parts).
1007
1008    COMMA_NEEDED is 1 if fields have been printed at the current recursion
1009    level, so that a comma is needed before any field printed by this
1010    call.
1011
1012    Returns 1 if COMMA_NEEDED or any fields were printed.  */
1013
1014 static int
1015 print_field_values (struct type *type, const gdb_byte *valaddr,
1016                     struct ui_file *stream, int recurse,
1017                     const struct value_print_options *options,
1018                     int comma_needed,
1019                     struct type *outer_type, const gdb_byte *outer_valaddr)
1020 {
1021   int i, len;
1022
1023   len = TYPE_NFIELDS (type);
1024
1025   for (i = 0; i < len; i += 1)
1026     {
1027       if (ada_is_ignored_field (type, i))
1028         continue;
1029
1030       if (ada_is_wrapper_field (type, i))
1031         {
1032           comma_needed =
1033             print_field_values (TYPE_FIELD_TYPE (type, i),
1034                                 valaddr
1035                                 + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1036                                 stream, recurse, options,
1037                                 comma_needed, type, valaddr);
1038           continue;
1039         }
1040       else if (ada_is_variant_part (type, i))
1041         {
1042           comma_needed =
1043             print_variant_part (type, i, valaddr,
1044                                 stream, recurse, options, comma_needed,
1045                                 outer_type, outer_valaddr);
1046           continue;
1047         }
1048
1049       if (comma_needed)
1050         fprintf_filtered (stream, ", ");
1051       comma_needed = 1;
1052
1053       if (options->pretty)
1054         {
1055           fprintf_filtered (stream, "\n");
1056           print_spaces_filtered (2 + 2 * recurse, stream);
1057         }
1058       else
1059         {
1060           wrap_here (n_spaces (2 + 2 * recurse));
1061         }
1062       if (options->inspect_it)
1063         {
1064           if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
1065             fputs_filtered ("\"( ptr \"", stream);
1066           else
1067             fputs_filtered ("\"( nodef \"", stream);
1068           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1069                                    language_cplus, DMGL_NO_OPTS);
1070           fputs_filtered ("\" \"", stream);
1071           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1072                                    language_cplus, DMGL_NO_OPTS);
1073           fputs_filtered ("\") \"", stream);
1074         }
1075       else
1076         {
1077           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1078           fprintf_filtered (stream, "%.*s",
1079                             ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1080                             TYPE_FIELD_NAME (type, i));
1081           annotate_field_name_end ();
1082           fputs_filtered (" => ", stream);
1083           annotate_field_value ();
1084         }
1085
1086       if (TYPE_FIELD_PACKED (type, i))
1087         {
1088           struct value *v;
1089
1090           /* Bitfields require special handling, especially due to byte
1091              order problems.  */
1092           if (TYPE_CPLUS_SPECIFIC (type) != NULL
1093               && TYPE_FIELD_IGNORE (type, i))
1094             {
1095               fputs_filtered (_("<optimized out or zero length>"), stream);
1096             }
1097           else
1098             {
1099               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1100               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1101               struct value_print_options opts;
1102
1103               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1104               v = ada_value_primitive_packed_val (NULL, valaddr,
1105                                                   bit_pos / HOST_CHAR_BIT,
1106                                                   bit_pos % HOST_CHAR_BIT,
1107                                                   bit_size,
1108                                                   TYPE_FIELD_TYPE (type, i));
1109               opts = *options;
1110               opts.deref_ref = 0;
1111               val_print (TYPE_FIELD_TYPE (type, i), value_contents (v), 0, 0,
1112                          stream, recurse + 1, &opts, current_language);
1113             }
1114         }
1115       else
1116         {
1117           struct value_print_options opts = *options;
1118           opts.deref_ref = 0;
1119           ada_val_print (TYPE_FIELD_TYPE (type, i),
1120                          valaddr + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1121                          0, 0, stream, recurse + 1, &opts);
1122         }
1123       annotate_field_end ();
1124     }
1125
1126   return comma_needed;
1127 }