gdb/ada-valprint.c

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