gdb/p-valprint.c

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