gdb/p-valprint.c

   1 /* Support for printing Pascal values for GDB, the GNU debugger.
   2
   3    Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010
   4    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 /* This file is derived from c-valprint.c */
  22
  23 #include "defs.h"
  24 #include "gdb_obstack.h"
  25 #include "symtab.h"
  26 #include "gdbtypes.h"
  27 #include "expression.h"
  28 #include "value.h"
  29 #include "command.h"
  30 #include "gdbcmd.h"
  31 #include "gdbcore.h"
  32 #include "demangle.h"
  33 #include "valprint.h"
  34 #include "typeprint.h"
  35 #include "language.h"
  36 #include "target.h"
  37 #include "annotate.h"
  38 #include "p-lang.h"
  39 #include "cp-abi.h"
  40 #include "cp-support.h"
  41 \f
  42
  43
  44
  45 /* Print data of type TYPE located at VALADDR (within GDB), which came from
  46    the inferior at address ADDRESS, onto stdio stream STREAM according to
  47    OPTIONS.  The data at VALADDR is in target byte order.
  48
  49    If the data are a string pointer, returns the number of string characters
  50    printed.  */
  51
  52
  53 int
  54 pascal_val_print (struct type *type, const gdb_byte *valaddr,
  55                   int embedded_offset, CORE_ADDR address,
  56                   struct ui_file *stream, int recurse,
  57                   const struct value_print_options *options)
  58 {
  59   struct gdbarch *gdbarch = get_type_arch (type);
  60   enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
  61   unsigned int i = 0;   /* Number of characters printed */
  62   unsigned len;
  63   struct type *elttype;
  64   unsigned eltlen;
  65   int length_pos, length_size, string_pos;
  66   struct type *char_type;
  67   LONGEST val;
  68   CORE_ADDR addr;
  69
  70   CHECK_TYPEDEF (type);
  71   switch (TYPE_CODE (type))
  72     {
  73     case TYPE_CODE_ARRAY:
  74       if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
  75         {
  76           elttype = check_typedef (TYPE_TARGET_TYPE (type));
  77           eltlen = TYPE_LENGTH (elttype);
  78           len = TYPE_LENGTH (type) / eltlen;
  79           if (options->prettyprint_arrays)
  80             {
  81               print_spaces_filtered (2 + 2 * recurse, stream);
  82             }
  83           /* For an array of chars, print with string syntax.  */
  84           if ((eltlen == 1 || eltlen == 2 || eltlen == 4)
  85               && ((TYPE_CODE (elttype) == TYPE_CODE_INT)
  86                || ((current_language->la_language == language_pascal)
  87                    && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
  88               && (options->format == 0 || options->format == 's'))
  89             {
  90               /* If requested, look for the first null char and only print
  91                  elements up to it.  */
  92               if (options->stop_print_at_null)
  93                 {
  94                   unsigned int temp_len;
  95
  96                   /* Look for a NULL char. */
  97                   for (temp_len = 0;
  98                        extract_unsigned_integer (valaddr + embedded_offset +
  99                                                  temp_len * eltlen, eltlen,
 100                                                  byte_order)
 101                        && temp_len < len && temp_len < options->print_max;
 102                        temp_len++);
 103                   len = temp_len;
 104                 }
 105
 106               LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
 107                                valaddr + embedded_offset, len, 0,
 108                                options);
 109               i = len;
 110             }
 111           else
 112             {
 113               fprintf_filtered (stream, "{");
 114               /* If this is a virtual function table, print the 0th
 115                  entry specially, and the rest of the members normally.  */
 116               if (pascal_object_is_vtbl_ptr_type (elttype))
 117                 {
 118                   i = 1;
 119                   fprintf_filtered (stream, "%d vtable entries", len - 1);
 120                 }
 121               else
 122                 {
 123                   i = 0;
 124                 }
 125               val_print_array_elements (type, valaddr + embedded_offset, address, stream,
 126                                         recurse, options, i);
 127               fprintf_filtered (stream, "}");
 128             }
 129           break;
 130         }
 131       /* Array of unspecified length: treat like pointer to first elt.  */
 132       addr = address;
 133       goto print_unpacked_pointer;
 134
 135     case TYPE_CODE_PTR:
 136       if (options->format && options->format != 's')
 137         {
 138           print_scalar_formatted (valaddr + embedded_offset, type,
 139                                   options, 0, stream);
 140           break;
 141         }
 142       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 143         {
 144           /* Print the unmangled name if desired.  */
 145           /* Print vtable entry - we only get here if we ARE using
 146              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.) */
 147           /* Extract the address, assume that it is unsigned.  */
 148           addr = extract_unsigned_integer (valaddr + embedded_offset,
 149                                            TYPE_LENGTH (type), byte_order);
 150           print_address_demangle (gdbarch, addr, stream, demangle);
 151           break;
 152         }
 153       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 154         {
 155           addr = unpack_pointer (type, valaddr + embedded_offset);
 156         print_unpacked_pointer:
 157           elttype = check_typedef (TYPE_TARGET_TYPE (type));
 158
 159           if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 160             {
 161               /* Try to print what function it points to.  */
 162               print_address_demangle (gdbarch, addr, stream, demangle);
 163               /* Return value is irrelevant except for string pointers.  */
 164               return (0);
 165             }
 166
 167           if (options->addressprint && options->format != 's')
 168             {
 169               fputs_filtered (paddress (gdbarch, addr), stream);
 170             }
 171
 172           /* For a pointer to char or unsigned char, also print the string
 173              pointed to, unless pointer is null.  */
 174           if (((TYPE_LENGTH (elttype) == 1
 175                && (TYPE_CODE (elttype) == TYPE_CODE_INT
 176                   || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 177               || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
 178                   && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 179               && (options->format == 0 || options->format == 's')
 180               && addr != 0)
 181             {
 182               /* no wide string yet */
 183               i = val_print_string (elttype, addr, -1, stream, options);
 184             }
 185           /* also for pointers to pascal strings */
 186           /* Note: this is Free Pascal specific:
 187              as GDB does not recognize stabs pascal strings
 188              Pascal strings are mapped to records
 189              with lowercase names PM  */
 190           if (is_pascal_string_type (elttype, &length_pos, &length_size,
 191                                      &string_pos, &char_type, NULL)
 192               && addr != 0)
 193             {
 194               ULONGEST string_length;
 195               void *buffer;
 196               buffer = xmalloc (length_size);
 197               read_memory (addr + length_pos, buffer, length_size);
 198               string_length = extract_unsigned_integer (buffer, length_size,
 199                                                         byte_order);
 200               xfree (buffer);
 201               i = val_print_string (char_type ,addr + string_pos, string_length, stream, options);
 202             }
 203           else if (pascal_object_is_vtbl_member (type))
 204             {
 205               /* print vtbl's nicely */
 206               CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
 207
 208               struct minimal_symbol *msymbol =
 209               lookup_minimal_symbol_by_pc (vt_address);
 210               if ((msymbol != NULL)
 211                   && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
 212                 {
 213                   fputs_filtered (" <", stream);
 214                   fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
 215                   fputs_filtered (">", stream);
 216                 }
 217               if (vt_address && options->vtblprint)
 218                 {
 219                   struct value *vt_val;
 220                   struct symbol *wsym = (struct symbol *) NULL;
 221                   struct type *wtype;
 222                   struct block *block = (struct block *) NULL;
 223                   int is_this_fld;
 224
 225                   if (msymbol != NULL)
 226                     wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
 227                                           VAR_DOMAIN, &is_this_fld);
 228
 229                   if (wsym)
 230                     {
 231                       wtype = SYMBOL_TYPE (wsym);
 232                     }
 233                   else
 234                     {
 235                       wtype = TYPE_TARGET_TYPE (type);
 236                     }
 237                   vt_val = value_at (wtype, vt_address);
 238                   common_val_print (vt_val, stream, recurse + 1, options,
 239                                     current_language);
 240                   if (options->pretty)
 241                     {
 242                       fprintf_filtered (stream, "\n");
 243                       print_spaces_filtered (2 + 2 * recurse, stream);
 244                     }
 245                 }
 246             }
 247
 248           /* Return number of characters printed, including the terminating
 249              '\0' if we reached the end.  val_print_string takes care including
 250              the terminating '\0' if necessary.  */
 251           return i;
 252         }
 253       break;
 254
 255     case TYPE_CODE_REF:
 256       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 257       if (options->addressprint)
 258         {
 259           CORE_ADDR addr
 260             = extract_typed_address (valaddr + embedded_offset, type);
 261           fprintf_filtered (stream, "@");
 262           fputs_filtered (paddress (gdbarch, addr), stream);
 263           if (options->deref_ref)
 264             fputs_filtered (": ", stream);
 265         }
 266       /* De-reference the reference.  */
 267       if (options->deref_ref)
 268         {
 269           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 270             {
 271               struct value *deref_val =
 272               value_at
 273               (TYPE_TARGET_TYPE (type),
 274                unpack_pointer (type, valaddr + embedded_offset));
 275               common_val_print (deref_val, stream, recurse + 1, options,
 276                                 current_language);
 277             }
 278           else
 279             fputs_filtered ("???", stream);
 280         }
 281       break;
 282
 283     case TYPE_CODE_UNION:
 284       if (recurse && !options->unionprint)
 285         {
 286           fprintf_filtered (stream, "{...}");
 287           break;
 288         }
 289       /* Fall through.  */
 290     case TYPE_CODE_STRUCT:
 291       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 292         {
 293           /* Print the unmangled name if desired.  */
 294           /* Print vtable entry - we only get here if NOT using
 295              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.) */
 296           /* Extract the address, assume that it is unsigned.  */
 297           print_address_demangle
 298             (gdbarch,
 299              extract_unsigned_integer (valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
 300                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET)), byte_order),
 301              stream, demangle);
 302         }
 303       else
 304         {
 305           if (is_pascal_string_type (type, &length_pos, &length_size,
 306                                      &string_pos, &char_type, NULL))
 307             {
 308               len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size, byte_order);
 309               LA_PRINT_STRING (stream, char_type, valaddr + embedded_offset + string_pos, len, 0, options);
 310             }
 311           else
 312             pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream,
 313                                               recurse, options, NULL, 0);
 314         }
 315       break;
 316
 317     case TYPE_CODE_ENUM:
 318       if (options->format)
 319         {
 320           print_scalar_formatted (valaddr + embedded_offset, type,
 321                                   options, 0, stream);
 322           break;
 323         }
 324       len = TYPE_NFIELDS (type);
 325       val = unpack_long (type, valaddr + embedded_offset);
 326       for (i = 0; i < len; i++)
 327         {
 328           QUIT;
 329           if (val == TYPE_FIELD_BITPOS (type, i))
 330             {
 331               break;
 332             }
 333         }
 334       if (i < len)
 335         {
 336           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 337         }
 338       else
 339         {
 340           print_longest (stream, 'd', 0, val);
 341         }
 342       break;
 343
 344     case TYPE_CODE_FLAGS:
 345       if (options->format)
 346           print_scalar_formatted (valaddr + embedded_offset, type,
 347                                   options, 0, stream);
 348       else
 349         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
 350       break;
 351
 352     case TYPE_CODE_FUNC:
 353       if (options->format)
 354         {
 355           print_scalar_formatted (valaddr + embedded_offset, type,
 356                                   options, 0, stream);
 357           break;
 358         }
 359       /* FIXME, we should consider, at least for ANSI C language, eliminating
 360          the distinction made between FUNCs and POINTERs to FUNCs.  */
 361       fprintf_filtered (stream, "{");
 362       type_print (type, "", stream, -1);
 363       fprintf_filtered (stream, "} ");
 364       /* Try to print what function it points to, and its address.  */
 365       print_address_demangle (gdbarch, address, stream, demangle);
 366       break;
 367
 368     case TYPE_CODE_BOOL:
 369       if (options->format || options->output_format)
 370         {
 371           struct value_print_options opts = *options;
 372           opts.format = (options->format ? options->format
 373                          : options->output_format);
 374           print_scalar_formatted (valaddr + embedded_offset, type,
 375                                   &opts, 0, stream);
 376         }
 377       else
 378         {
 379           val = unpack_long (type, valaddr + embedded_offset);
 380           if (val == 0)
 381             fputs_filtered ("false", stream);
 382           else if (val == 1)
 383             fputs_filtered ("true", stream);
 384           else
 385             {
 386               fputs_filtered ("true (", stream);
 387               fprintf_filtered (stream, "%ld)", (long int) val);
 388             }
 389         }
 390       break;
 391
 392     case TYPE_CODE_RANGE:
 393       /* FIXME: create_range_type does not set the unsigned bit in a
 394          range type (I think it probably should copy it from the target
 395          type), so we won't print values which are too large to
 396          fit in a signed integer correctly.  */
 397       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
 398          print with the target type, though, because the size of our type
 399          and the target type might differ).  */
 400       /* FALLTHROUGH */
 401
 402     case TYPE_CODE_INT:
 403       if (options->format || options->output_format)
 404         {
 405           struct value_print_options opts = *options;
 406           opts.format = (options->format ? options->format
 407                          : options->output_format);
 408           print_scalar_formatted (valaddr + embedded_offset, type,
 409                                   &opts, 0, stream);
 410         }
 411       else
 412         {
 413           val_print_type_code_int (type, valaddr + embedded_offset, stream);
 414         }
 415       break;
 416
 417     case TYPE_CODE_CHAR:
 418       if (options->format || options->output_format)
 419         {
 420           struct value_print_options opts = *options;
 421           opts.format = (options->format ? options->format
 422                          : options->output_format);
 423           print_scalar_formatted (valaddr + embedded_offset, type,
 424                                   &opts, 0, stream);
 425         }
 426       else
 427         {
 428           val = unpack_long (type, valaddr + embedded_offset);
 429           if (TYPE_UNSIGNED (type))
 430             fprintf_filtered (stream, "%u", (unsigned int) val);
 431           else
 432             fprintf_filtered (stream, "%d", (int) val);
 433           fputs_filtered (" ", stream);
 434           LA_PRINT_CHAR ((unsigned char) val, type, stream);
 435         }
 436       break;
 437
 438     case TYPE_CODE_FLT:
 439       if (options->format)
 440         {
 441           print_scalar_formatted (valaddr + embedded_offset, type,
 442                                   options, 0, stream);
 443         }
 444       else
 445         {
 446           print_floating (valaddr + embedded_offset, type, stream);
 447         }
 448       break;
 449
 450     case TYPE_CODE_BITSTRING:
 451     case TYPE_CODE_SET:
 452       elttype = TYPE_INDEX_TYPE (type);
 453       CHECK_TYPEDEF (elttype);
 454       if (TYPE_STUB (elttype))
 455         {
 456           fprintf_filtered (stream, "<incomplete type>");
 457           gdb_flush (stream);
 458           break;
 459         }
 460       else
 461         {
 462           struct type *range = elttype;
 463           LONGEST low_bound, high_bound;
 464           int i;
 465           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
 466           int need_comma = 0;
 467
 468           if (is_bitstring)
 469             fputs_filtered ("B'", stream);
 470           else
 471             fputs_filtered ("[", stream);
 472
 473           i = get_discrete_bounds (range, &low_bound, &high_bound);
 474         maybe_bad_bstring:
 475           if (i < 0)
 476             {
 477               fputs_filtered ("<error value>", stream);
 478               goto done;
 479             }
 480
 481           for (i = low_bound; i <= high_bound; i++)
 482             {
 483               int element = value_bit_index (type, valaddr + embedded_offset, i);
 484               if (element < 0)
 485                 {
 486                   i = element;
 487                   goto maybe_bad_bstring;
 488                 }
 489               if (is_bitstring)
 490                 fprintf_filtered (stream, "%d", element);
 491               else if (element)
 492                 {
 493                   if (need_comma)
 494                     fputs_filtered (", ", stream);
 495                   print_type_scalar (range, i, stream);
 496                   need_comma = 1;
 497
 498                   if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
 499                     {
 500                       int j = i;
 501                       fputs_filtered ("..", stream);
 502                       while (i + 1 <= high_bound
 503                              && value_bit_index (type, valaddr + embedded_offset, ++i))
 504                         j = i;
 505                       print_type_scalar (range, j, stream);
 506                     }
 507                 }
 508             }
 509         done:
 510           if (is_bitstring)
 511             fputs_filtered ("'", stream);
 512           else
 513             fputs_filtered ("]", stream);
 514         }
 515       break;
 516
 517     case TYPE_CODE_VOID:
 518       fprintf_filtered (stream, "void");
 519       break;
 520
 521     case TYPE_CODE_ERROR:
 522       fprintf_filtered (stream, "<error type>");
 523       break;
 524
 525     case TYPE_CODE_UNDEF:
 526       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 527          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 528          and no complete type for struct foo in that file.  */
 529       fprintf_filtered (stream, "<incomplete type>");
 530       break;
 531
 532     default:
 533       error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
 534     }
 535   gdb_flush (stream);
 536   return (0);
 537 }
 538 \f
 539 int
 540 pascal_value_print (struct value *val, struct ui_file *stream,
 541                     const struct value_print_options *options)
 542 {
 543   struct type *type = value_type (val);
 544
 545   /* If it is a pointer, indicate what it points to.
 546
 547      Print type also if it is a reference.
 548
 549      Object pascal: if it is a member pointer, we will take care
 550      of that when we print it.  */
 551   if (TYPE_CODE (type) == TYPE_CODE_PTR
 552       || TYPE_CODE (type) == TYPE_CODE_REF)
 553     {
 554       /* Hack:  remove (char *) for char strings.  Their
 555          type is indicated by the quoted string anyway. */
 556       if (TYPE_CODE (type) == TYPE_CODE_PTR
 557           && TYPE_NAME (type) == NULL
 558           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 559           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 560         {
 561           /* Print nothing */
 562         }
 563       else
 564         {
 565           fprintf_filtered (stream, "(");
 566           type_print (type, "", stream, -1);
 567           fprintf_filtered (stream, ") ");
 568         }
 569     }
 570   return common_val_print (val, stream, 0, options, current_language);
 571 }
 572
 573
 574 static void
 575 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 576                                 struct cmd_list_element *c, const char *value)
 577 {
 578   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 579                     value);
 580 }
 581
 582 static struct obstack dont_print_vb_obstack;
 583 static struct obstack dont_print_statmem_obstack;
 584
 585 static void pascal_object_print_static_field (struct value *,
 586                                               struct ui_file *, int,
 587                                               const struct value_print_options *);
 588
 589 static void pascal_object_print_value (struct type *, const gdb_byte *,
 590                                        CORE_ADDR, struct ui_file *, int,
 591                                        const struct value_print_options *,
 592                                        struct type **);
 593
 594 /* It was changed to this after 2.4.5.  */
 595 const char pascal_vtbl_ptr_name[] =
 596 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 597
 598 /* Return truth value for assertion that TYPE is of the type
 599    "pointer to virtual function".  */
 600
 601 int
 602 pascal_object_is_vtbl_ptr_type (struct type *type)
 603 {
 604   char *typename = type_name_no_tag (type);
 605
 606   return (typename != NULL
 607           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 608 }
 609
 610 /* Return truth value for the assertion that TYPE is of the type
 611    "pointer to virtual function table".  */
 612
 613 int
 614 pascal_object_is_vtbl_member (struct type *type)
 615 {
 616   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 617     {
 618       type = TYPE_TARGET_TYPE (type);
 619       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 620         {
 621           type = TYPE_TARGET_TYPE (type);
 622           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
 623               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
 624             {
 625               /* Virtual functions tables are full of pointers
 626                  to virtual functions. */
 627               return pascal_object_is_vtbl_ptr_type (type);
 628             }
 629         }
 630     }
 631   return 0;
 632 }
 633
 634 /* Mutually recursive subroutines of pascal_object_print_value and
 635    c_val_print to print out a structure's fields:
 636    pascal_object_print_value_fields and pascal_object_print_value.
 637
 638    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 639    same meanings as in pascal_object_print_value and c_val_print.
 640
 641    DONT_PRINT is an array of baseclass types that we
 642    should not print, or zero if called from top level.  */
 643
 644 void
 645 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 646                                   CORE_ADDR address, struct ui_file *stream,
 647                                   int recurse,
 648                                   const struct value_print_options *options,
 649                                   struct type **dont_print_vb,
 650                                   int dont_print_statmem)
 651 {
 652   int i, len, n_baseclasses;
 653   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 654
 655   CHECK_TYPEDEF (type);
 656
 657   fprintf_filtered (stream, "{");
 658   len = TYPE_NFIELDS (type);
 659   n_baseclasses = TYPE_N_BASECLASSES (type);
 660
 661   /* Print out baseclasses such that we don't print
 662      duplicates of virtual baseclasses.  */
 663   if (n_baseclasses > 0)
 664     pascal_object_print_value (type, valaddr, address, stream,
 665                                recurse + 1, options, dont_print_vb);
 666
 667   if (!len && n_baseclasses == 1)
 668     fprintf_filtered (stream, "<No data fields>");
 669   else
 670     {
 671       struct obstack tmp_obstack = dont_print_statmem_obstack;
 672       int fields_seen = 0;
 673
 674       if (dont_print_statmem == 0)
 675         {
 676           /* If we're at top level, carve out a completely fresh
 677              chunk of the obstack and use that until this particular
 678              invocation returns.  */
 679           obstack_finish (&dont_print_statmem_obstack);
 680         }
 681
 682       for (i = n_baseclasses; i < len; i++)
 683         {
 684           /* If requested, skip printing of static fields.  */
 685           if (!options->pascal_static_field_print
 686               && field_is_static (&TYPE_FIELD (type, i)))
 687             continue;
 688           if (fields_seen)
 689             fprintf_filtered (stream, ", ");
 690           else if (n_baseclasses > 0)
 691             {
 692               if (options->pretty)
 693                 {
 694                   fprintf_filtered (stream, "\n");
 695                   print_spaces_filtered (2 + 2 * recurse, stream);
 696                   fputs_filtered ("members of ", stream);
 697                   fputs_filtered (type_name_no_tag (type), stream);
 698                   fputs_filtered (": ", stream);
 699                 }
 700             }
 701           fields_seen = 1;
 702
 703           if (options->pretty)
 704             {
 705               fprintf_filtered (stream, "\n");
 706               print_spaces_filtered (2 + 2 * recurse, stream);
 707             }
 708           else
 709             {
 710               wrap_here (n_spaces (2 + 2 * recurse));
 711             }
 712           if (options->inspect_it)
 713             {
 714               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 715                 fputs_filtered ("\"( ptr \"", stream);
 716               else
 717                 fputs_filtered ("\"( nodef \"", stream);
 718               if (field_is_static (&TYPE_FIELD (type, i)))
 719                 fputs_filtered ("static ", stream);
 720               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 721                                        language_cplus,
 722                                        DMGL_PARAMS | DMGL_ANSI);
 723               fputs_filtered ("\" \"", stream);
 724               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 725                                        language_cplus,
 726                                        DMGL_PARAMS | DMGL_ANSI);
 727               fputs_filtered ("\") \"", stream);
 728             }
 729           else
 730             {
 731               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 732
 733               if (field_is_static (&TYPE_FIELD (type, i)))
 734                 fputs_filtered ("static ", stream);
 735               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 736                                        language_cplus,
 737                                        DMGL_PARAMS | DMGL_ANSI);
 738               annotate_field_name_end ();
 739               fputs_filtered (" = ", stream);
 740               annotate_field_value ();
 741             }
 742
 743           if (!field_is_static (&TYPE_FIELD (type, i))
 744               && TYPE_FIELD_PACKED (type, i))
 745             {
 746               struct value *v;
 747
 748               /* Bitfields require special handling, especially due to byte
 749                  order problems.  */
 750               if (TYPE_FIELD_IGNORE (type, i))
 751                 {
 752                   fputs_filtered ("<optimized out or zero length>", stream);
 753                 }
 754               else
 755                 {
 756                   struct value_print_options opts = *options;
 757                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 758                                    unpack_field_as_long (type, valaddr, i));
 759
 760                   opts.deref_ref = 0;
 761                   common_val_print (v, stream, recurse + 1, &opts,
 762                                     current_language);
 763                 }
 764             }
 765           else
 766             {
 767               if (TYPE_FIELD_IGNORE (type, i))
 768                 {
 769                   fputs_filtered ("<optimized out or zero length>", stream);
 770                 }
 771               else if (field_is_static (&TYPE_FIELD (type, i)))
 772                 {
 773                   /* struct value *v = value_static_field (type, i); v4.17 specific */
 774                   struct value *v;
 775                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 776                                    unpack_field_as_long (type, valaddr, i));
 777
 778                   if (v == NULL)
 779                     fputs_filtered ("<optimized out>", stream);
 780                   else
 781                     pascal_object_print_static_field (v, stream, recurse + 1,
 782                                                       options);
 783                 }
 784               else
 785                 {
 786                   struct value_print_options opts = *options;
 787                   opts.deref_ref = 0;
 788                   /* val_print (TYPE_FIELD_TYPE (type, i),
 789                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 790                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 791                      stream, format, 0, recurse + 1, pretty); */
 792                   val_print (TYPE_FIELD_TYPE (type, i),
 793                              valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
 794                              address + TYPE_FIELD_BITPOS (type, i) / 8,
 795                              stream, recurse + 1, &opts,
 796                              current_language);
 797                 }
 798             }
 799           annotate_field_end ();
 800         }
 801
 802       if (dont_print_statmem == 0)
 803         {
 804           /* Free the space used to deal with the printing
 805              of the members from top level.  */
 806           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 807           dont_print_statmem_obstack = tmp_obstack;
 808         }
 809
 810       if (options->pretty)
 811         {
 812           fprintf_filtered (stream, "\n");
 813           print_spaces_filtered (2 * recurse, stream);
 814         }
 815     }
 816   fprintf_filtered (stream, "}");
 817 }
 818
 819 /* Special val_print routine to avoid printing multiple copies of virtual
 820    baseclasses.  */
 821
 822 static void
 823 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 824                            CORE_ADDR address, struct ui_file *stream,
 825                            int recurse,
 826                            const struct value_print_options *options,
 827                            struct type **dont_print_vb)
 828 {
 829   struct type **last_dont_print
 830   = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 831   struct obstack tmp_obstack = dont_print_vb_obstack;
 832   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 833
 834   if (dont_print_vb == 0)
 835     {
 836       /* If we're at top level, carve out a completely fresh
 837          chunk of the obstack and use that until this particular
 838          invocation returns.  */
 839       /* Bump up the high-water mark.  Now alpha is omega.  */
 840       obstack_finish (&dont_print_vb_obstack);
 841     }
 842
 843   for (i = 0; i < n_baseclasses; i++)
 844     {
 845       int boffset;
 846       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 847       char *basename = type_name_no_tag (baseclass);
 848       const gdb_byte *base_valaddr;
 849
 850       if (BASETYPE_VIA_VIRTUAL (type, i))
 851         {
 852           struct type **first_dont_print
 853           = (struct type **) obstack_base (&dont_print_vb_obstack);
 854
 855           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 856           - first_dont_print;
 857
 858           while (--j >= 0)
 859             if (baseclass == first_dont_print[j])
 860               goto flush_it;
 861
 862           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 863         }
 864
 865       boffset = baseclass_offset (type, i, valaddr, address);
 866
 867       if (options->pretty)
 868         {
 869           fprintf_filtered (stream, "\n");
 870           print_spaces_filtered (2 * recurse, stream);
 871         }
 872       fputs_filtered ("<", stream);
 873       /* Not sure what the best notation is in the case where there is no
 874          baseclass name.  */
 875
 876       fputs_filtered (basename ? basename : "", stream);
 877       fputs_filtered ("> = ", stream);
 878
 879       /* The virtual base class pointer might have been clobbered by the
 880          user program. Make sure that it still points to a valid memory
 881          location.  */
 882
 883       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 884         {
 885           /* FIXME (alloc): not safe is baseclass is really really big. */
 886           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 887           base_valaddr = buf;
 888           if (target_read_memory (address + boffset, buf,
 889                                   TYPE_LENGTH (baseclass)) != 0)
 890             boffset = -1;
 891         }
 892       else
 893         base_valaddr = valaddr + boffset;
 894
 895       if (boffset == -1)
 896         fprintf_filtered (stream, "<invalid address>");
 897       else
 898         pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
 899                                           stream, recurse, options,
 900                      (struct type **) obstack_base (&dont_print_vb_obstack),
 901                                           0);
 902       fputs_filtered (", ", stream);
 903
 904     flush_it:
 905       ;
 906     }
 907
 908   if (dont_print_vb == 0)
 909     {
 910       /* Free the space used to deal with the printing
 911          of this type from top level.  */
 912       obstack_free (&dont_print_vb_obstack, last_dont_print);
 913       /* Reset watermark so that we can continue protecting
 914          ourselves from whatever we were protecting ourselves.  */
 915       dont_print_vb_obstack = tmp_obstack;
 916     }
 917 }
 918
 919 /* Print value of a static member.
 920    To avoid infinite recursion when printing a class that contains
 921    a static instance of the class, we keep the addresses of all printed
 922    static member classes in an obstack and refuse to print them more
 923    than once.
 924
 925    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 926    have the same meanings as in c_val_print.  */
 927
 928 static void
 929 pascal_object_print_static_field (struct value *val,
 930                                   struct ui_file *stream,
 931                                   int recurse,
 932                                   const struct value_print_options *options)
 933 {
 934   struct type *type = value_type (val);
 935   struct value_print_options opts;
 936
 937   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 938     {
 939       CORE_ADDR *first_dont_print, addr;
 940       int i;
 941
 942       first_dont_print
 943         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 944       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 945         - first_dont_print;
 946
 947       while (--i >= 0)
 948         {
 949           if (value_address (val) == first_dont_print[i])
 950             {
 951               fputs_filtered ("<same as static member of an already seen type>",
 952                               stream);
 953               return;
 954             }
 955         }
 956
 957       addr = value_address (val);
 958       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 959                     sizeof (CORE_ADDR));
 960
 961       CHECK_TYPEDEF (type);
 962       pascal_object_print_value_fields (type, value_contents (val), addr,
 963                                         stream, recurse, options, NULL, 1);
 964       return;
 965     }
 966
 967   opts = *options;
 968   opts.deref_ref = 0;
 969   common_val_print (val, stream, recurse, &opts, current_language);
 970 }
 971
 972 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
 973
 974 void
 975 _initialize_pascal_valprint (void)
 976 {
 977   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 978                            &user_print_options.pascal_static_field_print, _("\
 979 Set printing of pascal static members."), _("\
 980 Show printing of pascal static members."), NULL,
 981                            NULL,
 982                            show_pascal_static_field_print,
 983                            &setprintlist, &showprintlist);
 984 }