gdb/ada-valprint.c

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