gdb/p-valprint.c

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