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