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 "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   struct type *elttype;
  73   unsigned eltlen;
  74   int length_pos, length_size, string_pos;
  75   struct type *char_type;
  76   CORE_ADDR addr;
  77   int want_space = 0;
  78   const gdb_byte *valaddr = value_contents_for_printing (original_value);
  79
  80   type = check_typedef (type);
  81   switch (TYPE_CODE (type))
  82     {
  83     case TYPE_CODE_ARRAY:
  84       {
  85         LONGEST low_bound, high_bound;
  86
  87         if (get_array_bounds (type, &low_bound, &high_bound))
  88           {
  89             len = high_bound - low_bound + 1;
  90             elttype = check_typedef (TYPE_TARGET_TYPE (type));
  91             eltlen = TYPE_LENGTH (elttype);
  92             if (options->prettyformat_arrays)
  93               {
  94                 print_spaces_filtered (2 + 2 * recurse, stream);
  95               }
  96             /* If 's' format is used, try to print out as string.
  97                If no format is given, print as string if element type
  98                is of TYPE_CODE_CHAR and element size is 1,2 or 4.  */
  99             if (options->format == 's'
 100                 || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
 101                     && TYPE_CODE (elttype) == TYPE_CODE_CHAR
 102                     && options->format == 0))
 103               {
 104                 /* If requested, look for the first null char and only print
 105                    elements up to it.  */
 106                 if (options->stop_print_at_null)
 107                   {
 108                     unsigned int temp_len;
 109
 110                     /* Look for a NULL char.  */
 111                     for (temp_len = 0;
 112                          extract_unsigned_integer (valaddr + embedded_offset +
 113                                                    temp_len * eltlen, eltlen,
 114                                                    byte_order)
 115                            && temp_len < len && temp_len < options->print_max;
 116                          temp_len++);
 117                     len = temp_len;
 118                   }
 119
 120                 LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
 121                                  valaddr + embedded_offset, len, NULL, 0,
 122                                  options);
 123                 i = len;
 124               }
 125             else
 126               {
 127                 fprintf_filtered (stream, "{");
 128                 /* If this is a virtual function table, print the 0th
 129                    entry specially, and the rest of the members normally.  */
 130                 if (pascal_object_is_vtbl_ptr_type (elttype))
 131                   {
 132                     i = 1;
 133                     fprintf_filtered (stream, "%d vtable entries", len - 1);
 134                   }
 135                 else
 136                   {
 137                     i = 0;
 138                   }
 139                 val_print_array_elements (type, embedded_offset,
 140                                           address, stream, recurse,
 141                                           original_value, options, i);
 142                 fprintf_filtered (stream, "}");
 143               }
 144             break;
 145           }
 146         /* Array of unspecified length: treat like pointer to first elt.  */
 147         addr = address + embedded_offset;
 148       }
 149       goto print_unpacked_pointer;
 150
 151     case TYPE_CODE_PTR:
 152       if (options->format && options->format != 's')
 153         {
 154           val_print_scalar_formatted (type, embedded_offset,
 155                                       original_value, options, 0, stream);
 156           break;
 157         }
 158       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 159         {
 160           /* Print the unmangled name if desired.  */
 161           /* Print vtable entry - we only get here if we ARE using
 162              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.)  */
 163           /* Extract the address, assume that it is unsigned.  */
 164           addr = extract_unsigned_integer (valaddr + embedded_offset,
 165                                            TYPE_LENGTH (type), byte_order);
 166           print_address_demangle (options, gdbarch, addr, stream, demangle);
 167           break;
 168         }
 169       check_typedef (TYPE_TARGET_TYPE (type));
 170
 171       addr = unpack_pointer (type, valaddr + embedded_offset);
 172     print_unpacked_pointer:
 173       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 174
 175       if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 176         {
 177           /* Try to print what function it points to.  */
 178           print_address_demangle (options, gdbarch, addr, stream, demangle);
 179           return;
 180         }
 181
 182       if (options->addressprint && options->format != 's')
 183         {
 184           fputs_filtered (paddress (gdbarch, addr), stream);
 185           want_space = 1;
 186         }
 187
 188       /* For a pointer to char or unsigned char, also print the string
 189          pointed to, unless pointer is null.  */
 190       if (((TYPE_LENGTH (elttype) == 1
 191            && (TYPE_CODE (elttype) == TYPE_CODE_INT
 192               || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 193           || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
 194               && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 195           && (options->format == 0 || options->format == 's')
 196           && addr != 0)
 197         {
 198           if (want_space)
 199             fputs_filtered (" ", stream);
 200           /* No wide string yet.  */
 201           i = val_print_string (elttype, NULL, addr, -1, stream, options);
 202         }
 203       /* Also for pointers to pascal strings.  */
 204       /* Note: this is Free Pascal specific:
 205          as GDB does not recognize stabs pascal strings
 206          Pascal strings are mapped to records
 207          with lowercase names PM.  */
 208       if (is_pascal_string_type (elttype, &length_pos, &length_size,
 209                                  &string_pos, &char_type, NULL)
 210           && addr != 0)
 211         {
 212           ULONGEST string_length;
 213           gdb_byte *buffer;
 214
 215           if (want_space)
 216             fputs_filtered (" ", stream);
 217           buffer = (gdb_byte *) xmalloc (length_size);
 218           read_memory (addr + length_pos, buffer, length_size);
 219           string_length = extract_unsigned_integer (buffer, length_size,
 220                                                     byte_order);
 221           xfree (buffer);
 222           i = val_print_string (char_type, NULL,
 223                                 addr + string_pos, string_length,
 224                                 stream, options);
 225         }
 226       else if (pascal_object_is_vtbl_member (type))
 227         {
 228           /* Print vtbl's nicely.  */
 229           CORE_ADDR vt_address = unpack_pointer (type,
 230                                                  valaddr + embedded_offset);
 231           struct bound_minimal_symbol msymbol =
 232             lookup_minimal_symbol_by_pc (vt_address);
 233
 234           /* If 'symbol_print' is set, we did the work above.  */
 235           if (!options->symbol_print
 236               && (msymbol.minsym != NULL)
 237               && (vt_address == BMSYMBOL_VALUE_ADDRESS (msymbol)))
 238             {
 239               if (want_space)
 240                 fputs_filtered (" ", stream);
 241               fputs_filtered ("<", stream);
 242               fputs_filtered (MSYMBOL_PRINT_NAME (msymbol.minsym), stream);
 243               fputs_filtered (">", stream);
 244               want_space = 1;
 245             }
 246           if (vt_address && options->vtblprint)
 247             {
 248               struct value *vt_val;
 249               struct symbol *wsym = NULL;
 250               struct type *wtype;
 251               struct block *block = NULL;
 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, block,
 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_filtered (stream, "<incomplete type>");
 352           gdb_flush (stream);
 353           break;
 354         }
 355       else
 356         {
 357           struct type *range = elttype;
 358           LONGEST low_bound, high_bound;
 359           int need_comma = 0;
 360
 361           fputs_filtered ("[", stream);
 362
 363           int bound_info = get_discrete_bounds (range, &low_bound, &high_bound);
 364           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
 365             {
 366               /* If we know the size of the set type, we can figure out the
 367               maximum value.  */
 368               bound_info = 0;
 369               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
 370               TYPE_HIGH_BOUND (range) = high_bound;
 371             }
 372         maybe_bad_bstring:
 373           if (bound_info < 0)
 374             {
 375               fputs_filtered ("<error value>", stream);
 376               goto done;
 377             }
 378
 379           for (i = low_bound; i <= high_bound; i++)
 380             {
 381               int element = value_bit_index (type,
 382                                              valaddr + embedded_offset, i);
 383
 384               if (element < 0)
 385                 {
 386                   i = element;
 387                   goto maybe_bad_bstring;
 388                 }
 389               if (element)
 390                 {
 391                   if (need_comma)
 392                     fputs_filtered (", ", stream);
 393                   print_type_scalar (range, i, stream);
 394                   need_comma = 1;
 395
 396                   if (i + 1 <= high_bound
 397                       && value_bit_index (type,
 398                                           valaddr + embedded_offset, ++i))
 399                     {
 400                       int j = i;
 401
 402                       fputs_filtered ("..", stream);
 403                       while (i + 1 <= high_bound
 404                              && value_bit_index (type,
 405                                                  valaddr + embedded_offset,
 406                                                  ++i))
 407                         j = i;
 408                       print_type_scalar (range, j, stream);
 409                     }
 410                 }
 411             }
 412         done:
 413           fputs_filtered ("]", stream);
 414         }
 415       break;
 416
 417     default:
 418       error (_("Invalid pascal type code %d in symbol table."),
 419              TYPE_CODE (type));
 420     }
 421   gdb_flush (stream);
 422 }
 423 \f
 424 void
 425 pascal_value_print (struct value *val, struct ui_file *stream,
 426                     const struct value_print_options *options)
 427 {
 428   struct type *type = value_type (val);
 429   struct value_print_options opts = *options;
 430
 431   opts.deref_ref = 1;
 432
 433   /* If it is a pointer, indicate what it points to.
 434
 435      Print type also if it is a reference.
 436
 437      Object pascal: if it is a member pointer, we will take care
 438      of that when we print it.  */
 439   if (TYPE_CODE (type) == TYPE_CODE_PTR
 440       || TYPE_CODE (type) == TYPE_CODE_REF)
 441     {
 442       /* Hack:  remove (char *) for char strings.  Their
 443          type is indicated by the quoted string anyway.  */
 444       if (TYPE_CODE (type) == TYPE_CODE_PTR
 445           && TYPE_NAME (type) == NULL
 446           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 447           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 448         {
 449           /* Print nothing.  */
 450         }
 451       else
 452         {
 453           fprintf_filtered (stream, "(");
 454           type_print (type, "", stream, -1);
 455           fprintf_filtered (stream, ") ");
 456         }
 457     }
 458   common_val_print (val, stream, 0, &opts, current_language);
 459 }
 460
 461
 462 static void
 463 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 464                                 struct cmd_list_element *c, const char *value)
 465 {
 466   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 467                     value);
 468 }
 469
 470 static struct obstack dont_print_vb_obstack;
 471 static struct obstack dont_print_statmem_obstack;
 472
 473 static void pascal_object_print_static_field (struct value *,
 474                                               struct ui_file *, int,
 475                                               const struct value_print_options *);
 476
 477 static void pascal_object_print_value (struct type *, const gdb_byte *,
 478                                        LONGEST,
 479                                        CORE_ADDR, struct ui_file *, int,
 480                                        struct value *,
 481                                        const struct value_print_options *,
 482                                        struct type **);
 483
 484 /* It was changed to this after 2.4.5.  */
 485 const char pascal_vtbl_ptr_name[] =
 486 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 487
 488 /* Return truth value for assertion that TYPE is of the type
 489    "pointer to virtual function".  */
 490
 491 int
 492 pascal_object_is_vtbl_ptr_type (struct type *type)
 493 {
 494   const char *type_name = TYPE_NAME (type);
 495
 496   return (type_name != NULL
 497           && strcmp (type_name, pascal_vtbl_ptr_name) == 0);
 498 }
 499
 500 /* Return truth value for the assertion that TYPE is of the type
 501    "pointer to virtual function table".  */
 502
 503 int
 504 pascal_object_is_vtbl_member (struct type *type)
 505 {
 506   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 507     {
 508       type = TYPE_TARGET_TYPE (type);
 509       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 510         {
 511           type = TYPE_TARGET_TYPE (type);
 512           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* If not using
 513                                                            thunks.  */
 514               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* If using thunks.  */
 515             {
 516               /* Virtual functions tables are full of pointers
 517                  to virtual functions.  */
 518               return pascal_object_is_vtbl_ptr_type (type);
 519             }
 520         }
 521     }
 522   return 0;
 523 }
 524
 525 /* Mutually recursive subroutines of pascal_object_print_value and
 526    c_val_print to print out a structure's fields:
 527    pascal_object_print_value_fields and pascal_object_print_value.
 528
 529    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 530    same meanings as in pascal_object_print_value and c_val_print.
 531
 532    DONT_PRINT is an array of baseclass types that we
 533    should not print, or zero if called from top level.  */
 534
 535 void
 536 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 537                                   LONGEST offset,
 538                                   CORE_ADDR address, struct ui_file *stream,
 539                                   int recurse,
 540                                   struct value *val,
 541                                   const struct value_print_options *options,
 542                                   struct type **dont_print_vb,
 543                                   int dont_print_statmem)
 544 {
 545   int i, len, n_baseclasses;
 546   char *last_dont_print
 547     = (char *) obstack_next_free (&dont_print_statmem_obstack);
 548
 549   type = check_typedef (type);
 550
 551   fprintf_filtered (stream, "{");
 552   len = TYPE_NFIELDS (type);
 553   n_baseclasses = TYPE_N_BASECLASSES (type);
 554
 555   /* Print out baseclasses such that we don't print
 556      duplicates of virtual baseclasses.  */
 557   if (n_baseclasses > 0)
 558     pascal_object_print_value (type, valaddr, offset, address,
 559                                stream, recurse + 1, val,
 560                                options, dont_print_vb);
 561
 562   if (!len && n_baseclasses == 1)
 563     fprintf_filtered (stream, "<No data fields>");
 564   else
 565     {
 566       struct obstack tmp_obstack = dont_print_statmem_obstack;
 567       int fields_seen = 0;
 568
 569       if (dont_print_statmem == 0)
 570         {
 571           /* If we're at top level, carve out a completely fresh
 572              chunk of the obstack and use that until this particular
 573              invocation returns.  */
 574           obstack_finish (&dont_print_statmem_obstack);
 575         }
 576
 577       for (i = n_baseclasses; i < len; i++)
 578         {
 579           /* If requested, skip printing of static fields.  */
 580           if (!options->pascal_static_field_print
 581               && field_is_static (&TYPE_FIELD (type, i)))
 582             continue;
 583           if (fields_seen)
 584             fprintf_filtered (stream, ", ");
 585           else if (n_baseclasses > 0)
 586             {
 587               if (options->prettyformat)
 588                 {
 589                   fprintf_filtered (stream, "\n");
 590                   print_spaces_filtered (2 + 2 * recurse, stream);
 591                   fputs_filtered ("members of ", stream);
 592                   fputs_filtered (TYPE_NAME (type), stream);
 593                   fputs_filtered (": ", stream);
 594                 }
 595             }
 596           fields_seen = 1;
 597
 598           if (options->prettyformat)
 599             {
 600               fprintf_filtered (stream, "\n");
 601               print_spaces_filtered (2 + 2 * recurse, stream);
 602             }
 603           else
 604             {
 605               wrap_here (n_spaces (2 + 2 * recurse));
 606             }
 607
 608           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 609
 610           if (field_is_static (&TYPE_FIELD (type, i)))
 611             fputs_filtered ("static ", stream);
 612           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 613                                    language_cplus,
 614                                    DMGL_PARAMS | DMGL_ANSI);
 615           annotate_field_name_end ();
 616           fputs_filtered (" = ", stream);
 617           annotate_field_value ();
 618
 619           if (!field_is_static (&TYPE_FIELD (type, i))
 620               && TYPE_FIELD_PACKED (type, i))
 621             {
 622               struct value *v;
 623
 624               /* Bitfields require special handling, especially due to byte
 625                  order problems.  */
 626               if (TYPE_FIELD_IGNORE (type, i))
 627                 {
 628                   fputs_filtered ("<optimized out or zero length>", stream);
 629                 }
 630               else if (value_bits_synthetic_pointer (val,
 631                                                      TYPE_FIELD_BITPOS (type,
 632                                                                         i),
 633                                                      TYPE_FIELD_BITSIZE (type,
 634                                                                          i)))
 635                 {
 636                   fputs_filtered (_("<synthetic pointer>"), 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_filtered ("<optimized out or zero length>", 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 (ex, RETURN_MASK_ERROR)
 762         {
 763           if (ex.error == NOT_AVAILABLE_ERROR)
 764             skip = -1;
 765           else
 766             skip = 1;
 767         }
 768       END_CATCH
 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 }