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, NULL, 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,
 310                                valaddr + embedded_offset + string_pos,
 311                                len, NULL, 0, options);
 312             }
 313           else
 314             pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream,
 315                                               recurse, options, NULL, 0);
 316         }
 317       break;
 318
 319     case TYPE_CODE_ENUM:
 320       if (options->format)
 321         {
 322           print_scalar_formatted (valaddr + embedded_offset, type,
 323                                   options, 0, stream);
 324           break;
 325         }
 326       len = TYPE_NFIELDS (type);
 327       val = unpack_long (type, valaddr + embedded_offset);
 328       for (i = 0; i < len; i++)
 329         {
 330           QUIT;
 331           if (val == TYPE_FIELD_BITPOS (type, i))
 332             {
 333               break;
 334             }
 335         }
 336       if (i < len)
 337         {
 338           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 339         }
 340       else
 341         {
 342           print_longest (stream, 'd', 0, val);
 343         }
 344       break;
 345
 346     case TYPE_CODE_FLAGS:
 347       if (options->format)
 348           print_scalar_formatted (valaddr + embedded_offset, type,
 349                                   options, 0, stream);
 350       else
 351         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
 352       break;
 353
 354     case TYPE_CODE_FUNC:
 355       if (options->format)
 356         {
 357           print_scalar_formatted (valaddr + embedded_offset, type,
 358                                   options, 0, stream);
 359           break;
 360         }
 361       /* FIXME, we should consider, at least for ANSI C language, eliminating
 362          the distinction made between FUNCs and POINTERs to FUNCs.  */
 363       fprintf_filtered (stream, "{");
 364       type_print (type, "", stream, -1);
 365       fprintf_filtered (stream, "} ");
 366       /* Try to print what function it points to, and its address.  */
 367       print_address_demangle (gdbarch, address, stream, demangle);
 368       break;
 369
 370     case TYPE_CODE_BOOL:
 371       if (options->format || options->output_format)
 372         {
 373           struct value_print_options opts = *options;
 374           opts.format = (options->format ? options->format
 375                          : options->output_format);
 376           print_scalar_formatted (valaddr + embedded_offset, type,
 377                                   &opts, 0, stream);
 378         }
 379       else
 380         {
 381           val = unpack_long (type, valaddr + embedded_offset);
 382           if (val == 0)
 383             fputs_filtered ("false", stream);
 384           else if (val == 1)
 385             fputs_filtered ("true", stream);
 386           else
 387             {
 388               fputs_filtered ("true (", stream);
 389               fprintf_filtered (stream, "%ld)", (long int) val);
 390             }
 391         }
 392       break;
 393
 394     case TYPE_CODE_RANGE:
 395       /* FIXME: create_range_type does not set the unsigned bit in a
 396          range type (I think it probably should copy it from the target
 397          type), so we won't print values which are too large to
 398          fit in a signed integer correctly.  */
 399       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
 400          print with the target type, though, because the size of our type
 401          and the target type might differ).  */
 402       /* FALLTHROUGH */
 403
 404     case TYPE_CODE_INT:
 405       if (options->format || options->output_format)
 406         {
 407           struct value_print_options opts = *options;
 408           opts.format = (options->format ? options->format
 409                          : options->output_format);
 410           print_scalar_formatted (valaddr + embedded_offset, type,
 411                                   &opts, 0, stream);
 412         }
 413       else
 414         {
 415           val_print_type_code_int (type, valaddr + embedded_offset, stream);
 416         }
 417       break;
 418
 419     case TYPE_CODE_CHAR:
 420       if (options->format || options->output_format)
 421         {
 422           struct value_print_options opts = *options;
 423           opts.format = (options->format ? options->format
 424                          : options->output_format);
 425           print_scalar_formatted (valaddr + embedded_offset, type,
 426                                   &opts, 0, stream);
 427         }
 428       else
 429         {
 430           val = unpack_long (type, valaddr + embedded_offset);
 431           if (TYPE_UNSIGNED (type))
 432             fprintf_filtered (stream, "%u", (unsigned int) val);
 433           else
 434             fprintf_filtered (stream, "%d", (int) val);
 435           fputs_filtered (" ", stream);
 436           LA_PRINT_CHAR ((unsigned char) val, type, stream);
 437         }
 438       break;
 439
 440     case TYPE_CODE_FLT:
 441       if (options->format)
 442         {
 443           print_scalar_formatted (valaddr + embedded_offset, type,
 444                                   options, 0, stream);
 445         }
 446       else
 447         {
 448           print_floating (valaddr + embedded_offset, type, stream);
 449         }
 450       break;
 451
 452     case TYPE_CODE_BITSTRING:
 453     case TYPE_CODE_SET:
 454       elttype = TYPE_INDEX_TYPE (type);
 455       CHECK_TYPEDEF (elttype);
 456       if (TYPE_STUB (elttype))
 457         {
 458           fprintf_filtered (stream, "<incomplete type>");
 459           gdb_flush (stream);
 460           break;
 461         }
 462       else
 463         {
 464           struct type *range = elttype;
 465           LONGEST low_bound, high_bound;
 466           int i;
 467           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
 468           int need_comma = 0;
 469
 470           if (is_bitstring)
 471             fputs_filtered ("B'", stream);
 472           else
 473             fputs_filtered ("[", stream);
 474
 475           i = get_discrete_bounds (range, &low_bound, &high_bound);
 476         maybe_bad_bstring:
 477           if (i < 0)
 478             {
 479               fputs_filtered ("<error value>", stream);
 480               goto done;
 481             }
 482
 483           for (i = low_bound; i <= high_bound; i++)
 484             {
 485               int element = value_bit_index (type, valaddr + embedded_offset, i);
 486               if (element < 0)
 487                 {
 488                   i = element;
 489                   goto maybe_bad_bstring;
 490                 }
 491               if (is_bitstring)
 492                 fprintf_filtered (stream, "%d", element);
 493               else if (element)
 494                 {
 495                   if (need_comma)
 496                     fputs_filtered (", ", stream);
 497                   print_type_scalar (range, i, stream);
 498                   need_comma = 1;
 499
 500                   if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
 501                     {
 502                       int j = i;
 503                       fputs_filtered ("..", stream);
 504                       while (i + 1 <= high_bound
 505                              && value_bit_index (type, valaddr + embedded_offset, ++i))
 506                         j = i;
 507                       print_type_scalar (range, j, stream);
 508                     }
 509                 }
 510             }
 511         done:
 512           if (is_bitstring)
 513             fputs_filtered ("'", stream);
 514           else
 515             fputs_filtered ("]", stream);
 516         }
 517       break;
 518
 519     case TYPE_CODE_VOID:
 520       fprintf_filtered (stream, "void");
 521       break;
 522
 523     case TYPE_CODE_ERROR:
 524       fprintf_filtered (stream, "<error type>");
 525       break;
 526
 527     case TYPE_CODE_UNDEF:
 528       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 529          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 530          and no complete type for struct foo in that file.  */
 531       fprintf_filtered (stream, "<incomplete type>");
 532       break;
 533
 534     default:
 535       error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
 536     }
 537   gdb_flush (stream);
 538   return (0);
 539 }
 540 \f
 541 int
 542 pascal_value_print (struct value *val, struct ui_file *stream,
 543                     const struct value_print_options *options)
 544 {
 545   struct type *type = value_type (val);
 546
 547   /* If it is a pointer, indicate what it points to.
 548
 549      Print type also if it is a reference.
 550
 551      Object pascal: if it is a member pointer, we will take care
 552      of that when we print it.  */
 553   if (TYPE_CODE (type) == TYPE_CODE_PTR
 554       || TYPE_CODE (type) == TYPE_CODE_REF)
 555     {
 556       /* Hack:  remove (char *) for char strings.  Their
 557          type is indicated by the quoted string anyway. */
 558       if (TYPE_CODE (type) == TYPE_CODE_PTR
 559           && TYPE_NAME (type) == NULL
 560           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 561           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 562         {
 563           /* Print nothing */
 564         }
 565       else
 566         {
 567           fprintf_filtered (stream, "(");
 568           type_print (type, "", stream, -1);
 569           fprintf_filtered (stream, ") ");
 570         }
 571     }
 572   return common_val_print (val, stream, 0, options, current_language);
 573 }
 574
 575
 576 static void
 577 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 578                                 struct cmd_list_element *c, const char *value)
 579 {
 580   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 581                     value);
 582 }
 583
 584 static struct obstack dont_print_vb_obstack;
 585 static struct obstack dont_print_statmem_obstack;
 586
 587 static void pascal_object_print_static_field (struct value *,
 588                                               struct ui_file *, int,
 589                                               const struct value_print_options *);
 590
 591 static void pascal_object_print_value (struct type *, const gdb_byte *,
 592                                        CORE_ADDR, struct ui_file *, int,
 593                                        const struct value_print_options *,
 594                                        struct type **);
 595
 596 /* It was changed to this after 2.4.5.  */
 597 const char pascal_vtbl_ptr_name[] =
 598 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 599
 600 /* Return truth value for assertion that TYPE is of the type
 601    "pointer to virtual function".  */
 602
 603 int
 604 pascal_object_is_vtbl_ptr_type (struct type *type)
 605 {
 606   char *typename = type_name_no_tag (type);
 607
 608   return (typename != NULL
 609           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 610 }
 611
 612 /* Return truth value for the assertion that TYPE is of the type
 613    "pointer to virtual function table".  */
 614
 615 int
 616 pascal_object_is_vtbl_member (struct type *type)
 617 {
 618   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 619     {
 620       type = TYPE_TARGET_TYPE (type);
 621       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 622         {
 623           type = TYPE_TARGET_TYPE (type);
 624           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
 625               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
 626             {
 627               /* Virtual functions tables are full of pointers
 628                  to virtual functions. */
 629               return pascal_object_is_vtbl_ptr_type (type);
 630             }
 631         }
 632     }
 633   return 0;
 634 }
 635
 636 /* Mutually recursive subroutines of pascal_object_print_value and
 637    c_val_print to print out a structure's fields:
 638    pascal_object_print_value_fields and pascal_object_print_value.
 639
 640    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 641    same meanings as in pascal_object_print_value and c_val_print.
 642
 643    DONT_PRINT is an array of baseclass types that we
 644    should not print, or zero if called from top level.  */
 645
 646 void
 647 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 648                                   CORE_ADDR address, struct ui_file *stream,
 649                                   int recurse,
 650                                   const struct value_print_options *options,
 651                                   struct type **dont_print_vb,
 652                                   int dont_print_statmem)
 653 {
 654   int i, len, n_baseclasses;
 655   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 656
 657   CHECK_TYPEDEF (type);
 658
 659   fprintf_filtered (stream, "{");
 660   len = TYPE_NFIELDS (type);
 661   n_baseclasses = TYPE_N_BASECLASSES (type);
 662
 663   /* Print out baseclasses such that we don't print
 664      duplicates of virtual baseclasses.  */
 665   if (n_baseclasses > 0)
 666     pascal_object_print_value (type, valaddr, address, stream,
 667                                recurse + 1, options, dont_print_vb);
 668
 669   if (!len && n_baseclasses == 1)
 670     fprintf_filtered (stream, "<No data fields>");
 671   else
 672     {
 673       struct obstack tmp_obstack = dont_print_statmem_obstack;
 674       int fields_seen = 0;
 675
 676       if (dont_print_statmem == 0)
 677         {
 678           /* If we're at top level, carve out a completely fresh
 679              chunk of the obstack and use that until this particular
 680              invocation returns.  */
 681           obstack_finish (&dont_print_statmem_obstack);
 682         }
 683
 684       for (i = n_baseclasses; i < len; i++)
 685         {
 686           /* If requested, skip printing of static fields.  */
 687           if (!options->pascal_static_field_print
 688               && field_is_static (&TYPE_FIELD (type, i)))
 689             continue;
 690           if (fields_seen)
 691             fprintf_filtered (stream, ", ");
 692           else if (n_baseclasses > 0)
 693             {
 694               if (options->pretty)
 695                 {
 696                   fprintf_filtered (stream, "\n");
 697                   print_spaces_filtered (2 + 2 * recurse, stream);
 698                   fputs_filtered ("members of ", stream);
 699                   fputs_filtered (type_name_no_tag (type), stream);
 700                   fputs_filtered (": ", stream);
 701                 }
 702             }
 703           fields_seen = 1;
 704
 705           if (options->pretty)
 706             {
 707               fprintf_filtered (stream, "\n");
 708               print_spaces_filtered (2 + 2 * recurse, stream);
 709             }
 710           else
 711             {
 712               wrap_here (n_spaces (2 + 2 * recurse));
 713             }
 714           if (options->inspect_it)
 715             {
 716               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 717                 fputs_filtered ("\"( ptr \"", stream);
 718               else
 719                 fputs_filtered ("\"( nodef \"", stream);
 720               if (field_is_static (&TYPE_FIELD (type, i)))
 721                 fputs_filtered ("static ", stream);
 722               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 723                                        language_cplus,
 724                                        DMGL_PARAMS | DMGL_ANSI);
 725               fputs_filtered ("\" \"", stream);
 726               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 727                                        language_cplus,
 728                                        DMGL_PARAMS | DMGL_ANSI);
 729               fputs_filtered ("\") \"", stream);
 730             }
 731           else
 732             {
 733               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 734
 735               if (field_is_static (&TYPE_FIELD (type, i)))
 736                 fputs_filtered ("static ", stream);
 737               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 738                                        language_cplus,
 739                                        DMGL_PARAMS | DMGL_ANSI);
 740               annotate_field_name_end ();
 741               fputs_filtered (" = ", stream);
 742               annotate_field_value ();
 743             }
 744
 745           if (!field_is_static (&TYPE_FIELD (type, i))
 746               && TYPE_FIELD_PACKED (type, i))
 747             {
 748               struct value *v;
 749
 750               /* Bitfields require special handling, especially due to byte
 751                  order problems.  */
 752               if (TYPE_FIELD_IGNORE (type, i))
 753                 {
 754                   fputs_filtered ("<optimized out or zero length>", stream);
 755                 }
 756               else
 757                 {
 758                   struct value_print_options opts = *options;
 759                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 760                                    unpack_field_as_long (type, valaddr, i));
 761
 762                   opts.deref_ref = 0;
 763                   common_val_print (v, stream, recurse + 1, &opts,
 764                                     current_language);
 765                 }
 766             }
 767           else
 768             {
 769               if (TYPE_FIELD_IGNORE (type, i))
 770                 {
 771                   fputs_filtered ("<optimized out or zero length>", stream);
 772                 }
 773               else if (field_is_static (&TYPE_FIELD (type, i)))
 774                 {
 775                   /* struct value *v = value_static_field (type, i); v4.17 specific */
 776                   struct value *v;
 777                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 778                                    unpack_field_as_long (type, valaddr, i));
 779
 780                   if (v == NULL)
 781                     fputs_filtered ("<optimized out>", stream);
 782                   else
 783                     pascal_object_print_static_field (v, stream, recurse + 1,
 784                                                       options);
 785                 }
 786               else
 787                 {
 788                   struct value_print_options opts = *options;
 789                   opts.deref_ref = 0;
 790                   /* val_print (TYPE_FIELD_TYPE (type, i),
 791                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 792                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 793                      stream, format, 0, recurse + 1, pretty); */
 794                   val_print (TYPE_FIELD_TYPE (type, i),
 795                              valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
 796                              address + TYPE_FIELD_BITPOS (type, i) / 8,
 797                              stream, recurse + 1, &opts,
 798                              current_language);
 799                 }
 800             }
 801           annotate_field_end ();
 802         }
 803
 804       if (dont_print_statmem == 0)
 805         {
 806           /* Free the space used to deal with the printing
 807              of the members from top level.  */
 808           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 809           dont_print_statmem_obstack = tmp_obstack;
 810         }
 811
 812       if (options->pretty)
 813         {
 814           fprintf_filtered (stream, "\n");
 815           print_spaces_filtered (2 * recurse, stream);
 816         }
 817     }
 818   fprintf_filtered (stream, "}");
 819 }
 820
 821 /* Special val_print routine to avoid printing multiple copies of virtual
 822    baseclasses.  */
 823
 824 static void
 825 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 826                            CORE_ADDR address, struct ui_file *stream,
 827                            int recurse,
 828                            const struct value_print_options *options,
 829                            struct type **dont_print_vb)
 830 {
 831   struct type **last_dont_print
 832   = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 833   struct obstack tmp_obstack = dont_print_vb_obstack;
 834   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 835
 836   if (dont_print_vb == 0)
 837     {
 838       /* If we're at top level, carve out a completely fresh
 839          chunk of the obstack and use that until this particular
 840          invocation returns.  */
 841       /* Bump up the high-water mark.  Now alpha is omega.  */
 842       obstack_finish (&dont_print_vb_obstack);
 843     }
 844
 845   for (i = 0; i < n_baseclasses; i++)
 846     {
 847       int boffset;
 848       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 849       char *basename = type_name_no_tag (baseclass);
 850       const gdb_byte *base_valaddr;
 851
 852       if (BASETYPE_VIA_VIRTUAL (type, i))
 853         {
 854           struct type **first_dont_print
 855           = (struct type **) obstack_base (&dont_print_vb_obstack);
 856
 857           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 858           - first_dont_print;
 859
 860           while (--j >= 0)
 861             if (baseclass == first_dont_print[j])
 862               goto flush_it;
 863
 864           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 865         }
 866
 867       boffset = baseclass_offset (type, i, valaddr, address);
 868
 869       if (options->pretty)
 870         {
 871           fprintf_filtered (stream, "\n");
 872           print_spaces_filtered (2 * recurse, stream);
 873         }
 874       fputs_filtered ("<", stream);
 875       /* Not sure what the best notation is in the case where there is no
 876          baseclass name.  */
 877
 878       fputs_filtered (basename ? basename : "", stream);
 879       fputs_filtered ("> = ", stream);
 880
 881       /* The virtual base class pointer might have been clobbered by the
 882          user program. Make sure that it still points to a valid memory
 883          location.  */
 884
 885       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 886         {
 887           /* FIXME (alloc): not safe is baseclass is really really big. */
 888           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 889           base_valaddr = buf;
 890           if (target_read_memory (address + boffset, buf,
 891                                   TYPE_LENGTH (baseclass)) != 0)
 892             boffset = -1;
 893         }
 894       else
 895         base_valaddr = valaddr + boffset;
 896
 897       if (boffset == -1)
 898         fprintf_filtered (stream, "<invalid address>");
 899       else
 900         pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
 901                                           stream, recurse, options,
 902                      (struct type **) obstack_base (&dont_print_vb_obstack),
 903                                           0);
 904       fputs_filtered (", ", stream);
 905
 906     flush_it:
 907       ;
 908     }
 909
 910   if (dont_print_vb == 0)
 911     {
 912       /* Free the space used to deal with the printing
 913          of this type from top level.  */
 914       obstack_free (&dont_print_vb_obstack, last_dont_print);
 915       /* Reset watermark so that we can continue protecting
 916          ourselves from whatever we were protecting ourselves.  */
 917       dont_print_vb_obstack = tmp_obstack;
 918     }
 919 }
 920
 921 /* Print value of a static member.
 922    To avoid infinite recursion when printing a class that contains
 923    a static instance of the class, we keep the addresses of all printed
 924    static member classes in an obstack and refuse to print them more
 925    than once.
 926
 927    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 928    have the same meanings as in c_val_print.  */
 929
 930 static void
 931 pascal_object_print_static_field (struct value *val,
 932                                   struct ui_file *stream,
 933                                   int recurse,
 934                                   const struct value_print_options *options)
 935 {
 936   struct type *type = value_type (val);
 937   struct value_print_options opts;
 938
 939   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 940     {
 941       CORE_ADDR *first_dont_print, addr;
 942       int i;
 943
 944       first_dont_print
 945         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 946       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 947         - first_dont_print;
 948
 949       while (--i >= 0)
 950         {
 951           if (value_address (val) == first_dont_print[i])
 952             {
 953               fputs_filtered ("<same as static member of an already seen type>",
 954                               stream);
 955               return;
 956             }
 957         }
 958
 959       addr = value_address (val);
 960       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 961                     sizeof (CORE_ADDR));
 962
 963       CHECK_TYPEDEF (type);
 964       pascal_object_print_value_fields (type, value_contents (val), addr,
 965                                         stream, recurse, options, NULL, 1);
 966       return;
 967     }
 968
 969   opts = *options;
 970   opts.deref_ref = 0;
 971   common_val_print (val, stream, recurse, &opts, current_language);
 972 }
 973
 974 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
 975
 976 void
 977 _initialize_pascal_valprint (void)
 978 {
 979   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 980                            &user_print_options.pascal_static_field_print, _("\
 981 Set printing of pascal static members."), _("\
 982 Show printing of pascal static members."), NULL,
 983                            NULL,
 984                            show_pascal_static_field_print,
 985                            &setprintlist, &showprintlist);
 986 }