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