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