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
 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 (is_pascal_string_type (type, &length_pos, &length_size,
 317                                      &string_pos, &char_type, NULL))
 318             {
 319               len = extract_unsigned_integer (valaddr + length_pos,
 320                                               length_size, byte_order);
 321               LA_PRINT_STRING (stream, char_type, valaddr + string_pos,
 322                                len, 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_value_print (struct value *val, struct ui_file *stream,
 406                     const struct value_print_options *options)
 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 /* Mutually recursive subroutines of pascal_object_print_value and
 503    pascal_value_print to print out a structure's fields:
 504    pascal_object_print_value_fields and pascal_object_print_value.
 505
 506    VAL, STREAM, RECURSE, and OPTIONS have the same meanings as in
 507    pascal_object_print_value and c_value_print.
 508
 509    DONT_PRINT is an array of baseclass types that we
 510    should not print, or zero if called from top level.  */
 511
 512 static void
 513 pascal_object_print_value_fields (struct value *val, struct ui_file *stream,
 514                                   int recurse,
 515                                   const struct value_print_options *options,
 516                                   struct type **dont_print_vb,
 517                                   int dont_print_statmem)
 518 {
 519   int i, len, n_baseclasses;
 520   char *last_dont_print
 521     = (char *) obstack_next_free (&dont_print_statmem_obstack);
 522
 523   struct type *type = check_typedef (value_type (val));
 524
 525   fprintf_filtered (stream, "{");
 526   len = type->num_fields ();
 527   n_baseclasses = TYPE_N_BASECLASSES (type);
 528
 529   /* Print out baseclasses such that we don't print
 530      duplicates of virtual baseclasses.  */
 531   if (n_baseclasses > 0)
 532     pascal_object_print_value (val, stream, recurse + 1,
 533                                options, dont_print_vb);
 534
 535   if (!len && n_baseclasses == 1)
 536     fprintf_styled (stream, metadata_style.style (), "<No data fields>");
 537   else
 538     {
 539       struct obstack tmp_obstack = dont_print_statmem_obstack;
 540       int fields_seen = 0;
 541       const gdb_byte *valaddr = value_contents_for_printing (val);
 542
 543       if (dont_print_statmem == 0)
 544         {
 545           /* If we're at top level, carve out a completely fresh
 546              chunk of the obstack and use that until this particular
 547              invocation returns.  */
 548           obstack_finish (&dont_print_statmem_obstack);
 549         }
 550
 551       for (i = n_baseclasses; i < len; i++)
 552         {
 553           /* If requested, skip printing of static fields.  */
 554           if (!options->pascal_static_field_print
 555               && field_is_static (&type->field (i)))
 556             continue;
 557           if (fields_seen)
 558             fprintf_filtered (stream, ", ");
 559           else if (n_baseclasses > 0)
 560             {
 561               if (options->prettyformat)
 562                 {
 563                   fprintf_filtered (stream, "\n");
 564                   print_spaces_filtered (2 + 2 * recurse, stream);
 565                   fputs_filtered ("members of ", stream);
 566                   fputs_filtered (type->name (), stream);
 567                   fputs_filtered (": ", stream);
 568                 }
 569             }
 570           fields_seen = 1;
 571
 572           if (options->prettyformat)
 573             {
 574               fprintf_filtered (stream, "\n");
 575               print_spaces_filtered (2 + 2 * recurse, stream);
 576             }
 577           else
 578             {
 579               wrap_here (n_spaces (2 + 2 * recurse));
 580             }
 581
 582           annotate_field_begin (type->field (i).type ());
 583
 584           if (field_is_static (&type->field (i)))
 585             {
 586               fputs_filtered ("static ", stream);
 587               fprintf_symbol_filtered (stream,
 588                                        TYPE_FIELD_NAME (type, i),
 589                                        current_language->la_language,
 590                                        DMGL_PARAMS | DMGL_ANSI);
 591             }
 592           else
 593             fputs_styled (TYPE_FIELD_NAME (type, i),
 594                           variable_name_style.style (), stream);
 595           annotate_field_name_end ();
 596           fputs_filtered (" = ", stream);
 597           annotate_field_value ();
 598
 599           if (!field_is_static (&type->field (i))
 600               && TYPE_FIELD_PACKED (type, i))
 601             {
 602               struct value *v;
 603
 604               /* Bitfields require special handling, especially due to byte
 605                  order problems.  */
 606               if (TYPE_FIELD_IGNORE (type, i))
 607                 {
 608                   fputs_styled ("<optimized out or zero length>",
 609                                 metadata_style.style (), stream);
 610                 }
 611               else if (value_bits_synthetic_pointer (val,
 612                                                      TYPE_FIELD_BITPOS (type,
 613                                                                         i),
 614                                                      TYPE_FIELD_BITSIZE (type,
 615                                                                          i)))
 616                 {
 617                   fputs_styled (_("<synthetic pointer>"),
 618                                 metadata_style.style (), stream);
 619                 }
 620               else
 621                 {
 622                   struct value_print_options opts = *options;
 623
 624                   v = value_field_bitfield (type, i, valaddr, 0, val);
 625
 626                   opts.deref_ref = 0;
 627                   common_val_print (v, stream, recurse + 1, &opts,
 628                                     current_language);
 629                 }
 630             }
 631           else
 632             {
 633               if (TYPE_FIELD_IGNORE (type, i))
 634                 {
 635                   fputs_styled ("<optimized out or zero length>",
 636                                 metadata_style.style (), stream);
 637                 }
 638               else if (field_is_static (&type->field (i)))
 639                 {
 640                   /* struct value *v = value_static_field (type, i);
 641                      v4.17 specific.  */
 642                   struct value *v;
 643
 644                   v = value_field_bitfield (type, i, valaddr, 0, val);
 645
 646                   if (v == NULL)
 647                     val_print_optimized_out (NULL, stream);
 648                   else
 649                     pascal_object_print_static_field (v, stream, recurse + 1,
 650                                                       options);
 651                 }
 652               else
 653                 {
 654                   struct value_print_options opts = *options;
 655
 656                   opts.deref_ref = 0;
 657
 658                   struct value *v = value_primitive_field (val, 0, i,
 659                                                            value_type (val));
 660                   common_val_print (v, stream, recurse + 1, &opts,
 661                                     current_language);
 662                 }
 663             }
 664           annotate_field_end ();
 665         }
 666
 667       if (dont_print_statmem == 0)
 668         {
 669           /* Free the space used to deal with the printing
 670              of the members from top level.  */
 671           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 672           dont_print_statmem_obstack = tmp_obstack;
 673         }
 674
 675       if (options->prettyformat)
 676         {
 677           fprintf_filtered (stream, "\n");
 678           print_spaces_filtered (2 * recurse, stream);
 679         }
 680     }
 681   fprintf_filtered (stream, "}");
 682 }
 683
 684 /* Special val_print routine to avoid printing multiple copies of virtual
 685    baseclasses.  */
 686
 687 static void
 688 pascal_object_print_value (struct value *val, struct ui_file *stream,
 689                            int recurse,
 690                            const struct value_print_options *options,
 691                            struct type **dont_print_vb)
 692 {
 693   struct type **last_dont_print
 694     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 695   struct obstack tmp_obstack = dont_print_vb_obstack;
 696   struct type *type = check_typedef (value_type (val));
 697   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 698
 699   if (dont_print_vb == 0)
 700     {
 701       /* If we're at top level, carve out a completely fresh
 702          chunk of the obstack and use that until this particular
 703          invocation returns.  */
 704       /* Bump up the high-water mark.  Now alpha is omega.  */
 705       obstack_finish (&dont_print_vb_obstack);
 706     }
 707
 708   for (i = 0; i < n_baseclasses; i++)
 709     {
 710       LONGEST boffset = 0;
 711       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 712       const char *basename = baseclass->name ();
 713       int skip = 0;
 714
 715       if (BASETYPE_VIA_VIRTUAL (type, i))
 716         {
 717           struct type **first_dont_print
 718             = (struct type **) obstack_base (&dont_print_vb_obstack);
 719
 720           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 721             - first_dont_print;
 722
 723           while (--j >= 0)
 724             if (baseclass == first_dont_print[j])
 725               goto flush_it;
 726
 727           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 728         }
 729
 730       struct value *base_value;
 731       try
 732         {
 733           base_value = value_primitive_field (val, 0, i, type);
 734         }
 735       catch (const gdb_exception_error &ex)
 736         {
 737           base_value = nullptr;
 738           if (ex.error == NOT_AVAILABLE_ERROR)
 739             skip = -1;
 740           else
 741             skip = 1;
 742         }
 743
 744       if (skip == 0)
 745         {
 746           /* The virtual base class pointer might have been clobbered by the
 747              user program. Make sure that it still points to a valid memory
 748              location.  */
 749
 750           if (boffset < 0 || boffset >= TYPE_LENGTH (type))
 751             {
 752               CORE_ADDR address= value_address (val);
 753               gdb::byte_vector buf (TYPE_LENGTH (baseclass));
 754
 755               if (target_read_memory (address + boffset, buf.data (),
 756                                       TYPE_LENGTH (baseclass)) != 0)
 757                 skip = 1;
 758               base_value = value_from_contents_and_address (baseclass,
 759                                                             buf.data (),
 760                                                             address + boffset);
 761               baseclass = value_type (base_value);
 762               boffset = 0;
 763             }
 764         }
 765
 766       if (options->prettyformat)
 767         {
 768           fprintf_filtered (stream, "\n");
 769           print_spaces_filtered (2 * recurse, stream);
 770         }
 771       fputs_filtered ("<", stream);
 772       /* Not sure what the best notation is in the case where there is no
 773          baseclass name.  */
 774
 775       fputs_filtered (basename ? basename : "", stream);
 776       fputs_filtered ("> = ", stream);
 777
 778       if (skip < 0)
 779         val_print_unavailable (stream);
 780       else if (skip > 0)
 781         val_print_invalid_address (stream);
 782       else
 783         pascal_object_print_value_fields
 784           (base_value, stream, recurse, options,
 785            (struct type **) obstack_base (&dont_print_vb_obstack),
 786            0);
 787       fputs_filtered (", ", stream);
 788
 789     flush_it:
 790       ;
 791     }
 792
 793   if (dont_print_vb == 0)
 794     {
 795       /* Free the space used to deal with the printing
 796          of this type from top level.  */
 797       obstack_free (&dont_print_vb_obstack, last_dont_print);
 798       /* Reset watermark so that we can continue protecting
 799          ourselves from whatever we were protecting ourselves.  */
 800       dont_print_vb_obstack = tmp_obstack;
 801     }
 802 }
 803
 804 /* Print value of a static member.
 805    To avoid infinite recursion when printing a class that contains
 806    a static instance of the class, we keep the addresses of all printed
 807    static member classes in an obstack and refuse to print them more
 808    than once.
 809
 810    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 811    have the same meanings as in c_val_print.  */
 812
 813 static void
 814 pascal_object_print_static_field (struct value *val,
 815                                   struct ui_file *stream,
 816                                   int recurse,
 817                                   const struct value_print_options *options)
 818 {
 819   struct type *type = value_type (val);
 820   struct value_print_options opts;
 821
 822   if (value_entirely_optimized_out (val))
 823     {
 824       val_print_optimized_out (val, stream);
 825       return;
 826     }
 827
 828   if (type->code () == TYPE_CODE_STRUCT)
 829     {
 830       CORE_ADDR *first_dont_print, addr;
 831       int i;
 832
 833       first_dont_print
 834         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 835       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 836         - first_dont_print;
 837
 838       while (--i >= 0)
 839         {
 840           if (value_address (val) == first_dont_print[i])
 841             {
 842               fputs_styled (_("\
 843 <same as static member of an already seen type>"),
 844                             metadata_style.style (), stream);
 845               return;
 846             }
 847         }
 848
 849       addr = value_address (val);
 850       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 851                     sizeof (CORE_ADDR));
 852
 853       type = check_typedef (type);
 854       pascal_object_print_value_fields (val, stream, recurse,
 855                                         options, NULL, 1);
 856       return;
 857     }
 858
 859   opts = *options;
 860   opts.deref_ref = 0;
 861   common_val_print (val, stream, recurse, &opts, current_language);
 862 }
 863
 864 void _initialize_pascal_valprint ();
 865 void
 866 _initialize_pascal_valprint ()
 867 {
 868   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 869                            &user_print_options.pascal_static_field_print, _("\
 870 Set printing of pascal static members."), _("\
 871 Show printing of pascal static members."), NULL,
 872                            NULL,
 873                            show_pascal_static_field_print,
 874                            &setprintlist, &showprintlist);
 875 }