gdb/ada-valprint.c

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