gdb/ada-valprint.c

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