gdb/p-valprint.c

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