gdb/ada-valprint.c

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