gdb/p-valprint.c

   1 /* Support for printing Pascal values for GDB, the GNU debugger.
   2
   3    Copyright (C) 2000-2020 Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 /* This file is derived from c-valprint.c */
  21
  22 #include "defs.h"
  23 #include "gdb_obstack.h"
  24 #include "symtab.h"
  25 #include "gdbtypes.h"
  26 #include "expression.h"
  27 #include "value.h"
  28 #include "command.h"
  29 #include "gdbcmd.h"
  30 #include "gdbcore.h"
  31 #include "demangle.h"
  32 #include "valprint.h"
  33 #include "typeprint.h"
  34 #include "language.h"
  35 #include "target.h"
  36 #include "annotate.h"
  37 #include "p-lang.h"
  38 #include "cp-abi.h"
  39 #include "cp-support.h"
  40 #include "objfiles.h"
  41 #include "gdbsupport/byte-vector.h"
  42 #include "cli/cli-style.h"
  43 \f
  44
  45 static void pascal_object_print_value_fields (struct value *, struct ui_file *,
  46                                               int,
  47                                               const struct value_print_options *,
  48                                               struct type **, int);
  49
  50 /* Decorations for Pascal.  */
  51
  52 static const struct generic_val_print_decorations p_decorations =
  53 {
  54   "",
  55   " + ",
  56   " * I",
  57   "true",
  58   "false",
  59   "void",
  60   "{",
  61   "}"
  62 };
  63
  64 /* See p-lang.h.  */
  65
  66 void
  67 pascal_value_print_inner (struct value *val, struct ui_file *stream,
  68                           int recurse,
  69                           const struct value_print_options *options)
  70
  71 {
  72   struct type *type = check_typedef (value_type (val));
  73   struct gdbarch *gdbarch = get_type_arch (type);
  74   enum bfd_endian byte_order = type_byte_order (type);
  75   unsigned int i = 0;   /* Number of characters printed */
  76   unsigned len;
  77   struct type *elttype;
  78   unsigned eltlen;
  79   int length_pos, length_size, string_pos;
  80   struct type *char_type;
  81   CORE_ADDR addr;
  82   int want_space = 0;
  83   const gdb_byte *valaddr = value_contents_for_printing (val);
  84
  85   switch (type->code ())
  86     {
  87     case TYPE_CODE_ARRAY:
  88       {
  89         LONGEST low_bound, high_bound;
  90
  91         if (get_array_bounds (type, &low_bound, &high_bound))
  92           {
  93             len = high_bound - low_bound + 1;
  94             elttype = check_typedef (TYPE_TARGET_TYPE (type));
  95             eltlen = TYPE_LENGTH (elttype);
  96             /* If 's' format is used, try to print out as string.
  97                If no format is given, print as string if element type
  98                is of TYPE_CODE_CHAR and element size is 1,2 or 4.  */
  99             if (options->format == 's'
 100                 || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
 101                     && elttype->code () == TYPE_CODE_CHAR
 102                     && options->format == 0))
 103               {
 104                 /* If requested, look for the first null char and only print
 105                    elements up to it.  */
 106                 if (options->stop_print_at_null)
 107                   {
 108                     unsigned int temp_len;
 109
 110                     /* Look for a NULL char.  */
 111                     for (temp_len = 0;
 112                          extract_unsigned_integer (valaddr + temp_len * eltlen,
 113                                                    eltlen, byte_order)
 114                            && temp_len < len && temp_len < options->print_max;
 115                          temp_len++);
 116                     len = temp_len;
 117                   }
 118
 119                 LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
 120                                  valaddr, len, NULL, 0, options);
 121                 i = len;
 122               }
 123             else
 124               {
 125                 fprintf_filtered (stream, "{");
 126                 /* If this is a virtual function table, print the 0th
 127                    entry specially, and the rest of the members normally.  */
 128                 if (pascal_object_is_vtbl_ptr_type (elttype))
 129                   {
 130                     i = 1;
 131                     fprintf_filtered (stream, "%d vtable entries", len - 1);
 132                   }
 133                 else
 134                   {
 135                     i = 0;
 136                   }
 137                 value_print_array_elements (val, stream, recurse, options, i);
 138                 fprintf_filtered (stream, "}");
 139               }
 140             break;
 141           }
 142         /* Array of unspecified length: treat like pointer to first elt.  */
 143         addr = value_address (val);
 144       }
 145       goto print_unpacked_pointer;
 146
 147     case TYPE_CODE_PTR:
 148       if (options->format && options->format != 's')
 149         {
 150           value_print_scalar_formatted (val, options, 0, stream);
 151           break;
 152         }
 153       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 154         {
 155           /* Print the unmangled name if desired.  */
 156           /* Print vtable entry - we only get here if we ARE using
 157              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.)  */
 158           /* Extract the address, assume that it is unsigned.  */
 159           addr = extract_unsigned_integer (valaddr,
 160                                            TYPE_LENGTH (type), byte_order);
 161           print_address_demangle (options, gdbarch, addr, stream, demangle);
 162           break;
 163         }
 164       check_typedef (TYPE_TARGET_TYPE (type));
 165
 166       addr = unpack_pointer (type, valaddr);
 167     print_unpacked_pointer:
 168       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 169
 170       if (elttype->code () == TYPE_CODE_FUNC)
 171         {
 172           /* Try to print what function it points to.  */
 173           print_address_demangle (options, gdbarch, addr, stream, demangle);
 174           return;
 175         }
 176
 177       if (options->addressprint && options->format != 's')
 178         {
 179           fputs_filtered (paddress (gdbarch, addr), stream);
 180           want_space = 1;
 181         }
 182
 183       /* For a pointer to char or unsigned char, also print the string
 184          pointed to, unless pointer is null.  */
 185       if (((TYPE_LENGTH (elttype) == 1
 186            && (elttype->code () == TYPE_CODE_INT
 187                || elttype->code () == TYPE_CODE_CHAR))
 188            || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
 189                && elttype->code () == TYPE_CODE_CHAR))
 190           && (options->format == 0 || options->format == 's')
 191           && addr != 0)
 192         {
 193           if (want_space)
 194             fputs_filtered (" ", stream);
 195           /* No wide string yet.  */
 196           i = val_print_string (elttype, NULL, addr, -1, stream, options);
 197         }
 198       /* Also for pointers to pascal strings.  */
 199       /* Note: this is Free Pascal specific:
 200          as GDB does not recognize stabs pascal strings
 201          Pascal strings are mapped to records
 202          with lowercase names PM.  */
 203       if (is_pascal_string_type (elttype, &length_pos, &length_size,
 204                                  &string_pos, &char_type, NULL)
 205           && addr != 0)
 206         {
 207           ULONGEST string_length;
 208           gdb_byte *buffer;
 209
 210           if (want_space)
 211             fputs_filtered (" ", stream);
 212           buffer = (gdb_byte *) xmalloc (length_size);
 213           read_memory (addr + length_pos, buffer, length_size);
 214           string_length = extract_unsigned_integer (buffer, length_size,
 215                                                     byte_order);
 216           xfree (buffer);
 217           i = val_print_string (char_type, NULL,
 218                                 addr + string_pos, string_length,
 219                                 stream, options);
 220         }
 221       else if (pascal_object_is_vtbl_member (type))
 222         {
 223           /* Print vtbl's nicely.  */
 224           CORE_ADDR vt_address = unpack_pointer (type, valaddr);
 225           struct bound_minimal_symbol msymbol =
 226             lookup_minimal_symbol_by_pc (vt_address);
 227
 228           /* If 'symbol_print' is set, we did the work above.  */
 229           if (!options->symbol_print
 230               && (msymbol.minsym != NULL)
 231               && (vt_address == BMSYMBOL_VALUE_ADDRESS (msymbol)))
 232             {
 233               if (want_space)
 234                 fputs_filtered (" ", stream);
 235               fputs_filtered ("<", stream);
 236               fputs_filtered (msymbol.minsym->print_name (), stream);
 237               fputs_filtered (">", stream);
 238               want_space = 1;
 239             }
 240           if (vt_address && options->vtblprint)
 241             {
 242               struct value *vt_val;
 243               struct symbol *wsym = NULL;
 244               struct type *wtype;
 245
 246               if (want_space)
 247                 fputs_filtered (" ", stream);
 248
 249               if (msymbol.minsym != NULL)
 250                 {
 251                   const char *search_name = msymbol.minsym->search_name ();
 252                   wsym = lookup_symbol_search_name (search_name, NULL,
 253                                                     VAR_DOMAIN).symbol;
 254                 }
 255
 256               if (wsym)
 257                 {
 258                   wtype = SYMBOL_TYPE (wsym);
 259                 }
 260               else
 261                 {
 262                   wtype = TYPE_TARGET_TYPE (type);
 263                 }
 264               vt_val = value_at (wtype, vt_address);
 265               common_val_print (vt_val, stream, recurse + 1, options,
 266                                 current_language);
 267               if (options->prettyformat)
 268                 {
 269                   fprintf_filtered (stream, "\n");
 270                   print_spaces_filtered (2 + 2 * recurse, stream);
 271                 }
 272             }
 273         }
 274
 275       return;
 276
 277     case TYPE_CODE_REF:
 278     case TYPE_CODE_ENUM:
 279     case TYPE_CODE_FLAGS:
 280     case TYPE_CODE_FUNC:
 281     case TYPE_CODE_RANGE:
 282     case TYPE_CODE_INT:
 283     case TYPE_CODE_FLT:
 284     case TYPE_CODE_VOID:
 285     case TYPE_CODE_ERROR:
 286     case TYPE_CODE_UNDEF:
 287     case TYPE_CODE_BOOL:
 288     case TYPE_CODE_CHAR:
 289       generic_value_print (val, stream, recurse, options, &p_decorations);
 290       break;
 291
 292     case TYPE_CODE_UNION:
 293       if (recurse && !options->unionprint)
 294         {
 295           fprintf_filtered (stream, "{...}");
 296           break;
 297         }
 298       /* Fall through.  */
 299     case TYPE_CODE_STRUCT:
 300       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 301         {
 302           /* Print the unmangled name if desired.  */
 303           /* Print vtable entry - we only get here if NOT using
 304              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.)  */
 305           /* Extract the address, assume that it is unsigned.  */
 306           print_address_demangle
 307             (options, gdbarch,
 308              extract_unsigned_integer (valaddr
 309                                        + TYPE_FIELD_BITPOS (type,
 310                                                             VTBL_FNADDR_OFFSET) / 8,
 311                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type,
 312                                                                      VTBL_FNADDR_OFFSET)),
 313                                        byte_order),
 314              stream, demangle);
 315         }
 316       else
 317         {
 318           if (is_pascal_string_type (type, &length_pos, &length_size,
 319                                      &string_pos, &char_type, NULL))
 320             {
 321               len = extract_unsigned_integer (valaddr + length_pos,
 322                                               length_size, byte_order);
 323               LA_PRINT_STRING (stream, char_type, valaddr + string_pos,
 324                                len, NULL, 0, options);
 325             }
 326           else
 327             pascal_object_print_value_fields (val, stream, recurse,
 328                                               options, NULL, 0);
 329         }
 330       break;
 331
 332     case TYPE_CODE_SET:
 333       elttype = TYPE_INDEX_TYPE (type);
 334       elttype = check_typedef (elttype);
 335       if (TYPE_STUB (elttype))
 336         {
 337           fprintf_styled (stream, metadata_style.style (), "<incomplete type>");
 338           break;
 339         }
 340       else
 341         {
 342           struct type *range = elttype;
 343           LONGEST low_bound, high_bound;
 344           int need_comma = 0;
 345
 346           fputs_filtered ("[", stream);
 347
 348           int bound_info = get_discrete_bounds (range, &low_bound, &high_bound);
 349           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
 350             {
 351               /* If we know the size of the set type, we can figure out the
 352               maximum value.  */
 353               bound_info = 0;
 354               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
 355               TYPE_HIGH_BOUND (range) = high_bound;
 356             }
 357         maybe_bad_bstring:
 358           if (bound_info < 0)
 359             {
 360               fputs_styled ("<error value>", metadata_style.style (), stream);
 361               goto done;
 362             }
 363
 364           for (i = low_bound; i <= high_bound; i++)
 365             {
 366               int element = value_bit_index (type, valaddr, i);
 367
 368               if (element < 0)
 369                 {
 370                   i = element;
 371                   goto maybe_bad_bstring;
 372                 }
 373               if (element)
 374                 {
 375                   if (need_comma)
 376                     fputs_filtered (", ", stream);
 377                   print_type_scalar (range, i, stream);
 378                   need_comma = 1;
 379
 380                   if (i + 1 <= high_bound
 381                       && value_bit_index (type, valaddr, ++i))
 382                     {
 383                       int j = i;
 384
 385                       fputs_filtered ("..", stream);
 386                       while (i + 1 <= high_bound
 387                              && value_bit_index (type, valaddr, ++i))
 388                         j = i;
 389                       print_type_scalar (range, j, stream);
 390                     }
 391                 }
 392             }
 393         done:
 394           fputs_filtered ("]", stream);
 395         }
 396       break;
 397
 398     default:
 399       error (_("Invalid pascal type code %d in symbol table."),
 400              type->code ());
 401     }
 402 }
 403
 404 \f
 405 void
 406 pascal_value_print (struct value *val, struct ui_file *stream,
 407                     const struct value_print_options *options)
 408 {
 409   struct type *type = value_type (val);
 410   struct value_print_options opts = *options;
 411
 412   opts.deref_ref = 1;
 413
 414   /* If it is a pointer, indicate what it points to.
 415
 416      Print type also if it is a reference.
 417
 418      Object pascal: if it is a member pointer, we will take care
 419      of that when we print it.  */
 420   if (type->code () == TYPE_CODE_PTR
 421       || type->code () == TYPE_CODE_REF)
 422     {
 423       /* Hack:  remove (char *) for char strings.  Their
 424          type is indicated by the quoted string anyway.  */
 425       if (type->code () == TYPE_CODE_PTR
 426           && type->name () == NULL
 427           && TYPE_TARGET_TYPE (type)->name () != NULL
 428           && strcmp (TYPE_TARGET_TYPE (type)->name (), "char") == 0)
 429         {
 430           /* Print nothing.  */
 431         }
 432       else
 433         {
 434           fprintf_filtered (stream, "(");
 435           type_print (type, "", stream, -1);
 436           fprintf_filtered (stream, ") ");
 437         }
 438     }
 439   common_val_print (val, stream, 0, &opts, current_language);
 440 }
 441
 442
 443 static void
 444 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 445                                 struct cmd_list_element *c, const char *value)
 446 {
 447   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 448                     value);
 449 }
 450
 451 static struct obstack dont_print_vb_obstack;
 452 static struct obstack dont_print_statmem_obstack;
 453
 454 static void pascal_object_print_static_field (struct value *,
 455                                               struct ui_file *, int,
 456                                               const struct value_print_options *);
 457
 458 static void pascal_object_print_value (struct value *, struct ui_file *, int,
 459                                        const struct value_print_options *,
 460                                        struct type **);
 461
 462 /* It was changed to this after 2.4.5.  */
 463 const char pascal_vtbl_ptr_name[] =
 464 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 465
 466 /* Return truth value for assertion that TYPE is of the type
 467    "pointer to virtual function".  */
 468
 469 int
 470 pascal_object_is_vtbl_ptr_type (struct type *type)
 471 {
 472   const char *type_name = type->name ();
 473
 474   return (type_name != NULL
 475           && strcmp (type_name, pascal_vtbl_ptr_name) == 0);
 476 }
 477
 478 /* Return truth value for the assertion that TYPE is of the type
 479    "pointer to virtual function table".  */
 480
 481 int
 482 pascal_object_is_vtbl_member (struct type *type)
 483 {
 484   if (type->code () == TYPE_CODE_PTR)
 485     {
 486       type = TYPE_TARGET_TYPE (type);
 487       if (type->code () == TYPE_CODE_ARRAY)
 488         {
 489           type = TYPE_TARGET_TYPE (type);
 490           if (type->code () == TYPE_CODE_STRUCT /* If not using
 491                                                            thunks.  */
 492               || type->code () == TYPE_CODE_PTR)        /* If using thunks.  */
 493             {
 494               /* Virtual functions tables are full of pointers
 495                  to virtual functions.  */
 496               return pascal_object_is_vtbl_ptr_type (type);
 497             }
 498         }
 499     }
 500   return 0;
 501 }
 502
 503 /* Mutually recursive subroutines of pascal_object_print_value and
 504    pascal_value_print to print out a structure's fields:
 505    pascal_object_print_value_fields and pascal_object_print_value.
 506
 507    VAL, STREAM, RECURSE, and OPTIONS have the same meanings as in
 508    pascal_object_print_value and c_value_print.
 509
 510    DONT_PRINT is an array of baseclass types that we
 511    should not print, or zero if called from top level.  */
 512
 513 static void
 514 pascal_object_print_value_fields (struct value *val, struct ui_file *stream,
 515                                   int recurse,
 516                                   const struct value_print_options *options,
 517                                   struct type **dont_print_vb,
 518                                   int dont_print_statmem)
 519 {
 520   int i, len, n_baseclasses;
 521   char *last_dont_print
 522     = (char *) obstack_next_free (&dont_print_statmem_obstack);
 523
 524   struct type *type = check_typedef (value_type (val));
 525
 526   fprintf_filtered (stream, "{");
 527   len = type->num_fields ();
 528   n_baseclasses = TYPE_N_BASECLASSES (type);
 529
 530   /* Print out baseclasses such that we don't print
 531      duplicates of virtual baseclasses.  */
 532   if (n_baseclasses > 0)
 533     pascal_object_print_value (val, stream, recurse + 1,
 534                                options, dont_print_vb);
 535
 536   if (!len && n_baseclasses == 1)
 537     fprintf_styled (stream, metadata_style.style (), "<No data fields>");
 538   else
 539     {
 540       struct obstack tmp_obstack = dont_print_statmem_obstack;
 541       int fields_seen = 0;
 542       const gdb_byte *valaddr = value_contents_for_printing (val);
 543
 544       if (dont_print_statmem == 0)
 545         {
 546           /* If we're at top level, carve out a completely fresh
 547              chunk of the obstack and use that until this particular
 548              invocation returns.  */
 549           obstack_finish (&dont_print_statmem_obstack);
 550         }
 551
 552       for (i = n_baseclasses; i < len; i++)
 553         {
 554           /* If requested, skip printing of static fields.  */
 555           if (!options->pascal_static_field_print
 556               && field_is_static (&type->field (i)))
 557             continue;
 558           if (fields_seen)
 559             fprintf_filtered (stream, ", ");
 560           else if (n_baseclasses > 0)
 561             {
 562               if (options->prettyformat)
 563                 {
 564                   fprintf_filtered (stream, "\n");
 565                   print_spaces_filtered (2 + 2 * recurse, stream);
 566                   fputs_filtered ("members of ", stream);
 567                   fputs_filtered (type->name (), stream);
 568                   fputs_filtered (": ", stream);
 569                 }
 570             }
 571           fields_seen = 1;
 572
 573           if (options->prettyformat)
 574             {
 575               fprintf_filtered (stream, "\n");
 576               print_spaces_filtered (2 + 2 * recurse, stream);
 577             }
 578           else
 579             {
 580               wrap_here (n_spaces (2 + 2 * recurse));
 581             }
 582
 583           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 584
 585           if (field_is_static (&type->field (i)))
 586             {
 587               fputs_filtered ("static ", stream);
 588               fprintf_symbol_filtered (stream,
 589                                        TYPE_FIELD_NAME (type, i),
 590                                        current_language->la_language,
 591                                        DMGL_PARAMS | DMGL_ANSI);
 592             }
 593           else
 594             fputs_styled (TYPE_FIELD_NAME (type, i),
 595                           variable_name_style.style (), stream);
 596           annotate_field_name_end ();
 597           fputs_filtered (" = ", stream);
 598           annotate_field_value ();
 599
 600           if (!field_is_static (&type->field (i))
 601               && TYPE_FIELD_PACKED (type, i))
 602             {
 603               struct value *v;
 604
 605               /* Bitfields require special handling, especially due to byte
 606                  order problems.  */
 607               if (TYPE_FIELD_IGNORE (type, i))
 608                 {
 609                   fputs_styled ("<optimized out or zero length>",
 610                                 metadata_style.style (), stream);
 611                 }
 612               else if (value_bits_synthetic_pointer (val,
 613                                                      TYPE_FIELD_BITPOS (type,
 614                                                                         i),
 615                                                      TYPE_FIELD_BITSIZE (type,
 616                                                                          i)))
 617                 {
 618                   fputs_styled (_("<synthetic pointer>"),
 619                                 metadata_style.style (), stream);
 620                 }
 621               else
 622                 {
 623                   struct value_print_options opts = *options;
 624
 625                   v = value_field_bitfield (type, i, valaddr, 0, val);
 626
 627                   opts.deref_ref = 0;
 628                   common_val_print (v, stream, recurse + 1, &opts,
 629                                     current_language);
 630                 }
 631             }
 632           else
 633             {
 634               if (TYPE_FIELD_IGNORE (type, i))
 635                 {
 636                   fputs_styled ("<optimized out or zero length>",
 637                                 metadata_style.style (), stream);
 638                 }
 639               else if (field_is_static (&type->field (i)))
 640                 {
 641                   /* struct value *v = value_static_field (type, i);
 642                      v4.17 specific.  */
 643                   struct value *v;
 644
 645                   v = value_field_bitfield (type, i, valaddr, 0, val);
 646
 647                   if (v == NULL)
 648                     val_print_optimized_out (NULL, stream);
 649                   else
 650                     pascal_object_print_static_field (v, stream, recurse + 1,
 651                                                       options);
 652                 }
 653               else
 654                 {
 655                   struct value_print_options opts = *options;
 656
 657                   opts.deref_ref = 0;
 658
 659                   struct value *v = value_primitive_field (val, 0, i,
 660                                                            value_type (val));
 661                   common_val_print (v, stream, recurse + 1, &opts,
 662                                     current_language);
 663                 }
 664             }
 665           annotate_field_end ();
 666         }
 667
 668       if (dont_print_statmem == 0)
 669         {
 670           /* Free the space used to deal with the printing
 671              of the members from top level.  */
 672           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 673           dont_print_statmem_obstack = tmp_obstack;
 674         }
 675
 676       if (options->prettyformat)
 677         {
 678           fprintf_filtered (stream, "\n");
 679           print_spaces_filtered (2 * recurse, stream);
 680         }
 681     }
 682   fprintf_filtered (stream, "}");
 683 }
 684
 685 /* Special val_print routine to avoid printing multiple copies of virtual
 686    baseclasses.  */
 687
 688 static void
 689 pascal_object_print_value (struct value *val, struct ui_file *stream,
 690                            int recurse,
 691                            const struct value_print_options *options,
 692                            struct type **dont_print_vb)
 693 {
 694   struct type **last_dont_print
 695     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 696   struct obstack tmp_obstack = dont_print_vb_obstack;
 697   struct type *type = check_typedef (value_type (val));
 698   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 699
 700   if (dont_print_vb == 0)
 701     {
 702       /* If we're at top level, carve out a completely fresh
 703          chunk of the obstack and use that until this particular
 704          invocation returns.  */
 705       /* Bump up the high-water mark.  Now alpha is omega.  */
 706       obstack_finish (&dont_print_vb_obstack);
 707     }
 708
 709   for (i = 0; i < n_baseclasses; i++)
 710     {
 711       LONGEST boffset = 0;
 712       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 713       const char *basename = baseclass->name ();
 714       int skip = 0;
 715
 716       if (BASETYPE_VIA_VIRTUAL (type, i))
 717         {
 718           struct type **first_dont_print
 719             = (struct type **) obstack_base (&dont_print_vb_obstack);
 720
 721           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 722             - first_dont_print;
 723
 724           while (--j >= 0)
 725             if (baseclass == first_dont_print[j])
 726               goto flush_it;
 727
 728           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 729         }
 730
 731       struct value *base_value;
 732       try
 733         {
 734           base_value = value_primitive_field (val, 0, i, type);
 735         }
 736       catch (const gdb_exception_error &ex)
 737         {
 738           base_value = nullptr;
 739           if (ex.error == NOT_AVAILABLE_ERROR)
 740             skip = -1;
 741           else
 742             skip = 1;
 743         }
 744
 745       if (skip == 0)
 746         {
 747           /* The virtual base class pointer might have been clobbered by the
 748              user program. Make sure that it still points to a valid memory
 749              location.  */
 750
 751           if (boffset < 0 || boffset >= TYPE_LENGTH (type))
 752             {
 753               CORE_ADDR address= value_address (val);
 754               gdb::byte_vector buf (TYPE_LENGTH (baseclass));
 755
 756               if (target_read_memory (address + boffset, buf.data (),
 757                                       TYPE_LENGTH (baseclass)) != 0)
 758                 skip = 1;
 759               base_value = value_from_contents_and_address (baseclass,
 760                                                             buf.data (),
 761                                                             address + boffset);
 762               baseclass = value_type (base_value);
 763               boffset = 0;
 764             }
 765         }
 766
 767       if (options->prettyformat)
 768         {
 769           fprintf_filtered (stream, "\n");
 770           print_spaces_filtered (2 * recurse, stream);
 771         }
 772       fputs_filtered ("<", stream);
 773       /* Not sure what the best notation is in the case where there is no
 774          baseclass name.  */
 775
 776       fputs_filtered (basename ? basename : "", stream);
 777       fputs_filtered ("> = ", stream);
 778
 779       if (skip < 0)
 780         val_print_unavailable (stream);
 781       else if (skip > 0)
 782         val_print_invalid_address (stream);
 783       else
 784         pascal_object_print_value_fields
 785           (base_value, stream, recurse, options,
 786            (struct type **) obstack_base (&dont_print_vb_obstack),
 787            0);
 788       fputs_filtered (", ", stream);
 789
 790     flush_it:
 791       ;
 792     }
 793
 794   if (dont_print_vb == 0)
 795     {
 796       /* Free the space used to deal with the printing
 797          of this type from top level.  */
 798       obstack_free (&dont_print_vb_obstack, last_dont_print);
 799       /* Reset watermark so that we can continue protecting
 800          ourselves from whatever we were protecting ourselves.  */
 801       dont_print_vb_obstack = tmp_obstack;
 802     }
 803 }
 804
 805 /* Print value of a static member.
 806    To avoid infinite recursion when printing a class that contains
 807    a static instance of the class, we keep the addresses of all printed
 808    static member classes in an obstack and refuse to print them more
 809    than once.
 810
 811    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 812    have the same meanings as in c_val_print.  */
 813
 814 static void
 815 pascal_object_print_static_field (struct value *val,
 816                                   struct ui_file *stream,
 817                                   int recurse,
 818                                   const struct value_print_options *options)
 819 {
 820   struct type *type = value_type (val);
 821   struct value_print_options opts;
 822
 823   if (value_entirely_optimized_out (val))
 824     {
 825       val_print_optimized_out (val, stream);
 826       return;
 827     }
 828
 829   if (type->code () == TYPE_CODE_STRUCT)
 830     {
 831       CORE_ADDR *first_dont_print, addr;
 832       int i;
 833
 834       first_dont_print
 835         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 836       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 837         - first_dont_print;
 838
 839       while (--i >= 0)
 840         {
 841           if (value_address (val) == first_dont_print[i])
 842             {
 843               fputs_styled (_("\
 844 <same as static member of an already seen type>"),
 845                             metadata_style.style (), stream);
 846               return;
 847             }
 848         }
 849
 850       addr = value_address (val);
 851       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 852                     sizeof (CORE_ADDR));
 853
 854       type = check_typedef (type);
 855       pascal_object_print_value_fields (val, stream, recurse,
 856                                         options, NULL, 1);
 857       return;
 858     }
 859
 860   opts = *options;
 861   opts.deref_ref = 0;
 862   common_val_print (val, stream, recurse, &opts, current_language);
 863 }
 864
 865 void _initialize_pascal_valprint ();
 866 void
 867 _initialize_pascal_valprint ()
 868 {
 869   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 870                            &user_print_options.pascal_static_field_print, _("\
 871 Set printing of pascal static members."), _("\
 872 Show printing of pascal static members."), NULL,
 873                            NULL,
 874                            show_pascal_static_field_print,
 875                            &setprintlist, &showprintlist);
 876 }