gdb/p-valprint.c

   1 /* Support for printing Pascal values for GDB, the GNU debugger.
   2
   3    Copyright (C) 2000-2019 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 /* Decorations for Pascal.  */
  46
  47 static const struct generic_val_print_decorations p_decorations =
  48 {
  49   "",
  50   " + ",
  51   " * I",
  52   "true",
  53   "false",
  54   "void",
  55   "{",
  56   "}"
  57 };
  58
  59 /* See val_print for a description of the various parameters of this
  60    function; they are identical.  */
  61
  62 void
  63 pascal_val_print (struct type *type,
  64                   int embedded_offset, CORE_ADDR address,
  65                   struct ui_file *stream, int recurse,
  66                   struct value *original_value,
  67                   const struct value_print_options *options)
  68 {
  69   struct gdbarch *gdbarch = get_type_arch (type);
  70   enum bfd_endian byte_order = type_byte_order (type);
  71   unsigned int i = 0;   /* Number of characters printed */
  72   unsigned len;
  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       {
  86         LONGEST low_bound, high_bound;
  87
  88         if (get_array_bounds (type, &low_bound, &high_bound))
  89           {
  90             len = high_bound - low_bound + 1;
  91             elttype = check_typedef (TYPE_TARGET_TYPE (type));
  92             eltlen = TYPE_LENGTH (elttype);
  93             if (options->prettyformat_arrays)
  94               {
  95                 print_spaces_filtered (2 + 2 * recurse, stream);
  96               }
  97             /* If 's' format is used, try to print out as string.
  98                If no format is given, print as string if element type
  99                is of TYPE_CODE_CHAR and element size is 1,2 or 4.  */
 100             if (options->format == 's'
 101                 || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
 102                     && TYPE_CODE (elttype) == TYPE_CODE_CHAR
 103                     && options->format == 0))
 104               {
 105                 /* If requested, look for the first null char and only print
 106                    elements up to it.  */
 107                 if (options->stop_print_at_null)
 108                   {
 109                     unsigned int temp_len;
 110
 111                     /* Look for a NULL char.  */
 112                     for (temp_len = 0;
 113                          extract_unsigned_integer (valaddr + embedded_offset +
 114                                                    temp_len * eltlen, eltlen,
 115                                                    byte_order)
 116                            && temp_len < len && temp_len < options->print_max;
 117                          temp_len++);
 118                     len = temp_len;
 119                   }
 120
 121                 LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
 122                                  valaddr + embedded_offset, len, NULL, 0,
 123                                  options);
 124                 i = len;
 125               }
 126             else
 127               {
 128                 fprintf_filtered (stream, "{");
 129                 /* If this is a virtual function table, print the 0th
 130                    entry specially, and the rest of the members normally.  */
 131                 if (pascal_object_is_vtbl_ptr_type (elttype))
 132                   {
 133                     i = 1;
 134                     fprintf_filtered (stream, "%d vtable entries", len - 1);
 135                   }
 136                 else
 137                   {
 138                     i = 0;
 139                   }
 140                 val_print_array_elements (type, embedded_offset,
 141                                           address, stream, recurse,
 142                                           original_value, options, i);
 143                 fprintf_filtered (stream, "}");
 144               }
 145             break;
 146           }
 147         /* Array of unspecified length: treat like pointer to first elt.  */
 148         addr = address + embedded_offset;
 149       }
 150       goto print_unpacked_pointer;
 151
 152     case TYPE_CODE_PTR:
 153       if (options->format && options->format != 's')
 154         {
 155           val_print_scalar_formatted (type, embedded_offset,
 156                                       original_value, options, 0, stream);
 157           break;
 158         }
 159       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 160         {
 161           /* Print the unmangled name if desired.  */
 162           /* Print vtable entry - we only get here if we ARE using
 163              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.)  */
 164           /* Extract the address, assume that it is unsigned.  */
 165           addr = extract_unsigned_integer (valaddr + embedded_offset,
 166                                            TYPE_LENGTH (type), byte_order);
 167           print_address_demangle (options, gdbarch, addr, stream, demangle);
 168           break;
 169         }
 170       check_typedef (TYPE_TARGET_TYPE (type));
 171
 172       addr = unpack_pointer (type, valaddr + embedded_offset);
 173     print_unpacked_pointer:
 174       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 175
 176       if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 177         {
 178           /* Try to print what function it points to.  */
 179           print_address_demangle (options, gdbarch, addr, stream, demangle);
 180           return;
 181         }
 182
 183       if (options->addressprint && options->format != 's')
 184         {
 185           fputs_filtered (paddress (gdbarch, addr), stream);
 186           want_space = 1;
 187         }
 188
 189       /* For a pointer to char or unsigned char, also print the string
 190          pointed to, unless pointer is null.  */
 191       if (((TYPE_LENGTH (elttype) == 1
 192            && (TYPE_CODE (elttype) == TYPE_CODE_INT
 193               || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 194           || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
 195               && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 196           && (options->format == 0 || options->format == 's')
 197           && addr != 0)
 198         {
 199           if (want_space)
 200             fputs_filtered (" ", stream);
 201           /* No wide string yet.  */
 202           i = val_print_string (elttype, NULL, addr, -1, stream, options);
 203         }
 204       /* Also for pointers to pascal strings.  */
 205       /* Note: this is Free Pascal specific:
 206          as GDB does not recognize stabs pascal strings
 207          Pascal strings are mapped to records
 208          with lowercase names PM.  */
 209       if (is_pascal_string_type (elttype, &length_pos, &length_size,
 210                                  &string_pos, &char_type, NULL)
 211           && addr != 0)
 212         {
 213           ULONGEST string_length;
 214           gdb_byte *buffer;
 215
 216           if (want_space)
 217             fputs_filtered (" ", stream);
 218           buffer = (gdb_byte *) xmalloc (length_size);
 219           read_memory (addr + length_pos, buffer, length_size);
 220           string_length = extract_unsigned_integer (buffer, length_size,
 221                                                     byte_order);
 222           xfree (buffer);
 223           i = val_print_string (char_type, NULL,
 224                                 addr + string_pos, string_length,
 225                                 stream, options);
 226         }
 227       else if (pascal_object_is_vtbl_member (type))
 228         {
 229           /* Print vtbl's nicely.  */
 230           CORE_ADDR vt_address = unpack_pointer (type,
 231                                                  valaddr + embedded_offset);
 232           struct bound_minimal_symbol msymbol =
 233             lookup_minimal_symbol_by_pc (vt_address);
 234
 235           /* If 'symbol_print' is set, we did the work above.  */
 236           if (!options->symbol_print
 237               && (msymbol.minsym != NULL)
 238               && (vt_address == BMSYMBOL_VALUE_ADDRESS (msymbol)))
 239             {
 240               if (want_space)
 241                 fputs_filtered (" ", stream);
 242               fputs_filtered ("<", stream);
 243               fputs_filtered (MSYMBOL_PRINT_NAME (msymbol.minsym), stream);
 244               fputs_filtered (">", stream);
 245               want_space = 1;
 246             }
 247           if (vt_address && options->vtblprint)
 248             {
 249               struct value *vt_val;
 250               struct symbol *wsym = NULL;
 251               struct type *wtype;
 252
 253               if (want_space)
 254                 fputs_filtered (" ", stream);
 255
 256               if (msymbol.minsym != NULL)
 257                 {
 258                   const char *search_name
 259                     = MSYMBOL_SEARCH_NAME (msymbol.minsym);
 260                   wsym = lookup_symbol_search_name (search_name, NULL,
 261                                                     VAR_DOMAIN).symbol;
 262                 }
 263
 264               if (wsym)
 265                 {
 266                   wtype = SYMBOL_TYPE (wsym);
 267                 }
 268               else
 269                 {
 270                   wtype = TYPE_TARGET_TYPE (type);
 271                 }
 272               vt_val = value_at (wtype, vt_address);
 273               common_val_print (vt_val, stream, recurse + 1, options,
 274                                 current_language);
 275               if (options->prettyformat)
 276                 {
 277                   fprintf_filtered (stream, "\n");
 278                   print_spaces_filtered (2 + 2 * recurse, stream);
 279                 }
 280             }
 281         }
 282
 283       return;
 284
 285     case TYPE_CODE_REF:
 286     case TYPE_CODE_ENUM:
 287     case TYPE_CODE_FLAGS:
 288     case TYPE_CODE_FUNC:
 289     case TYPE_CODE_RANGE:
 290     case TYPE_CODE_INT:
 291     case TYPE_CODE_FLT:
 292     case TYPE_CODE_VOID:
 293     case TYPE_CODE_ERROR:
 294     case TYPE_CODE_UNDEF:
 295     case TYPE_CODE_BOOL:
 296     case TYPE_CODE_CHAR:
 297       generic_val_print (type, embedded_offset, address,
 298                          stream, recurse, original_value, options,
 299                          &p_decorations);
 300       break;
 301
 302     case TYPE_CODE_UNION:
 303       if (recurse && !options->unionprint)
 304         {
 305           fprintf_filtered (stream, "{...}");
 306           break;
 307         }
 308       /* Fall through.  */
 309     case TYPE_CODE_STRUCT:
 310       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 311         {
 312           /* Print the unmangled name if desired.  */
 313           /* Print vtable entry - we only get here if NOT using
 314              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.)  */
 315           /* Extract the address, assume that it is unsigned.  */
 316           print_address_demangle
 317             (options, gdbarch,
 318              extract_unsigned_integer (valaddr + embedded_offset
 319                                        + TYPE_FIELD_BITPOS (type,
 320                                                             VTBL_FNADDR_OFFSET) / 8,
 321                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type,
 322                                                                      VTBL_FNADDR_OFFSET)),
 323                                        byte_order),
 324              stream, demangle);
 325         }
 326       else
 327         {
 328           if (is_pascal_string_type (type, &length_pos, &length_size,
 329                                      &string_pos, &char_type, NULL))
 330             {
 331               len = extract_unsigned_integer (valaddr + embedded_offset
 332                                               + length_pos, length_size,
 333                                               byte_order);
 334               LA_PRINT_STRING (stream, char_type,
 335                                valaddr + embedded_offset + string_pos,
 336                                len, NULL, 0, options);
 337             }
 338           else
 339             pascal_object_print_value_fields (type, valaddr, embedded_offset,
 340                                               address, stream, recurse,
 341                                               original_value, options,
 342                                               NULL, 0);
 343         }
 344       break;
 345
 346     case TYPE_CODE_SET:
 347       elttype = TYPE_INDEX_TYPE (type);
 348       elttype = check_typedef (elttype);
 349       if (TYPE_STUB (elttype))
 350         {
 351           fprintf_styled (stream, metadata_style.style (), "<incomplete type>");
 352           break;
 353         }
 354       else
 355         {
 356           struct type *range = elttype;
 357           LONGEST low_bound, high_bound;
 358           int need_comma = 0;
 359
 360           fputs_filtered ("[", stream);
 361
 362           int bound_info = get_discrete_bounds (range, &low_bound, &high_bound);
 363           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
 364             {
 365               /* If we know the size of the set type, we can figure out the
 366               maximum value.  */
 367               bound_info = 0;
 368               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
 369               TYPE_HIGH_BOUND (range) = high_bound;
 370             }
 371         maybe_bad_bstring:
 372           if (bound_info < 0)
 373             {
 374               fputs_styled ("<error value>", metadata_style.style (), stream);
 375               goto done;
 376             }
 377
 378           for (i = low_bound; i <= high_bound; i++)
 379             {
 380               int element = value_bit_index (type,
 381                                              valaddr + embedded_offset, i);
 382
 383               if (element < 0)
 384                 {
 385                   i = element;
 386                   goto maybe_bad_bstring;
 387                 }
 388               if (element)
 389                 {
 390                   if (need_comma)
 391                     fputs_filtered (", ", stream);
 392                   print_type_scalar (range, i, stream);
 393                   need_comma = 1;
 394
 395                   if (i + 1 <= high_bound
 396                       && value_bit_index (type,
 397                                           valaddr + embedded_offset, ++i))
 398                     {
 399                       int j = i;
 400
 401                       fputs_filtered ("..", stream);
 402                       while (i + 1 <= high_bound
 403                              && value_bit_index (type,
 404                                                  valaddr + embedded_offset,
 405                                                  ++i))
 406                         j = i;
 407                       print_type_scalar (range, j, stream);
 408                     }
 409                 }
 410             }
 411         done:
 412           fputs_filtered ("]", stream);
 413         }
 414       break;
 415
 416     default:
 417       error (_("Invalid pascal type code %d in symbol table."),
 418              TYPE_CODE (type));
 419     }
 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_styled (stream, metadata_style.style (), "<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_styled ("<optimized out or zero length>",
 627                                 metadata_style.style (), stream);
 628                 }
 629               else if (value_bits_synthetic_pointer (val,
 630                                                      TYPE_FIELD_BITPOS (type,
 631                                                                         i),
 632                                                      TYPE_FIELD_BITSIZE (type,
 633                                                                          i)))
 634                 {
 635                   fputs_styled (_("<synthetic pointer>"),
 636                                 metadata_style.style (), stream);
 637                 }
 638               else
 639                 {
 640                   struct value_print_options opts = *options;
 641
 642                   v = value_field_bitfield (type, i, valaddr, offset, val);
 643
 644                   opts.deref_ref = 0;
 645                   common_val_print (v, stream, recurse + 1, &opts,
 646                                     current_language);
 647                 }
 648             }
 649           else
 650             {
 651               if (TYPE_FIELD_IGNORE (type, i))
 652                 {
 653                   fputs_styled ("<optimized out or zero length>",
 654                                 metadata_style.style (), stream);
 655                 }
 656               else if (field_is_static (&TYPE_FIELD (type, i)))
 657                 {
 658                   /* struct value *v = value_static_field (type, i);
 659                      v4.17 specific.  */
 660                   struct value *v;
 661
 662                   v = value_field_bitfield (type, i, valaddr, offset, val);
 663
 664                   if (v == NULL)
 665                     val_print_optimized_out (NULL, stream);
 666                   else
 667                     pascal_object_print_static_field (v, stream, recurse + 1,
 668                                                       options);
 669                 }
 670               else
 671                 {
 672                   struct value_print_options opts = *options;
 673
 674                   opts.deref_ref = 0;
 675                   /* val_print (TYPE_FIELD_TYPE (type, i),
 676                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 677                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 678                      stream, format, 0, recurse + 1, pretty); */
 679                   val_print (TYPE_FIELD_TYPE (type, i),
 680                              offset + TYPE_FIELD_BITPOS (type, i) / 8,
 681                              address, stream, recurse + 1, val, &opts,
 682                              current_language);
 683                 }
 684             }
 685           annotate_field_end ();
 686         }
 687
 688       if (dont_print_statmem == 0)
 689         {
 690           /* Free the space used to deal with the printing
 691              of the members from top level.  */
 692           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 693           dont_print_statmem_obstack = tmp_obstack;
 694         }
 695
 696       if (options->prettyformat)
 697         {
 698           fprintf_filtered (stream, "\n");
 699           print_spaces_filtered (2 * recurse, stream);
 700         }
 701     }
 702   fprintf_filtered (stream, "}");
 703 }
 704
 705 /* Special val_print routine to avoid printing multiple copies of virtual
 706    baseclasses.  */
 707
 708 static void
 709 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 710                            LONGEST offset,
 711                            CORE_ADDR address, struct ui_file *stream,
 712                            int recurse,
 713                            struct value *val,
 714                            const struct value_print_options *options,
 715                            struct type **dont_print_vb)
 716 {
 717   struct type **last_dont_print
 718     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 719   struct obstack tmp_obstack = dont_print_vb_obstack;
 720   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 721
 722   if (dont_print_vb == 0)
 723     {
 724       /* If we're at top level, carve out a completely fresh
 725          chunk of the obstack and use that until this particular
 726          invocation returns.  */
 727       /* Bump up the high-water mark.  Now alpha is omega.  */
 728       obstack_finish (&dont_print_vb_obstack);
 729     }
 730
 731   for (i = 0; i < n_baseclasses; i++)
 732     {
 733       LONGEST boffset = 0;
 734       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 735       const char *basename = TYPE_NAME (baseclass);
 736       const gdb_byte *base_valaddr = NULL;
 737       LONGEST thisoffset;
 738       int skip = 0;
 739       gdb::byte_vector buf;
 740
 741       if (BASETYPE_VIA_VIRTUAL (type, i))
 742         {
 743           struct type **first_dont_print
 744             = (struct type **) obstack_base (&dont_print_vb_obstack);
 745
 746           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 747             - first_dont_print;
 748
 749           while (--j >= 0)
 750             if (baseclass == first_dont_print[j])
 751               goto flush_it;
 752
 753           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 754         }
 755
 756       thisoffset = offset;
 757
 758       try
 759         {
 760           boffset = baseclass_offset (type, i, valaddr, offset, address, val);
 761         }
 762       catch (const gdb_exception_error &ex)
 763         {
 764           if (ex.error == NOT_AVAILABLE_ERROR)
 765             skip = -1;
 766           else
 767             skip = 1;
 768         }
 769
 770       if (skip == 0)
 771         {
 772           /* The virtual base class pointer might have been clobbered by the
 773              user program. Make sure that it still points to a valid memory
 774              location.  */
 775
 776           if (boffset < 0 || boffset >= TYPE_LENGTH (type))
 777             {
 778               buf.resize (TYPE_LENGTH (baseclass));
 779
 780               base_valaddr = buf.data ();
 781               if (target_read_memory (address + boffset, buf.data (),
 782                                       TYPE_LENGTH (baseclass)) != 0)
 783                 skip = 1;
 784               address = address + boffset;
 785               thisoffset = 0;
 786               boffset = 0;
 787             }
 788           else
 789             base_valaddr = valaddr;
 790         }
 791
 792       if (options->prettyformat)
 793         {
 794           fprintf_filtered (stream, "\n");
 795           print_spaces_filtered (2 * recurse, stream);
 796         }
 797       fputs_filtered ("<", stream);
 798       /* Not sure what the best notation is in the case where there is no
 799          baseclass name.  */
 800
 801       fputs_filtered (basename ? basename : "", stream);
 802       fputs_filtered ("> = ", stream);
 803
 804       if (skip < 0)
 805         val_print_unavailable (stream);
 806       else if (skip > 0)
 807         val_print_invalid_address (stream);
 808       else
 809         pascal_object_print_value_fields (baseclass, base_valaddr,
 810                                           thisoffset + boffset, address,
 811                                           stream, recurse, val, options,
 812                      (struct type **) obstack_base (&dont_print_vb_obstack),
 813                                           0);
 814       fputs_filtered (", ", stream);
 815
 816     flush_it:
 817       ;
 818     }
 819
 820   if (dont_print_vb == 0)
 821     {
 822       /* Free the space used to deal with the printing
 823          of this type from top level.  */
 824       obstack_free (&dont_print_vb_obstack, last_dont_print);
 825       /* Reset watermark so that we can continue protecting
 826          ourselves from whatever we were protecting ourselves.  */
 827       dont_print_vb_obstack = tmp_obstack;
 828     }
 829 }
 830
 831 /* Print value of a static member.
 832    To avoid infinite recursion when printing a class that contains
 833    a static instance of the class, we keep the addresses of all printed
 834    static member classes in an obstack and refuse to print them more
 835    than once.
 836
 837    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 838    have the same meanings as in c_val_print.  */
 839
 840 static void
 841 pascal_object_print_static_field (struct value *val,
 842                                   struct ui_file *stream,
 843                                   int recurse,
 844                                   const struct value_print_options *options)
 845 {
 846   struct type *type = value_type (val);
 847   struct value_print_options opts;
 848
 849   if (value_entirely_optimized_out (val))
 850     {
 851       val_print_optimized_out (val, stream);
 852       return;
 853     }
 854
 855   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 856     {
 857       CORE_ADDR *first_dont_print, addr;
 858       int i;
 859
 860       first_dont_print
 861         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 862       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 863         - first_dont_print;
 864
 865       while (--i >= 0)
 866         {
 867           if (value_address (val) == first_dont_print[i])
 868             {
 869               fputs_filtered ("\
 870 <same as static member of an already seen type>",
 871                               stream);
 872               return;
 873             }
 874         }
 875
 876       addr = value_address (val);
 877       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 878                     sizeof (CORE_ADDR));
 879
 880       type = check_typedef (type);
 881       pascal_object_print_value_fields (type,
 882                                         value_contents_for_printing (val),
 883                                         value_embedded_offset (val),
 884                                         addr,
 885                                         stream, recurse,
 886                                         val, options, NULL, 1);
 887       return;
 888     }
 889
 890   opts = *options;
 891   opts.deref_ref = 0;
 892   common_val_print (val, stream, recurse, &opts, current_language);
 893 }
 894
 895 void
 896 _initialize_pascal_valprint (void)
 897 {
 898   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 899                            &user_print_options.pascal_static_field_print, _("\
 900 Set printing of pascal static members."), _("\
 901 Show printing of pascal static members."), NULL,
 902                            NULL,
 903                            show_pascal_static_field_print,
 904                            &setprintlist, &showprintlist);
 905 }