gdb/ada-valprint.c

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