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 <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->prettyformat_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->prettyformat_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   struct ui_file *tmp_stream = mem_fileopen ();
 324   struct cleanup *cleanups = make_cleanup_ui_file_delete (tmp_stream);
 325
 326   print_floating (valaddr, type, tmp_stream);
 327   ui_file_put (tmp_stream, ui_memcpy, buffer);
 328   do_cleanups (cleanups);
 329
 330   result = buffer;
 331
 332   /* Modify for Ada rules.  */
 333
 334   s = strstr (result, "inf");
 335   if (s == NULL)
 336     s = strstr (result, "Inf");
 337   if (s == NULL)
 338     s = strstr (result, "INF");
 339   if (s != NULL)
 340     strcpy (s, "Inf");
 341
 342   if (s == NULL)
 343     {
 344       s = strstr (result, "nan");
 345       if (s == NULL)
 346         s = strstr (result, "NaN");
 347       if (s == NULL)
 348         s = strstr (result, "Nan");
 349       if (s != NULL)
 350         {
 351           s[0] = s[2] = 'N';
 352           if (result[0] == '-')
 353             result += 1;
 354         }
 355     }
 356
 357   if (s == NULL && strchr (result, '.') == NULL)
 358     {
 359       s = strchr (result, 'e');
 360       if (s == NULL)
 361         fprintf_filtered (stream, "%s.0", result);
 362       else
 363         fprintf_filtered (stream, "%.*s.0%s", (int) (s-result), result, s);
 364       return;
 365     }
 366   fprintf_filtered (stream, "%s", result);
 367 }
 368
 369 void
 370 ada_printchar (int c, struct type *type, struct ui_file *stream)
 371 {
 372   fputs_filtered ("'", stream);
 373   ada_emit_char (c, type, stream, '\'', TYPE_LENGTH (type));
 374   fputs_filtered ("'", stream);
 375 }
 376
 377 /* [From print_type_scalar in typeprint.c].   Print VAL on STREAM in a
 378    form appropriate for TYPE, if non-NULL.  If TYPE is NULL, print VAL
 379    like a default signed integer.  */
 380
 381 void
 382 ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
 383 {
 384   unsigned int i;
 385   unsigned len;
 386
 387   if (!type)
 388     {
 389       print_longest (stream, 'd', 0, val);
 390       return;
 391     }
 392
 393   type = ada_check_typedef (type);
 394
 395   switch (TYPE_CODE (type))
 396     {
 397
 398     case TYPE_CODE_ENUM:
 399       len = TYPE_NFIELDS (type);
 400       for (i = 0; i < len; i++)
 401         {
 402           if (TYPE_FIELD_ENUMVAL (type, i) == val)
 403             {
 404               break;
 405             }
 406         }
 407       if (i < len)
 408         {
 409           fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 410         }
 411       else
 412         {
 413           print_longest (stream, 'd', 0, val);
 414         }
 415       break;
 416
 417     case TYPE_CODE_INT:
 418       print_longest (stream, TYPE_UNSIGNED (type) ? 'u' : 'd', 0, val);
 419       break;
 420
 421     case TYPE_CODE_CHAR:
 422       LA_PRINT_CHAR (val, type, stream);
 423       break;
 424
 425     case TYPE_CODE_BOOL:
 426       fprintf_filtered (stream, val ? "true" : "false");
 427       break;
 428
 429     case TYPE_CODE_RANGE:
 430       ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
 431       return;
 432
 433     case TYPE_CODE_UNDEF:
 434     case TYPE_CODE_PTR:
 435     case TYPE_CODE_ARRAY:
 436     case TYPE_CODE_STRUCT:
 437     case TYPE_CODE_UNION:
 438     case TYPE_CODE_FUNC:
 439     case TYPE_CODE_FLT:
 440     case TYPE_CODE_VOID:
 441     case TYPE_CODE_SET:
 442     case TYPE_CODE_STRING:
 443     case TYPE_CODE_ERROR:
 444     case TYPE_CODE_MEMBERPTR:
 445     case TYPE_CODE_METHODPTR:
 446     case TYPE_CODE_METHOD:
 447     case TYPE_CODE_REF:
 448       warning (_("internal error: unhandled type in ada_print_scalar"));
 449       break;
 450
 451     default:
 452       error (_("Invalid type code in symbol table."));
 453     }
 454   gdb_flush (stream);
 455 }
 456
 457 /* Print the character string STRING, printing at most LENGTH characters.
 458    Printing stops early if the number hits print_max; repeat counts
 459    are printed as appropriate.  Print ellipses at the end if we
 460    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
 461    TYPE_LEN is the length (1 or 2) of the character type.  */
 462
 463 static void
 464 printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
 465           unsigned int length, int force_ellipses, int type_len,
 466           const struct value_print_options *options)
 467 {
 468   enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (elttype));
 469   unsigned int i;
 470   unsigned int things_printed = 0;
 471   int in_quotes = 0;
 472   int need_comma = 0;
 473
 474   if (length == 0)
 475     {
 476       fputs_filtered ("\"\"", stream);
 477       return;
 478     }
 479
 480   for (i = 0; i < length && things_printed < options->print_max; i += 1)
 481     {
 482       /* Position of the character we are examining
 483          to see whether it is repeated.  */
 484       unsigned int rep1;
 485       /* Number of repetitions we have detected so far.  */
 486       unsigned int reps;
 487
 488       QUIT;
 489
 490       if (need_comma)
 491         {
 492           fputs_filtered (", ", stream);
 493           need_comma = 0;
 494         }
 495
 496       rep1 = i + 1;
 497       reps = 1;
 498       while (rep1 < length
 499              && char_at (string, rep1, type_len, byte_order)
 500                 == char_at (string, i, type_len, byte_order))
 501         {
 502           rep1 += 1;
 503           reps += 1;
 504         }
 505
 506       if (reps > options->repeat_count_threshold)
 507         {
 508           if (in_quotes)
 509             {
 510               fputs_filtered ("\", ", stream);
 511               in_quotes = 0;
 512             }
 513           fputs_filtered ("'", stream);
 514           ada_emit_char (char_at (string, i, type_len, byte_order),
 515                          elttype, stream, '\'', type_len);
 516           fputs_filtered ("'", stream);
 517           fprintf_filtered (stream, _(" <repeats %u times>"), reps);
 518           i = rep1 - 1;
 519           things_printed += options->repeat_count_threshold;
 520           need_comma = 1;
 521         }
 522       else
 523         {
 524           if (!in_quotes)
 525             {
 526               fputs_filtered ("\"", stream);
 527               in_quotes = 1;
 528             }
 529           ada_emit_char (char_at (string, i, type_len, byte_order),
 530                          elttype, stream, '"', type_len);
 531           things_printed += 1;
 532         }
 533     }
 534
 535   /* Terminate the quotes if necessary.  */
 536   if (in_quotes)
 537     fputs_filtered ("\"", stream);
 538
 539   if (force_ellipses || i < length)
 540     fputs_filtered ("...", stream);
 541 }
 542
 543 void
 544 ada_printstr (struct ui_file *stream, struct type *type,
 545               const gdb_byte *string, unsigned int length,
 546               const char *encoding, int force_ellipses,
 547               const struct value_print_options *options)
 548 {
 549   printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
 550             options);
 551 }
 552
 553
 554 /* See val_print for a description of the various parameters of this
 555    function; they are identical.  */
 556
 557 void
 558 ada_val_print (struct type *type, const gdb_byte *valaddr,
 559                int embedded_offset, CORE_ADDR address,
 560                struct ui_file *stream, int recurse,
 561                const struct value *val,
 562                const struct value_print_options *options)
 563 {
 564   volatile struct gdb_exception except;
 565
 566   /* XXX: this catches QUIT/ctrl-c as well.  Isn't that busted?  */
 567   TRY_CATCH (except, RETURN_MASK_ALL)
 568     {
 569       ada_val_print_1 (type, valaddr, embedded_offset, address,
 570                        stream, recurse, val, options);
 571     }
 572 }
 573
 574 /* Assuming TYPE is a simple array, print the value of this array located
 575    at VALADDR + OFFSET.  See ada_val_print for a description of the various
 576    parameters of this function; they are identical.  */
 577
 578 static void
 579 ada_val_print_array (struct type *type, const gdb_byte *valaddr,
 580                      int offset, CORE_ADDR address,
 581                      struct ui_file *stream, int recurse,
 582                      const struct value *val,
 583                      const struct value_print_options *options)
 584 {
 585   /* For an array of chars, print with string syntax.  */
 586   if (ada_is_string_type (type)
 587       && (options->format == 0 || options->format == 's'))
 588     {
 589       enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
 590       struct type *elttype = TYPE_TARGET_TYPE (type);
 591       unsigned int eltlen;
 592       unsigned int len;
 593
 594       /* We know that ELTTYPE cannot possibly be null, because we found
 595          that TYPE is a string-like type.  Similarly, the size of ELTTYPE
 596          should also be non-null, since it's a character-like type.  */
 597       gdb_assert (elttype != NULL);
 598       gdb_assert (TYPE_LENGTH (elttype) != 0);
 599
 600       eltlen = TYPE_LENGTH (elttype);
 601       len = TYPE_LENGTH (type) / eltlen;
 602
 603       if (options->prettyformat_arrays)
 604         print_spaces_filtered (2 + 2 * recurse, stream);
 605
 606       /* If requested, look for the first null char and only print
 607          elements up to it.  */
 608       if (options->stop_print_at_null)
 609         {
 610           int temp_len;
 611
 612           /* Look for a NULL char.  */
 613           for (temp_len = 0;
 614                (temp_len < len
 615                 && temp_len < options->print_max
 616                 && char_at (valaddr + offset,
 617                             temp_len, eltlen, byte_order) != 0);
 618                temp_len += 1);
 619           len = temp_len;
 620         }
 621
 622       printstr (stream, elttype, valaddr + offset, len, 0, eltlen, options);
 623     }
 624   else
 625     {
 626       fprintf_filtered (stream, "(");
 627       print_optional_low_bound (stream, type, options);
 628       if (TYPE_FIELD_BITSIZE (type, 0) > 0)
 629         val_print_packed_array_elements (type, valaddr, offset,
 630                                          0, stream, recurse, val, options);
 631       else
 632         val_print_array_elements (type, valaddr, offset, address,
 633                                   stream, recurse, val, options, 0);
 634       fprintf_filtered (stream, ")");
 635     }
 636 }
 637
 638 /* See the comment on ada_val_print.  This function differs in that it
 639    does not catch evaluation errors (leaving that to ada_val_print).  */
 640
 641 static void
 642 ada_val_print_1 (struct type *type, const gdb_byte *valaddr,
 643                  int offset, CORE_ADDR address,
 644                  struct ui_file *stream, int recurse,
 645                  const struct value *original_value,
 646                  const struct value_print_options *options)
 647 {
 648   int i;
 649   struct type *elttype;
 650   int offset_aligned;
 651
 652   type = ada_check_typedef (type);
 653
 654   if (ada_is_array_descriptor_type (type)
 655       || (ada_is_constrained_packed_array_type (type)
 656           && TYPE_CODE (type) != TYPE_CODE_PTR))
 657     {
 658       struct value *mark = value_mark ();
 659       struct value *val;
 660
 661       val = value_from_contents_and_address (type, valaddr + offset, address);
 662       /* If this is a reference, coerce it now.  This helps taking care
 663          of the case where ADDRESS is meaningless because original_value
 664          was not an lval.  */
 665       val = coerce_ref (val);
 666       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
 667         val = ada_coerce_to_simple_array_ptr (val);
 668       else
 669         val = ada_coerce_to_simple_array (val);
 670       if (val == NULL)
 671         {
 672           gdb_assert (TYPE_CODE (type) == TYPE_CODE_TYPEDEF);
 673           fprintf_filtered (stream, "0x0");
 674         }
 675       else
 676         ada_val_print_1 (value_type (val),
 677                          value_contents_for_printing (val),
 678                          value_embedded_offset (val),
 679                          value_address (val), stream, recurse,
 680                          val, options);
 681       value_free_to_mark (mark);
 682       return;
 683     }
 684
 685   offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
 686   type = printable_val_type (type, valaddr + offset_aligned);
 687
 688   switch (TYPE_CODE (type))
 689     {
 690     default:
 691       c_val_print (type, valaddr, offset, address, stream,
 692                    recurse, original_value, options);
 693       break;
 694
 695     case TYPE_CODE_PTR:
 696       {
 697         c_val_print (type, valaddr, offset, address,
 698                      stream, recurse, original_value, options);
 699
 700         if (ada_is_tag_type (type))
 701           {
 702             struct value *val =
 703               value_from_contents_and_address (type,
 704                                                valaddr + offset_aligned,
 705                                                address + offset_aligned);
 706             const char *name = ada_tag_name (val);
 707
 708             if (name != NULL)
 709               fprintf_filtered (stream, " (%s)", name);
 710           }
 711         return;
 712       }
 713
 714     case TYPE_CODE_INT:
 715     case TYPE_CODE_RANGE:
 716       if (ada_is_fixed_point_type (type))
 717         {
 718           LONGEST v = unpack_long (type, valaddr + offset_aligned);
 719
 720           fprintf_filtered (stream, TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g",
 721                             (double) ada_fixed_to_float (type, v));
 722           return;
 723         }
 724       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
 725         {
 726           struct type *target_type = TYPE_TARGET_TYPE (type);
 727
 728           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
 729             {
 730               /* Obscure case of range type that has different length from
 731                  its base type.  Perform a conversion, or we will get a
 732                  nonsense value.  Actually, we could use the same
 733                  code regardless of lengths; I'm just avoiding a cast.  */
 734               struct value *v1
 735                 = value_from_contents_and_address (type, valaddr + offset, 0);
 736               struct value *v = value_cast (target_type, v1);
 737
 738               ada_val_print_1 (target_type,
 739                                value_contents_for_printing (v),
 740                                value_embedded_offset (v), 0,
 741                                stream, recurse + 1, v, options);
 742             }
 743           else
 744             ada_val_print_1 (TYPE_TARGET_TYPE (type),
 745                              valaddr, offset,
 746                              address, stream, recurse,
 747                              original_value, options);
 748           return;
 749         }
 750       else
 751         {
 752           int format = (options->format ? options->format
 753                         : options->output_format);
 754
 755           if (format)
 756             {
 757               struct value_print_options opts = *options;
 758
 759               opts.format = format;
 760               val_print_scalar_formatted (type, valaddr, offset_aligned,
 761                                           original_value, &opts, 0, stream);
 762             }
 763           else if (ada_is_system_address_type (type))
 764             {
 765               /* FIXME: We want to print System.Address variables using
 766                  the same format as for any access type.  But for some
 767                  reason GNAT encodes the System.Address type as an int,
 768                  so we have to work-around this deficiency by handling
 769                  System.Address values as a special case.  */
 770
 771               struct gdbarch *gdbarch = get_type_arch (type);
 772               struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
 773               CORE_ADDR addr = extract_typed_address (valaddr + offset_aligned,
 774                                                       ptr_type);
 775
 776               fprintf_filtered (stream, "(");
 777               type_print (type, "", stream, -1);
 778               fprintf_filtered (stream, ") ");
 779               fputs_filtered (paddress (gdbarch, addr), stream);
 780             }
 781           else
 782             {
 783               val_print_type_code_int (type, valaddr + offset_aligned, stream);
 784               if (ada_is_character_type (type))
 785                 {
 786                   LONGEST c;
 787
 788                   fputs_filtered (" ", stream);
 789                   c = unpack_long (type, valaddr + offset_aligned);
 790                   ada_printchar (c, type, stream);
 791                 }
 792             }
 793           return;
 794         }
 795
 796     case TYPE_CODE_ENUM:
 797       {
 798         unsigned int len;
 799         LONGEST val;
 800
 801         if (options->format)
 802           {
 803             val_print_scalar_formatted (type, valaddr, offset_aligned,
 804                                         original_value, options, 0, stream);
 805             break;
 806           }
 807         len = TYPE_NFIELDS (type);
 808         val = unpack_long (type, valaddr + offset_aligned);
 809         for (i = 0; i < len; i++)
 810           {
 811             QUIT;
 812             if (val == TYPE_FIELD_ENUMVAL (type, i))
 813               {
 814                 break;
 815               }
 816           }
 817         if (i < len)
 818           {
 819             const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
 820
 821             if (name[0] == '\'')
 822               fprintf_filtered (stream, "%ld %s", (long) val, name);
 823             else
 824               fputs_filtered (name, stream);
 825           }
 826         else
 827           {
 828             print_longest (stream, 'd', 0, val);
 829           }
 830         break;
 831       }
 832
 833     case TYPE_CODE_FLT:
 834       if (options->format)
 835         {
 836           c_val_print (type, valaddr, offset, address, stream,
 837                        recurse, original_value, options);
 838           return;
 839         }
 840       else
 841         ada_print_floating (valaddr + offset, type, stream);
 842       break;
 843
 844     case TYPE_CODE_UNION:
 845     case TYPE_CODE_STRUCT:
 846       if (ada_is_bogus_array_descriptor (type))
 847         {
 848           fprintf_filtered (stream, "(...?)");
 849           return;
 850         }
 851       else
 852         {
 853           print_record (type, valaddr, offset_aligned,
 854                         stream, recurse, original_value, options);
 855           return;
 856         }
 857
 858     case TYPE_CODE_ARRAY:
 859       ada_val_print_array (type, valaddr, offset_aligned,
 860                            address, stream, recurse, original_value,
 861                            options);
 862       return;
 863
 864     case TYPE_CODE_REF:
 865       /* For references, the debugger is expected to print the value as
 866          an address if DEREF_REF is null.  But printing an address in place
 867          of the object value would be confusing to an Ada programmer.
 868          So, for Ada values, we print the actual dereferenced value
 869          regardless.  */
 870       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 871
 872       if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 873         {
 874           CORE_ADDR deref_val_int;
 875           struct value *deref_val;
 876
 877           deref_val = coerce_ref_if_computed (original_value);
 878           if (deref_val)
 879             {
 880               if (ada_is_tagged_type (value_type (deref_val), 1))
 881                 deref_val = ada_tag_value_at_base_address (deref_val);
 882
 883               common_val_print (deref_val, stream, recurse + 1, options,
 884                                 current_language);
 885               break;
 886             }
 887
 888           deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
 889           if (deref_val_int != 0)
 890             {
 891               deref_val =
 892                 ada_value_ind (value_from_pointer
 893                                (lookup_pointer_type (elttype),
 894                                 deref_val_int));
 895
 896               if (ada_is_tagged_type (value_type (deref_val), 1))
 897                 deref_val = ada_tag_value_at_base_address (deref_val);
 898
 899               val_print (value_type (deref_val),
 900                          value_contents_for_printing (deref_val),
 901                          value_embedded_offset (deref_val),
 902                          value_address (deref_val), stream, recurse + 1,
 903                          deref_val, options, current_language);
 904             }
 905           else
 906             fputs_filtered ("(null)", stream);
 907         }
 908       else
 909         fputs_filtered ("???", stream);
 910
 911       break;
 912     }
 913   gdb_flush (stream);
 914 }
 915
 916 static int
 917 print_variant_part (struct type *type, int field_num,
 918                     const gdb_byte *valaddr, int offset,
 919                     struct ui_file *stream, int recurse,
 920                     const struct value *val,
 921                     const struct value_print_options *options,
 922                     int comma_needed,
 923                     struct type *outer_type, int outer_offset)
 924 {
 925   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
 926   int which = ada_which_variant_applies (var_type, outer_type,
 927                                          valaddr + outer_offset);
 928
 929   if (which < 0)
 930     return 0;
 931   else
 932     return print_field_values
 933       (TYPE_FIELD_TYPE (var_type, which),
 934        valaddr,
 935        offset + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
 936        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
 937        stream, recurse, val, options,
 938        comma_needed, outer_type, outer_offset);
 939 }
 940
 941 void
 942 ada_value_print (struct value *val0, struct ui_file *stream,
 943                  const struct value_print_options *options)
 944 {
 945   struct value *val = ada_to_fixed_value (val0);
 946   CORE_ADDR address = value_address (val);
 947   struct type *type = ada_check_typedef (value_type (val));
 948   struct value_print_options opts;
 949
 950   /* If it is a pointer, indicate what it points to.  */
 951   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 952     {
 953       /* Hack:  don't print (char *) for char strings.  Their
 954          type is indicated by the quoted string anyway.  */
 955       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
 956           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT
 957           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
 958         {
 959           fprintf_filtered (stream, "(");
 960           type_print (type, "", stream, -1);
 961           fprintf_filtered (stream, ") ");
 962         }
 963     }
 964   else if (ada_is_array_descriptor_type (type))
 965     {
 966       /* We do not print the type description unless TYPE is an array
 967          access type (this is encoded by the compiler as a typedef to
 968          a fat pointer - hence the check against TYPE_CODE_TYPEDEF).  */
 969       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
 970         {
 971           fprintf_filtered (stream, "(");
 972           type_print (type, "", stream, -1);
 973           fprintf_filtered (stream, ") ");
 974         }
 975     }
 976   else if (ada_is_bogus_array_descriptor (type))
 977     {
 978       fprintf_filtered (stream, "(");
 979       type_print (type, "", stream, -1);
 980       fprintf_filtered (stream, ") (...?)");
 981       return;
 982     }
 983
 984   opts = *options;
 985   opts.deref_ref = 1;
 986   val_print (type, value_contents_for_printing (val),
 987              value_embedded_offset (val), address,
 988              stream, 0, val, &opts, current_language);
 989 }
 990
 991 static void
 992 print_record (struct type *type, const gdb_byte *valaddr,
 993               int offset,
 994               struct ui_file *stream, int recurse,
 995               const struct value *val,
 996               const struct value_print_options *options)
 997 {
 998   type = ada_check_typedef (type);
 999
1000   fprintf_filtered (stream, "(");
1001
1002   if (print_field_values (type, valaddr, offset,
1003                           stream, recurse, val, options,
1004                           0, type, offset) != 0 && options->prettyformat)
1005     {
1006       fprintf_filtered (stream, "\n");
1007       print_spaces_filtered (2 * recurse, stream);
1008     }
1009
1010   fprintf_filtered (stream, ")");
1011 }
1012
1013 /* Print out fields of value at VALADDR + OFFSET having structure type TYPE.
1014
1015    TYPE, VALADDR, OFFSET, STREAM, RECURSE, and OPTIONS have the same
1016    meanings as in ada_print_value and ada_val_print.
1017
1018    OUTER_TYPE and OUTER_OFFSET give type and address of enclosing
1019    record (used to get discriminant values when printing variant
1020    parts).
1021
1022    COMMA_NEEDED is 1 if fields have been printed at the current recursion
1023    level, so that a comma is needed before any field printed by this
1024    call.
1025
1026    Returns 1 if COMMA_NEEDED or any fields were printed.  */
1027
1028 static int
1029 print_field_values (struct type *type, const gdb_byte *valaddr,
1030                     int offset, struct ui_file *stream, int recurse,
1031                     const struct value *val,
1032                     const struct value_print_options *options,
1033                     int comma_needed,
1034                     struct type *outer_type, int outer_offset)
1035 {
1036   int i, len;
1037
1038   len = TYPE_NFIELDS (type);
1039
1040   for (i = 0; i < len; i += 1)
1041     {
1042       if (ada_is_ignored_field (type, i))
1043         continue;
1044
1045       if (ada_is_wrapper_field (type, i))
1046         {
1047           comma_needed =
1048             print_field_values (TYPE_FIELD_TYPE (type, i),
1049                                 valaddr,
1050                                 (offset
1051                                  + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
1052                                 stream, recurse, val, options,
1053                                 comma_needed, type, offset);
1054           continue;
1055         }
1056       else if (ada_is_variant_part (type, i))
1057         {
1058           comma_needed =
1059             print_variant_part (type, i, valaddr,
1060                                 offset, stream, recurse, val,
1061                                 options, comma_needed,
1062                                 outer_type, outer_offset);
1063           continue;
1064         }
1065
1066       if (comma_needed)
1067         fprintf_filtered (stream, ", ");
1068       comma_needed = 1;
1069
1070       if (options->prettyformat)
1071         {
1072           fprintf_filtered (stream, "\n");
1073           print_spaces_filtered (2 + 2 * recurse, stream);
1074         }
1075       else
1076         {
1077           wrap_here (n_spaces (2 + 2 * recurse));
1078         }
1079
1080       annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1081       fprintf_filtered (stream, "%.*s",
1082                         ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1083                         TYPE_FIELD_NAME (type, i));
1084       annotate_field_name_end ();
1085       fputs_filtered (" => ", stream);
1086       annotate_field_value ();
1087
1088       if (TYPE_FIELD_PACKED (type, i))
1089         {
1090           struct value *v;
1091
1092           /* Bitfields require special handling, especially due to byte
1093              order problems.  */
1094           if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
1095             {
1096               fputs_filtered (_("<optimized out or zero length>"), stream);
1097             }
1098           else
1099             {
1100               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1101               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1102               struct value_print_options opts;
1103
1104               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1105               v = ada_value_primitive_packed_val
1106                     (NULL, valaddr,
1107                      offset + bit_pos / HOST_CHAR_BIT,
1108                      bit_pos % HOST_CHAR_BIT,
1109                      bit_size, TYPE_FIELD_TYPE (type, i));
1110               opts = *options;
1111               opts.deref_ref = 0;
1112               val_print (TYPE_FIELD_TYPE (type, i),
1113                          value_contents_for_printing (v),
1114                          value_embedded_offset (v), 0,
1115                          stream, recurse + 1, v,
1116                          &opts, current_language);
1117             }
1118         }
1119       else
1120         {
1121           struct value_print_options opts = *options;
1122
1123           opts.deref_ref = 0;
1124           ada_val_print (TYPE_FIELD_TYPE (type, i),
1125                          valaddr,
1126                          (offset
1127                           + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
1128                          0, stream, recurse + 1, val, &opts);
1129         }
1130       annotate_field_end ();
1131     }
1132
1133   return comma_needed;
1134 }