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               CORE_ADDR addr;
 750               addr = value_as_address (call_function_by_hand (func, 1, &val));
 751               val_print_string (builtin_type_true_char,
 752                                 addr, -1, stream, options);
 753               return 0;
 754             }
 755           /* No special printing function.  Do as best we can.  */
 756         }
 757       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
 758         {
 759           struct type *target_type = TYPE_TARGET_TYPE (type);
 760           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
 761             {
 762               /* Obscure case of range type that has different length from
 763                  its base type.  Perform a conversion, or we will get a
 764                  nonsense value.  Actually, we could use the same
 765                  code regardless of lengths; I'm just avoiding a cast.  */
 766               struct value *v = value_cast (target_type,
 767                                             value_from_contents_and_address
 768                                             (type, valaddr, 0));
 769               return ada_val_print_1 (target_type, value_contents (v), 0, 0,
 770                                       stream, recurse + 1, options);
 771             }
 772           else
 773             return ada_val_print_1 (TYPE_TARGET_TYPE (type),
 774                                     valaddr0, embedded_offset,
 775                                     address, stream, recurse, options);
 776         }
 777       else
 778         {
 779           int format = (options->format ? options->format
 780                         : options->output_format);
 781           if (format)
 782             {
 783               struct value_print_options opts = *options;
 784               opts.format = format;
 785               print_scalar_formatted (valaddr, type, &opts, 0, stream);
 786             }
 787           else if (ada_is_system_address_type (type)
 788                    && TYPE_OBJFILE (type) != NULL)
 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                  We do this only for System.Address types defined in an
 797                  objfile.  For the built-in version of System.Address we
 798                  have installed the proper type to begin with.  */
 799
 800               struct gdbarch *gdbarch = get_objfile_arch (TYPE_OBJFILE (type));
 801               struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
 802
 803               fprintf_filtered (stream, "(");
 804               type_print (type, "", stream, -1);
 805               fprintf_filtered (stream, ") ");
 806               fputs_filtered (paddress (extract_typed_address
 807                                         (valaddr, ptr_type)),
 808                               stream);
 809             }
 810           else
 811             {
 812               val_print_type_code_int (type, valaddr, stream);
 813               if (ada_is_character_type (type))
 814                 {
 815                   fputs_filtered (" ", stream);
 816                   ada_printchar ((unsigned char) unpack_long (type, valaddr),
 817                                  type, stream);
 818                 }
 819             }
 820           return 0;
 821         }
 822
 823     case TYPE_CODE_ENUM:
 824       if (options->format)
 825         {
 826           print_scalar_formatted (valaddr, type, options, 0, stream);
 827           break;
 828         }
 829       len = TYPE_NFIELDS (type);
 830       val = unpack_long (type, valaddr);
 831       for (i = 0; i < len; i++)
 832         {
 833           QUIT;
 834           if (val == TYPE_FIELD_BITPOS (type, i))
 835             {
 836               break;
 837             }
 838         }
 839       if (i < len)
 840         {
 841           const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
 842           if (name[0] == '\'')
 843             fprintf_filtered (stream, "%ld %s", (long) val, name);
 844           else
 845             fputs_filtered (name, stream);
 846         }
 847       else
 848         {
 849           print_longest (stream, 'd', 0, val);
 850         }
 851       break;
 852
 853     case TYPE_CODE_FLAGS:
 854       if (options->format)
 855         print_scalar_formatted (valaddr, type, options, 0, stream);
 856       else
 857         val_print_type_code_flags (type, valaddr, stream);
 858       break;
 859
 860     case TYPE_CODE_FLT:
 861       if (options->format)
 862         return c_val_print (type, valaddr0, embedded_offset, address, stream,
 863                             recurse, options);
 864       else
 865         ada_print_floating (valaddr0 + embedded_offset, type, stream);
 866       break;
 867
 868     case TYPE_CODE_UNION:
 869     case TYPE_CODE_STRUCT:
 870       if (ada_is_bogus_array_descriptor (type))
 871         {
 872           fprintf_filtered (stream, "(...?)");
 873           return 0;
 874         }
 875       else
 876         {
 877           print_record (type, valaddr, stream, recurse, options);
 878           return 0;
 879         }
 880
 881     case TYPE_CODE_ARRAY:
 882       return ada_val_print_array (type, valaddr, address, stream,
 883                                   recurse, options);
 884
 885     case TYPE_CODE_REF:
 886       /* For references, the debugger is expected to print the value as
 887          an address if DEREF_REF is null.  But printing an address in place
 888          of the object value would be confusing to an Ada programmer.
 889          So, for Ada values, we print the actual dereferenced value
 890          regardless.  */
 891       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 892
 893       if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 894         {
 895           LONGEST deref_val_int = (LONGEST) unpack_pointer (type, valaddr);
 896           if (deref_val_int != 0)
 897             {
 898               struct value *deref_val =
 899                 ada_value_ind (value_from_longest
 900                                (lookup_pointer_type (elttype),
 901                                 deref_val_int));
 902               val_print (value_type (deref_val),
 903                          value_contents (deref_val), 0,
 904                          value_address (deref_val), stream, recurse + 1,
 905                          options, current_language);
 906             }
 907           else
 908             fputs_filtered ("(null)", stream);
 909         }
 910       else
 911         fputs_filtered ("???", stream);
 912
 913       break;
 914     }
 915   gdb_flush (stream);
 916   return 0;
 917 }
 918
 919 static int
 920 print_variant_part (struct type *type, int field_num, const gdb_byte *valaddr,
 921                     struct ui_file *stream, int recurse,
 922                     const struct value_print_options *options, int comma_needed,
 923                     struct type *outer_type, const gdb_byte *outer_valaddr)
 924 {
 925   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
 926   int which = ada_which_variant_applies (var_type, outer_type, outer_valaddr);
 927
 928   if (which < 0)
 929     return 0;
 930   else
 931     return print_field_values
 932       (TYPE_FIELD_TYPE (var_type, which),
 933        valaddr + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
 934        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
 935        stream, recurse, options,
 936        comma_needed, outer_type, outer_valaddr);
 937 }
 938
 939 int
 940 ada_value_print (struct value *val0, struct ui_file *stream,
 941                  const struct value_print_options *options)
 942 {
 943   const gdb_byte *valaddr = value_contents (val0);
 944   CORE_ADDR address = value_address (val0);
 945   struct type *type =
 946     ada_to_fixed_type (value_type (val0), valaddr, address, NULL, 1);
 947   struct value *val =
 948     value_from_contents_and_address (type, valaddr, address);
 949   struct value_print_options opts;
 950
 951   /* If it is a pointer, indicate what it points to.  */
 952   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 953     {
 954       /* Hack:  don't print (char *) for char strings.  Their
 955          type is indicated by the quoted string anyway.  */
 956       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
 957           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT
 958           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
 959         {
 960           fprintf_filtered (stream, "(");
 961           type_print (type, "", stream, -1);
 962           fprintf_filtered (stream, ") ");
 963         }
 964     }
 965   else if (ada_is_array_descriptor_type (type))
 966     {
 967       fprintf_filtered (stream, "(");
 968       type_print (type, "", stream, -1);
 969       fprintf_filtered (stream, ") ");
 970     }
 971   else if (ada_is_bogus_array_descriptor (type))
 972     {
 973       fprintf_filtered (stream, "(");
 974       type_print (type, "", stream, -1);
 975       fprintf_filtered (stream, ") (...?)");
 976       return 0;
 977     }
 978
 979   opts = *options;
 980   opts.deref_ref = 1;
 981   return (val_print (type, value_contents (val), 0, address,
 982                      stream, 0, &opts, current_language));
 983 }
 984
 985 static void
 986 print_record (struct type *type, const gdb_byte *valaddr,
 987               struct ui_file *stream, int recurse,
 988               const struct value_print_options *options)
 989 {
 990   type = ada_check_typedef (type);
 991
 992   fprintf_filtered (stream, "(");
 993
 994   if (print_field_values (type, valaddr, stream, recurse, options,
 995                           0, type, valaddr) != 0 && options->pretty)
 996     {
 997       fprintf_filtered (stream, "\n");
 998       print_spaces_filtered (2 * recurse, stream);
 999     }
1000
1001   fprintf_filtered (stream, ")");
1002 }
1003
1004 /* Print out fields of value at VALADDR having structure type TYPE.
1005
1006    TYPE, VALADDR, STREAM, RECURSE, and OPTIONS have the
1007    same meanings as in ada_print_value and ada_val_print.
1008
1009    OUTER_TYPE and OUTER_VALADDR give type and address of enclosing record
1010    (used to get discriminant values when printing variant parts).
1011
1012    COMMA_NEEDED is 1 if fields have been printed at the current recursion
1013    level, so that a comma is needed before any field printed by this
1014    call.
1015
1016    Returns 1 if COMMA_NEEDED or any fields were printed.  */
1017
1018 static int
1019 print_field_values (struct type *type, const gdb_byte *valaddr,
1020                     struct ui_file *stream, int recurse,
1021                     const struct value_print_options *options,
1022                     int comma_needed,
1023                     struct type *outer_type, const gdb_byte *outer_valaddr)
1024 {
1025   int i, len;
1026
1027   len = TYPE_NFIELDS (type);
1028
1029   for (i = 0; i < len; i += 1)
1030     {
1031       if (ada_is_ignored_field (type, i))
1032         continue;
1033
1034       if (ada_is_wrapper_field (type, i))
1035         {
1036           comma_needed =
1037             print_field_values (TYPE_FIELD_TYPE (type, i),
1038                                 valaddr
1039                                 + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1040                                 stream, recurse, options,
1041                                 comma_needed, type, valaddr);
1042           continue;
1043         }
1044       else if (ada_is_variant_part (type, i))
1045         {
1046           comma_needed =
1047             print_variant_part (type, i, valaddr,
1048                                 stream, recurse, options, comma_needed,
1049                                 outer_type, outer_valaddr);
1050           continue;
1051         }
1052
1053       if (comma_needed)
1054         fprintf_filtered (stream, ", ");
1055       comma_needed = 1;
1056
1057       if (options->pretty)
1058         {
1059           fprintf_filtered (stream, "\n");
1060           print_spaces_filtered (2 + 2 * recurse, stream);
1061         }
1062       else
1063         {
1064           wrap_here (n_spaces (2 + 2 * recurse));
1065         }
1066       if (options->inspect_it)
1067         {
1068           if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
1069             fputs_filtered ("\"( ptr \"", stream);
1070           else
1071             fputs_filtered ("\"( nodef \"", stream);
1072           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1073                                    language_cplus, DMGL_NO_OPTS);
1074           fputs_filtered ("\" \"", stream);
1075           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1076                                    language_cplus, DMGL_NO_OPTS);
1077           fputs_filtered ("\") \"", stream);
1078         }
1079       else
1080         {
1081           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1082           fprintf_filtered (stream, "%.*s",
1083                             ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1084                             TYPE_FIELD_NAME (type, i));
1085           annotate_field_name_end ();
1086           fputs_filtered (" => ", stream);
1087           annotate_field_value ();
1088         }
1089
1090       if (TYPE_FIELD_PACKED (type, i))
1091         {
1092           struct value *v;
1093
1094           /* Bitfields require special handling, especially due to byte
1095              order problems.  */
1096           if (TYPE_CPLUS_SPECIFIC (type) != NULL
1097               && TYPE_FIELD_IGNORE (type, i))
1098             {
1099               fputs_filtered (_("<optimized out or zero length>"), stream);
1100             }
1101           else
1102             {
1103               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1104               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1105               struct value_print_options opts;
1106
1107               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1108               v = ada_value_primitive_packed_val (NULL, valaddr,
1109                                                   bit_pos / HOST_CHAR_BIT,
1110                                                   bit_pos % HOST_CHAR_BIT,
1111                                                   bit_size,
1112                                                   TYPE_FIELD_TYPE (type, i));
1113               opts = *options;
1114               opts.deref_ref = 0;
1115               val_print (TYPE_FIELD_TYPE (type, i), value_contents (v), 0, 0,
1116                          stream, recurse + 1, &opts, current_language);
1117             }
1118         }
1119       else
1120         {
1121           struct value_print_options opts = *options;
1122           opts.deref_ref = 0;
1123           ada_val_print (TYPE_FIELD_TYPE (type, i),
1124                          valaddr + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1125                          0, 0, stream, recurse + 1, &opts);
1126         }
1127       annotate_field_end ();
1128     }
1129
1130   return comma_needed;
1131 }