gdb/ada-valprint.c

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