gdb/p-valprint.c

   1 /* Support for printing Pascal values for GDB, the GNU debugger.
   2
   3    Copyright (C) 2000-2021 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_language::value_print_inner (struct value *val,
  68                                     struct ui_file *stream, int recurse,
  69                                     const struct value_print_options *options) const
  70
  71 {
  72   struct type *type = check_typedef (value_type (val));
  73   struct gdbarch *gdbarch = type->arch ();
  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                 printstr (stream, TYPE_TARGET_TYPE (type), valaddr, len,
 120                           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 (pascal_is_string_type (elttype, &length_pos, &length_size,
 204                                  &string_pos, &char_type, NULL) > 0
 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
 309                (valaddr + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
 310                 TYPE_LENGTH (type->field (VTBL_FNADDR_OFFSET).type ()),
 311                 byte_order),
 312              stream, demangle);
 313         }
 314       else
 315         {
 316           if (pascal_is_string_type (type, &length_pos, &length_size,
 317                                      &string_pos, &char_type, NULL) > 0)
 318             {
 319               len = extract_unsigned_integer (valaddr + length_pos,
 320                                               length_size, byte_order);
 321               printstr (stream, char_type, valaddr + string_pos, len,
 322                         NULL, 0, options);
 323             }
 324           else
 325             pascal_object_print_value_fields (val, stream, recurse,
 326                                               options, NULL, 0);
 327         }
 328       break;
 329
 330     case TYPE_CODE_SET:
 331       elttype = type->index_type ();
 332       elttype = check_typedef (elttype);
 333       if (elttype->is_stub ())
 334         {
 335           fprintf_styled (stream, metadata_style.style (), "<incomplete type>");
 336           break;
 337         }
 338       else
 339         {
 340           struct type *range = elttype;
 341           LONGEST low_bound, high_bound;
 342           int need_comma = 0;
 343
 344           fputs_filtered ("[", stream);
 345
 346           int bound_info = (get_discrete_bounds (range, &low_bound, &high_bound)
 347                             ? 0 : -1);
 348           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
 349             {
 350               /* If we know the size of the set type, we can figure out the
 351               maximum value.  */
 352               bound_info = 0;
 353               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
 354               range->bounds ()->high.set_const_val (high_bound);
 355             }
 356         maybe_bad_bstring:
 357           if (bound_info < 0)
 358             {
 359               fputs_styled ("<error value>", metadata_style.style (), stream);
 360               goto done;
 361             }
 362
 363           for (i = low_bound; i <= high_bound; i++)
 364             {
 365               int element = value_bit_index (type, valaddr, i);
 366
 367               if (element < 0)
 368                 {
 369                   i = element;
 370                   goto maybe_bad_bstring;
 371                 }
 372               if (element)
 373                 {
 374                   if (need_comma)
 375                     fputs_filtered (", ", stream);
 376                   print_type_scalar (range, i, stream);
 377                   need_comma = 1;
 378
 379                   if (i + 1 <= high_bound
 380                       && value_bit_index (type, valaddr, ++i))
 381                     {
 382                       int j = i;
 383
 384                       fputs_filtered ("..", stream);
 385                       while (i + 1 <= high_bound
 386                              && value_bit_index (type, valaddr, ++i))
 387                         j = i;
 388                       print_type_scalar (range, j, stream);
 389                     }
 390                 }
 391             }
 392         done:
 393           fputs_filtered ("]", stream);
 394         }
 395       break;
 396
 397     default:
 398       error (_("Invalid pascal type code %d in symbol table."),
 399              type->code ());
 400     }
 401 }
 402
 403 \f
 404 void
 405 pascal_language::value_print (struct value *val, struct ui_file *stream,
 406                               const struct value_print_options *options) const
 407 {
 408   struct type *type = value_type (val);
 409   struct value_print_options opts = *options;
 410
 411   opts.deref_ref = 1;
 412
 413   /* If it is a pointer, indicate what it points to.
 414
 415      Print type also if it is a reference.
 416
 417      Object pascal: if it is a member pointer, we will take care
 418      of that when we print it.  */
 419   if (type->code () == TYPE_CODE_PTR
 420       || type->code () == TYPE_CODE_REF)
 421     {
 422       /* Hack:  remove (char *) for char strings.  Their
 423          type is indicated by the quoted string anyway.  */
 424       if (type->code () == TYPE_CODE_PTR
 425           && type->name () == NULL
 426           && TYPE_TARGET_TYPE (type)->name () != NULL
 427           && strcmp (TYPE_TARGET_TYPE (type)->name (), "char") == 0)
 428         {
 429           /* Print nothing.  */
 430         }
 431       else
 432         {
 433           fprintf_filtered (stream, "(");
 434           type_print (type, "", stream, -1);
 435           fprintf_filtered (stream, ") ");
 436         }
 437     }
 438   common_val_print (val, stream, 0, &opts, current_language);
 439 }
 440
 441
 442 static void
 443 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 444                                 struct cmd_list_element *c, const char *value)
 445 {
 446   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 447                     value);
 448 }
 449
 450 static struct obstack dont_print_vb_obstack;
 451 static struct obstack dont_print_statmem_obstack;
 452
 453 static void pascal_object_print_static_field (struct value *,
 454                                               struct ui_file *, int,
 455                                               const struct value_print_options *);
 456
 457 static void pascal_object_print_value (struct value *, struct ui_file *, int,
 458                                        const struct value_print_options *,
 459                                        struct type **);
 460
 461 /* It was changed to this after 2.4.5.  */
 462 const char pascal_vtbl_ptr_name[] =
 463 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 464
 465 /* Return truth value for assertion that TYPE is of the type
 466    "pointer to virtual function".  */
 467
 468 int
 469 pascal_object_is_vtbl_ptr_type (struct type *type)
 470 {
 471   const char *type_name = type->name ();
 472
 473   return (type_name != NULL
 474           && strcmp (type_name, pascal_vtbl_ptr_name) == 0);
 475 }
 476
 477 /* Return truth value for the assertion that TYPE is of the type
 478    "pointer to virtual function table".  */
 479
 480 int
 481 pascal_object_is_vtbl_member (struct type *type)
 482 {
 483   if (type->code () == TYPE_CODE_PTR)
 484     {
 485       type = TYPE_TARGET_TYPE (type);
 486       if (type->code () == TYPE_CODE_ARRAY)
 487         {
 488           type = TYPE_TARGET_TYPE (type);
 489           if (type->code () == TYPE_CODE_STRUCT /* If not using
 490                                                            thunks.  */
 491               || type->code () == TYPE_CODE_PTR)        /* If using thunks.  */
 492             {
 493               /* Virtual functions tables are full of pointers
 494                  to virtual functions.  */
 495               return pascal_object_is_vtbl_ptr_type (type);
 496             }
 497         }
 498     }
 499   return 0;
 500 }
 501
 502 /* Helper function for print pascal objects.
 503
 504    VAL, STREAM, RECURSE, and OPTIONS have the same meanings as in
 505    pascal_object_print_value and c_value_print.
 506
 507    DONT_PRINT is an array of baseclass types that we
 508    should not print, or zero if called from top level.  */
 509
 510 static void
 511 pascal_object_print_value_fields (struct value *val, struct ui_file *stream,
 512                                   int recurse,
 513                                   const struct value_print_options *options,
 514                                   struct type **dont_print_vb,
 515                                   int dont_print_statmem)
 516 {
 517   int i, len, n_baseclasses;
 518   char *last_dont_print
 519     = (char *) obstack_next_free (&dont_print_statmem_obstack);
 520
 521   struct type *type = check_typedef (value_type (val));
 522
 523   fprintf_filtered (stream, "{");
 524   len = type->num_fields ();
 525   n_baseclasses = TYPE_N_BASECLASSES (type);
 526
 527   /* Print out baseclasses such that we don't print
 528      duplicates of virtual baseclasses.  */
 529   if (n_baseclasses > 0)
 530     pascal_object_print_value (val, stream, recurse + 1,
 531                                options, dont_print_vb);
 532
 533   if (!len && n_baseclasses == 1)
 534     fprintf_styled (stream, metadata_style.style (), "<No data fields>");
 535   else
 536     {
 537       struct obstack tmp_obstack = dont_print_statmem_obstack;
 538       int fields_seen = 0;
 539       const gdb_byte *valaddr = value_contents_for_printing (val);
 540
 541       if (dont_print_statmem == 0)
 542         {
 543           /* If we're at top level, carve out a completely fresh
 544              chunk of the obstack and use that until this particular
 545              invocation returns.  */
 546           obstack_finish (&dont_print_statmem_obstack);
 547         }
 548
 549       for (i = n_baseclasses; i < len; i++)
 550         {
 551           /* If requested, skip printing of static fields.  */
 552           if (!options->pascal_static_field_print
 553               && field_is_static (&type->field (i)))
 554             continue;
 555           if (fields_seen)
 556             fprintf_filtered (stream, ", ");
 557           else if (n_baseclasses > 0)
 558             {
 559               if (options->prettyformat)
 560                 {
 561                   fprintf_filtered (stream, "\n");
 562                   print_spaces_filtered (2 + 2 * recurse, stream);
 563                   fputs_filtered ("members of ", stream);
 564                   fputs_filtered (type->name (), stream);
 565                   fputs_filtered (": ", stream);
 566                 }
 567             }
 568           fields_seen = 1;
 569
 570           if (options->prettyformat)
 571             {
 572               fprintf_filtered (stream, "\n");
 573               print_spaces_filtered (2 + 2 * recurse, stream);
 574             }
 575           else
 576             {
 577               wrap_here (n_spaces (2 + 2 * recurse));
 578             }
 579
 580           annotate_field_begin (type->field (i).type ());
 581
 582           if (field_is_static (&type->field (i)))
 583             {
 584               fputs_filtered ("static ", stream);
 585               fprintf_symbol_filtered (stream,
 586                                        TYPE_FIELD_NAME (type, i),
 587                                        current_language->la_language,
 588                                        DMGL_PARAMS | DMGL_ANSI);
 589             }
 590           else
 591             fputs_styled (TYPE_FIELD_NAME (type, i),
 592                           variable_name_style.style (), stream);
 593           annotate_field_name_end ();
 594           fputs_filtered (" = ", stream);
 595           annotate_field_value ();
 596
 597           if (!field_is_static (&type->field (i))
 598               && TYPE_FIELD_PACKED (type, i))
 599             {
 600               struct value *v;
 601
 602               /* Bitfields require special handling, especially due to byte
 603                  order problems.  */
 604               if (TYPE_FIELD_IGNORE (type, i))
 605                 {
 606                   fputs_styled ("<optimized out or zero length>",
 607                                 metadata_style.style (), stream);
 608                 }
 609               else if (value_bits_synthetic_pointer (val,
 610                                                      TYPE_FIELD_BITPOS (type,
 611                                                                         i),
 612                                                      TYPE_FIELD_BITSIZE (type,
 613                                                                          i)))
 614                 {
 615                   fputs_styled (_("<synthetic pointer>"),
 616                                 metadata_style.style (), stream);
 617                 }
 618               else
 619                 {
 620                   struct value_print_options opts = *options;
 621
 622                   v = value_field_bitfield (type, i, valaddr, 0, val);
 623
 624                   opts.deref_ref = 0;
 625                   common_val_print (v, stream, recurse + 1, &opts,
 626                                     current_language);
 627                 }
 628             }
 629           else
 630             {
 631               if (TYPE_FIELD_IGNORE (type, i))
 632                 {
 633                   fputs_styled ("<optimized out or zero length>",
 634                                 metadata_style.style (), stream);
 635                 }
 636               else if (field_is_static (&type->field (i)))
 637                 {
 638                   /* struct value *v = value_static_field (type, i);
 639                      v4.17 specific.  */
 640                   struct value *v;
 641
 642                   v = value_field_bitfield (type, i, valaddr, 0, val);
 643
 644                   if (v == NULL)
 645                     val_print_optimized_out (NULL, stream);
 646                   else
 647                     pascal_object_print_static_field (v, stream, recurse + 1,
 648                                                       options);
 649                 }
 650               else
 651                 {
 652                   struct value_print_options opts = *options;
 653
 654                   opts.deref_ref = 0;
 655
 656                   struct value *v = value_primitive_field (val, 0, i,
 657                                                            value_type (val));
 658                   common_val_print (v, stream, recurse + 1, &opts,
 659                                     current_language);
 660                 }
 661             }
 662           annotate_field_end ();
 663         }
 664
 665       if (dont_print_statmem == 0)
 666         {
 667           /* Free the space used to deal with the printing
 668              of the members from top level.  */
 669           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 670           dont_print_statmem_obstack = tmp_obstack;
 671         }
 672
 673       if (options->prettyformat)
 674         {
 675           fprintf_filtered (stream, "\n");
 676           print_spaces_filtered (2 * recurse, stream);
 677         }
 678     }
 679   fprintf_filtered (stream, "}");
 680 }
 681
 682 /* Special val_print routine to avoid printing multiple copies of virtual
 683    baseclasses.  */
 684
 685 static void
 686 pascal_object_print_value (struct value *val, struct ui_file *stream,
 687                            int recurse,
 688                            const struct value_print_options *options,
 689                            struct type **dont_print_vb)
 690 {
 691   struct type **last_dont_print
 692     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 693   struct obstack tmp_obstack = dont_print_vb_obstack;
 694   struct type *type = check_typedef (value_type (val));
 695   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 696
 697   if (dont_print_vb == 0)
 698     {
 699       /* If we're at top level, carve out a completely fresh
 700          chunk of the obstack and use that until this particular
 701          invocation returns.  */
 702       /* Bump up the high-water mark.  Now alpha is omega.  */
 703       obstack_finish (&dont_print_vb_obstack);
 704     }
 705
 706   for (i = 0; i < n_baseclasses; i++)
 707     {
 708       LONGEST boffset = 0;
 709       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 710       const char *basename = baseclass->name ();
 711       int skip = 0;
 712
 713       if (BASETYPE_VIA_VIRTUAL (type, i))
 714         {
 715           struct type **first_dont_print
 716             = (struct type **) obstack_base (&dont_print_vb_obstack);
 717
 718           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 719             - first_dont_print;
 720
 721           while (--j >= 0)
 722             if (baseclass == first_dont_print[j])
 723               goto flush_it;
 724
 725           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 726         }
 727
 728       struct value *base_value;
 729       try
 730         {
 731           base_value = value_primitive_field (val, 0, i, type);
 732         }
 733       catch (const gdb_exception_error &ex)
 734         {
 735           base_value = nullptr;
 736           if (ex.error == NOT_AVAILABLE_ERROR)
 737             skip = -1;
 738           else
 739             skip = 1;
 740         }
 741
 742       if (skip == 0)
 743         {
 744           /* The virtual base class pointer might have been clobbered by the
 745              user program. Make sure that it still points to a valid memory
 746              location.  */
 747
 748           if (boffset < 0 || boffset >= TYPE_LENGTH (type))
 749             {
 750               CORE_ADDR address= value_address (val);
 751               gdb::byte_vector buf (TYPE_LENGTH (baseclass));
 752
 753               if (target_read_memory (address + boffset, buf.data (),
 754                                       TYPE_LENGTH (baseclass)) != 0)
 755                 skip = 1;
 756               base_value = value_from_contents_and_address (baseclass,
 757                                                             buf.data (),
 758                                                             address + boffset);
 759               baseclass = value_type (base_value);
 760               boffset = 0;
 761             }
 762         }
 763
 764       if (options->prettyformat)
 765         {
 766           fprintf_filtered (stream, "\n");
 767           print_spaces_filtered (2 * recurse, stream);
 768         }
 769       fputs_filtered ("<", stream);
 770       /* Not sure what the best notation is in the case where there is no
 771          baseclass name.  */
 772
 773       fputs_filtered (basename ? basename : "", stream);
 774       fputs_filtered ("> = ", stream);
 775
 776       if (skip < 0)
 777         val_print_unavailable (stream);
 778       else if (skip > 0)
 779         val_print_invalid_address (stream);
 780       else
 781         pascal_object_print_value_fields
 782           (base_value, stream, recurse, options,
 783            (struct type **) obstack_base (&dont_print_vb_obstack),
 784            0);
 785       fputs_filtered (", ", stream);
 786
 787     flush_it:
 788       ;
 789     }
 790
 791   if (dont_print_vb == 0)
 792     {
 793       /* Free the space used to deal with the printing
 794          of this type from top level.  */
 795       obstack_free (&dont_print_vb_obstack, last_dont_print);
 796       /* Reset watermark so that we can continue protecting
 797          ourselves from whatever we were protecting ourselves.  */
 798       dont_print_vb_obstack = tmp_obstack;
 799     }
 800 }
 801
 802 /* Print value of a static member.
 803    To avoid infinite recursion when printing a class that contains
 804    a static instance of the class, we keep the addresses of all printed
 805    static member classes in an obstack and refuse to print them more
 806    than once.
 807
 808    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 809    have the same meanings as in c_val_print.  */
 810
 811 static void
 812 pascal_object_print_static_field (struct value *val,
 813                                   struct ui_file *stream,
 814                                   int recurse,
 815                                   const struct value_print_options *options)
 816 {
 817   struct type *type = value_type (val);
 818   struct value_print_options opts;
 819
 820   if (value_entirely_optimized_out (val))
 821     {
 822       val_print_optimized_out (val, stream);
 823       return;
 824     }
 825
 826   if (type->code () == TYPE_CODE_STRUCT)
 827     {
 828       CORE_ADDR *first_dont_print, addr;
 829       int i;
 830
 831       first_dont_print
 832         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 833       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 834         - first_dont_print;
 835
 836       while (--i >= 0)
 837         {
 838           if (value_address (val) == first_dont_print[i])
 839             {
 840               fputs_styled (_("\
 841 <same as static member of an already seen type>"),
 842                             metadata_style.style (), stream);
 843               return;
 844             }
 845         }
 846
 847       addr = value_address (val);
 848       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 849                     sizeof (CORE_ADDR));
 850
 851       type = check_typedef (type);
 852       pascal_object_print_value_fields (val, stream, recurse,
 853                                         options, NULL, 1);
 854       return;
 855     }
 856
 857   opts = *options;
 858   opts.deref_ref = 0;
 859   common_val_print (val, stream, recurse, &opts, current_language);
 860 }
 861
 862 void _initialize_pascal_valprint ();
 863 void
 864 _initialize_pascal_valprint ()
 865 {
 866   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 867                            &user_print_options.pascal_static_field_print, _("\
 868 Set printing of pascal static members."), _("\
 869 Show printing of pascal static members."), NULL,
 870                            NULL,
 871                            show_pascal_static_field_print,
 872                            &setprintlist, &showprintlist);
 873 }