gdb/ada-valprint.c

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