gdb/p-valprint.c

   1 /* Support for printing Pascal values for GDB, the GNU debugger.
   2
   3    Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010
   4    Free Software Foundation, Inc.
   5
   6    This file is part of GDB.
   7
   8    This program is free software; you can redistribute it and/or modify
   9    it under the terms of the GNU General Public License as published by
  10    the Free Software Foundation; either version 3 of the License, or
  11    (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public License
  19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21 /* This file is derived from c-valprint.c */
  22
  23 #include "defs.h"
  24 #include "gdb_obstack.h"
  25 #include "symtab.h"
  26 #include "gdbtypes.h"
  27 #include "expression.h"
  28 #include "value.h"
  29 #include "command.h"
  30 #include "gdbcmd.h"
  31 #include "gdbcore.h"
  32 #include "demangle.h"
  33 #include "valprint.h"
  34 #include "typeprint.h"
  35 #include "language.h"
  36 #include "target.h"
  37 #include "annotate.h"
  38 #include "p-lang.h"
  39 #include "cp-abi.h"
  40 #include "cp-support.h"
  41 \f
  42
  43
  44
  45 /* Print data of type TYPE located at VALADDR (within GDB), which came from
  46    the inferior at address ADDRESS, onto stdio stream STREAM according to
  47    OPTIONS.  The data at VALADDR is in target byte order.
  48
  49    If the data are a string pointer, returns the number of string characters
  50    printed.  */
  51
  52
  53 int
  54 pascal_val_print (struct type *type, const gdb_byte *valaddr,
  55                   int embedded_offset, CORE_ADDR address,
  56                   struct ui_file *stream, int recurse,
  57                   const struct value_print_options *options)
  58 {
  59   struct gdbarch *gdbarch = get_type_arch (type);
  60   enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
  61   unsigned int i = 0;   /* Number of characters printed */
  62   unsigned len;
  63   struct type *elttype;
  64   unsigned eltlen;
  65   int length_pos, length_size, string_pos;
  66   struct type *char_type;
  67   LONGEST val;
  68   CORE_ADDR addr;
  69
  70   CHECK_TYPEDEF (type);
  71   switch (TYPE_CODE (type))
  72     {
  73     case TYPE_CODE_ARRAY:
  74       if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
  75         {
  76           elttype = check_typedef (TYPE_TARGET_TYPE (type));
  77           eltlen = TYPE_LENGTH (elttype);
  78           len = TYPE_LENGTH (type) / eltlen;
  79           if (options->prettyprint_arrays)
  80             {
  81               print_spaces_filtered (2 + 2 * recurse, stream);
  82             }
  83           /* If 's' format is used, try to print out as string.
  84              If no format is given, print as string if element type
  85              is of TYPE_CODE_CHAR and element size is 1,2 or 4.  */
  86           if (options->format == 's'
  87               || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
  88                   && TYPE_CODE (elttype) == TYPE_CODE_CHAR
  89                   && options->format == 0))
  90             {
  91               /* If requested, look for the first null char and only print
  92                  elements up to it.  */
  93               if (options->stop_print_at_null)
  94                 {
  95                   unsigned int temp_len;
  96
  97                   /* Look for a NULL char. */
  98                   for (temp_len = 0;
  99                        extract_unsigned_integer (valaddr + embedded_offset +
 100                                                  temp_len * eltlen, eltlen,
 101                                                  byte_order)
 102                        && temp_len < len && temp_len < options->print_max;
 103                        temp_len++);
 104                   len = temp_len;
 105                 }
 106
 107               LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
 108                                valaddr + embedded_offset, len, NULL, 0,
 109                                options);
 110               i = len;
 111             }
 112           else
 113             {
 114               fprintf_filtered (stream, "{");
 115               /* If this is a virtual function table, print the 0th
 116                  entry specially, and the rest of the members normally.  */
 117               if (pascal_object_is_vtbl_ptr_type (elttype))
 118                 {
 119                   i = 1;
 120                   fprintf_filtered (stream, "%d vtable entries", len - 1);
 121                 }
 122               else
 123                 {
 124                   i = 0;
 125                 }
 126               val_print_array_elements (type, valaddr + embedded_offset, address, stream,
 127                                         recurse, options, i);
 128               fprintf_filtered (stream, "}");
 129             }
 130           break;
 131         }
 132       /* Array of unspecified length: treat like pointer to first elt.  */
 133       addr = address;
 134       goto print_unpacked_pointer;
 135
 136     case TYPE_CODE_PTR:
 137       if (options->format && options->format != 's')
 138         {
 139           print_scalar_formatted (valaddr + embedded_offset, type,
 140                                   options, 0, stream);
 141           break;
 142         }
 143       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 144         {
 145           /* Print the unmangled name if desired.  */
 146           /* Print vtable entry - we only get here if we ARE using
 147              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.) */
 148           /* Extract the address, assume that it is unsigned.  */
 149           addr = extract_unsigned_integer (valaddr + embedded_offset,
 150                                            TYPE_LENGTH (type), byte_order);
 151           print_address_demangle (gdbarch, addr, stream, demangle);
 152           break;
 153         }
 154       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 155
 156       addr = unpack_pointer (type, valaddr + embedded_offset);
 157     print_unpacked_pointer:
 158       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 159
 160       if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 161         {
 162           /* Try to print what function it points to.  */
 163           print_address_demangle (gdbarch, addr, stream, demangle);
 164           /* Return value is irrelevant except for string pointers.  */
 165           return (0);
 166         }
 167
 168       if (options->addressprint && options->format != 's')
 169         {
 170           fputs_filtered (paddress (gdbarch, addr), stream);
 171         }
 172
 173       /* For a pointer to char or unsigned char, also print the string
 174          pointed to, unless pointer is null.  */
 175       if (((TYPE_LENGTH (elttype) == 1
 176            && (TYPE_CODE (elttype) == TYPE_CODE_INT
 177               || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 178           || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
 179               && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 180           && (options->format == 0 || options->format == 's')
 181           && addr != 0)
 182         {
 183           /* no wide string yet */
 184           i = val_print_string (elttype, addr, -1, stream, options);
 185         }
 186       /* also for pointers to pascal strings */
 187       /* Note: this is Free Pascal specific:
 188          as GDB does not recognize stabs pascal strings
 189          Pascal strings are mapped to records
 190          with lowercase names PM  */
 191       if (is_pascal_string_type (elttype, &length_pos, &length_size,
 192                                  &string_pos, &char_type, NULL)
 193           && addr != 0)
 194         {
 195           ULONGEST string_length;
 196           void *buffer;
 197           buffer = xmalloc (length_size);
 198           read_memory (addr + length_pos, buffer, length_size);
 199           string_length = extract_unsigned_integer (buffer, length_size,
 200                                                     byte_order);
 201           xfree (buffer);
 202           i = val_print_string (char_type ,addr + string_pos, string_length, stream, options);
 203         }
 204       else if (pascal_object_is_vtbl_member (type))
 205         {
 206           /* print vtbl's nicely */
 207           CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
 208
 209           struct minimal_symbol *msymbol =
 210           lookup_minimal_symbol_by_pc (vt_address);
 211           if ((msymbol != NULL)
 212               && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
 213             {
 214               fputs_filtered (" <", stream);
 215               fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
 216               fputs_filtered (">", stream);
 217             }
 218           if (vt_address && options->vtblprint)
 219             {
 220               struct value *vt_val;
 221               struct symbol *wsym = (struct symbol *) NULL;
 222               struct type *wtype;
 223               struct block *block = (struct block *) NULL;
 224               int is_this_fld;
 225
 226               if (msymbol != NULL)
 227                 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
 228                                       VAR_DOMAIN, &is_this_fld);
 229
 230               if (wsym)
 231                 {
 232                   wtype = SYMBOL_TYPE (wsym);
 233                 }
 234               else
 235                 {
 236                   wtype = TYPE_TARGET_TYPE (type);
 237                 }
 238               vt_val = value_at (wtype, vt_address);
 239               common_val_print (vt_val, stream, recurse + 1, options,
 240                                 current_language);
 241               if (options->pretty)
 242                 {
 243                   fprintf_filtered (stream, "\n");
 244                   print_spaces_filtered (2 + 2 * recurse, stream);
 245                 }
 246             }
 247         }
 248
 249       /* Return number of characters printed, including the terminating
 250          '\0' if we reached the end.  val_print_string takes care including
 251          the terminating '\0' if necessary.  */
 252       return i;
 253
 254       break;
 255
 256     case TYPE_CODE_REF:
 257       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 258       if (options->addressprint)
 259         {
 260           CORE_ADDR addr
 261             = extract_typed_address (valaddr + embedded_offset, type);
 262           fprintf_filtered (stream, "@");
 263           fputs_filtered (paddress (gdbarch, addr), stream);
 264           if (options->deref_ref)
 265             fputs_filtered (": ", stream);
 266         }
 267       /* De-reference the reference.  */
 268       if (options->deref_ref)
 269         {
 270           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 271             {
 272               struct value *deref_val =
 273               value_at
 274               (TYPE_TARGET_TYPE (type),
 275                unpack_pointer (type, valaddr + embedded_offset));
 276               common_val_print (deref_val, stream, recurse + 1, options,
 277                                 current_language);
 278             }
 279           else
 280             fputs_filtered ("???", stream);
 281         }
 282       break;
 283
 284     case TYPE_CODE_UNION:
 285       if (recurse && !options->unionprint)
 286         {
 287           fprintf_filtered (stream, "{...}");
 288           break;
 289         }
 290       /* Fall through.  */
 291     case TYPE_CODE_STRUCT:
 292       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 293         {
 294           /* Print the unmangled name if desired.  */
 295           /* Print vtable entry - we only get here if NOT using
 296              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.) */
 297           /* Extract the address, assume that it is unsigned.  */
 298           print_address_demangle
 299             (gdbarch,
 300              extract_unsigned_integer (valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
 301                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET)), byte_order),
 302              stream, demangle);
 303         }
 304       else
 305         {
 306           if (is_pascal_string_type (type, &length_pos, &length_size,
 307                                      &string_pos, &char_type, NULL))
 308             {
 309               len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size, byte_order);
 310               LA_PRINT_STRING (stream, char_type,
 311                                valaddr + embedded_offset + string_pos,
 312                                len, NULL, 0, options);
 313             }
 314           else
 315             pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream,
 316                                               recurse, options, NULL, 0);
 317         }
 318       break;
 319
 320     case TYPE_CODE_ENUM:
 321       if (options->format)
 322         {
 323           print_scalar_formatted (valaddr + embedded_offset, type,
 324                                   options, 0, stream);
 325           break;
 326         }
 327       len = TYPE_NFIELDS (type);
 328       val = unpack_long (type, valaddr + embedded_offset);
 329       for (i = 0; i < len; i++)
 330         {
 331           QUIT;
 332           if (val == TYPE_FIELD_BITPOS (type, i))
 333             {
 334               break;
 335             }
 336         }
 337       if (i < len)
 338         {
 339           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 340         }
 341       else
 342         {
 343           print_longest (stream, 'd', 0, val);
 344         }
 345       break;
 346
 347     case TYPE_CODE_FLAGS:
 348       if (options->format)
 349           print_scalar_formatted (valaddr + embedded_offset, type,
 350                                   options, 0, stream);
 351       else
 352         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
 353       break;
 354
 355     case TYPE_CODE_FUNC:
 356       if (options->format)
 357         {
 358           print_scalar_formatted (valaddr + embedded_offset, type,
 359                                   options, 0, stream);
 360           break;
 361         }
 362       /* FIXME, we should consider, at least for ANSI C language, eliminating
 363          the distinction made between FUNCs and POINTERs to FUNCs.  */
 364       fprintf_filtered (stream, "{");
 365       type_print (type, "", stream, -1);
 366       fprintf_filtered (stream, "} ");
 367       /* Try to print what function it points to, and its address.  */
 368       print_address_demangle (gdbarch, address, stream, demangle);
 369       break;
 370
 371     case TYPE_CODE_BOOL:
 372       if (options->format || options->output_format)
 373         {
 374           struct value_print_options opts = *options;
 375           opts.format = (options->format ? options->format
 376                          : options->output_format);
 377           print_scalar_formatted (valaddr + embedded_offset, type,
 378                                   &opts, 0, stream);
 379         }
 380       else
 381         {
 382           val = unpack_long (type, valaddr + embedded_offset);
 383           if (val == 0)
 384             fputs_filtered ("false", stream);
 385           else if (val == 1)
 386             fputs_filtered ("true", stream);
 387           else
 388             {
 389               fputs_filtered ("true (", stream);
 390               fprintf_filtered (stream, "%ld)", (long int) val);
 391             }
 392         }
 393       break;
 394
 395     case TYPE_CODE_RANGE:
 396       /* FIXME: create_range_type does not set the unsigned bit in a
 397          range type (I think it probably should copy it from the target
 398          type), so we won't print values which are too large to
 399          fit in a signed integer correctly.  */
 400       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
 401          print with the target type, though, because the size of our type
 402          and the target type might differ).  */
 403       /* FALLTHROUGH */
 404
 405     case TYPE_CODE_INT:
 406       if (options->format || options->output_format)
 407         {
 408           struct value_print_options opts = *options;
 409           opts.format = (options->format ? options->format
 410                          : options->output_format);
 411           print_scalar_formatted (valaddr + embedded_offset, type,
 412                                   &opts, 0, stream);
 413         }
 414       else
 415         {
 416           val_print_type_code_int (type, valaddr + embedded_offset, stream);
 417         }
 418       break;
 419
 420     case TYPE_CODE_CHAR:
 421       if (options->format || options->output_format)
 422         {
 423           struct value_print_options opts = *options;
 424           opts.format = (options->format ? options->format
 425                          : options->output_format);
 426           print_scalar_formatted (valaddr + embedded_offset, type,
 427                                   &opts, 0, stream);
 428         }
 429       else
 430         {
 431           val = unpack_long (type, valaddr + embedded_offset);
 432           if (TYPE_UNSIGNED (type))
 433             fprintf_filtered (stream, "%u", (unsigned int) val);
 434           else
 435             fprintf_filtered (stream, "%d", (int) val);
 436           fputs_filtered (" ", stream);
 437           LA_PRINT_CHAR ((unsigned char) val, type, stream);
 438         }
 439       break;
 440
 441     case TYPE_CODE_FLT:
 442       if (options->format)
 443         {
 444           print_scalar_formatted (valaddr + embedded_offset, type,
 445                                   options, 0, stream);
 446         }
 447       else
 448         {
 449           print_floating (valaddr + embedded_offset, type, stream);
 450         }
 451       break;
 452
 453     case TYPE_CODE_BITSTRING:
 454     case TYPE_CODE_SET:
 455       elttype = TYPE_INDEX_TYPE (type);
 456       CHECK_TYPEDEF (elttype);
 457       if (TYPE_STUB (elttype))
 458         {
 459           fprintf_filtered (stream, "<incomplete type>");
 460           gdb_flush (stream);
 461           break;
 462         }
 463       else
 464         {
 465           struct type *range = elttype;
 466           LONGEST low_bound, high_bound;
 467           int i;
 468           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
 469           int need_comma = 0;
 470
 471           if (is_bitstring)
 472             fputs_filtered ("B'", stream);
 473           else
 474             fputs_filtered ("[", stream);
 475
 476           i = get_discrete_bounds (range, &low_bound, &high_bound);
 477         maybe_bad_bstring:
 478           if (i < 0)
 479             {
 480               fputs_filtered ("<error value>", stream);
 481               goto done;
 482             }
 483
 484           for (i = low_bound; i <= high_bound; i++)
 485             {
 486               int element = value_bit_index (type, valaddr + embedded_offset, i);
 487               if (element < 0)
 488                 {
 489                   i = element;
 490                   goto maybe_bad_bstring;
 491                 }
 492               if (is_bitstring)
 493                 fprintf_filtered (stream, "%d", element);
 494               else if (element)
 495                 {
 496                   if (need_comma)
 497                     fputs_filtered (", ", stream);
 498                   print_type_scalar (range, i, stream);
 499                   need_comma = 1;
 500
 501                   if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
 502                     {
 503                       int j = i;
 504                       fputs_filtered ("..", stream);
 505                       while (i + 1 <= high_bound
 506                              && value_bit_index (type, valaddr + embedded_offset, ++i))
 507                         j = i;
 508                       print_type_scalar (range, j, stream);
 509                     }
 510                 }
 511             }
 512         done:
 513           if (is_bitstring)
 514             fputs_filtered ("'", stream);
 515           else
 516             fputs_filtered ("]", stream);
 517         }
 518       break;
 519
 520     case TYPE_CODE_VOID:
 521       fprintf_filtered (stream, "void");
 522       break;
 523
 524     case TYPE_CODE_ERROR:
 525       fprintf_filtered (stream, "<error type>");
 526       break;
 527
 528     case TYPE_CODE_UNDEF:
 529       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 530          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 531          and no complete type for struct foo in that file.  */
 532       fprintf_filtered (stream, "<incomplete type>");
 533       break;
 534
 535     default:
 536       error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
 537     }
 538   gdb_flush (stream);
 539   return (0);
 540 }
 541 \f
 542 int
 543 pascal_value_print (struct value *val, struct ui_file *stream,
 544                     const struct value_print_options *options)
 545 {
 546   struct type *type = value_type (val);
 547
 548   /* If it is a pointer, indicate what it points to.
 549
 550      Print type also if it is a reference.
 551
 552      Object pascal: if it is a member pointer, we will take care
 553      of that when we print it.  */
 554   if (TYPE_CODE (type) == TYPE_CODE_PTR
 555       || TYPE_CODE (type) == TYPE_CODE_REF)
 556     {
 557       /* Hack:  remove (char *) for char strings.  Their
 558          type is indicated by the quoted string anyway. */
 559       if (TYPE_CODE (type) == TYPE_CODE_PTR
 560           && TYPE_NAME (type) == NULL
 561           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 562           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 563         {
 564           /* Print nothing */
 565         }
 566       else
 567         {
 568           fprintf_filtered (stream, "(");
 569           type_print (type, "", stream, -1);
 570           fprintf_filtered (stream, ") ");
 571         }
 572     }
 573   return common_val_print (val, stream, 0, options, current_language);
 574 }
 575
 576
 577 static void
 578 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 579                                 struct cmd_list_element *c, const char *value)
 580 {
 581   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 582                     value);
 583 }
 584
 585 static struct obstack dont_print_vb_obstack;
 586 static struct obstack dont_print_statmem_obstack;
 587
 588 static void pascal_object_print_static_field (struct value *,
 589                                               struct ui_file *, int,
 590                                               const struct value_print_options *);
 591
 592 static void pascal_object_print_value (struct type *, const gdb_byte *,
 593                                        CORE_ADDR, struct ui_file *, int,
 594                                        const struct value_print_options *,
 595                                        struct type **);
 596
 597 /* It was changed to this after 2.4.5.  */
 598 const char pascal_vtbl_ptr_name[] =
 599 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 600
 601 /* Return truth value for assertion that TYPE is of the type
 602    "pointer to virtual function".  */
 603
 604 int
 605 pascal_object_is_vtbl_ptr_type (struct type *type)
 606 {
 607   char *typename = type_name_no_tag (type);
 608
 609   return (typename != NULL
 610           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 611 }
 612
 613 /* Return truth value for the assertion that TYPE is of the type
 614    "pointer to virtual function table".  */
 615
 616 int
 617 pascal_object_is_vtbl_member (struct type *type)
 618 {
 619   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 620     {
 621       type = TYPE_TARGET_TYPE (type);
 622       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 623         {
 624           type = TYPE_TARGET_TYPE (type);
 625           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
 626               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
 627             {
 628               /* Virtual functions tables are full of pointers
 629                  to virtual functions. */
 630               return pascal_object_is_vtbl_ptr_type (type);
 631             }
 632         }
 633     }
 634   return 0;
 635 }
 636
 637 /* Mutually recursive subroutines of pascal_object_print_value and
 638    c_val_print to print out a structure's fields:
 639    pascal_object_print_value_fields and pascal_object_print_value.
 640
 641    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 642    same meanings as in pascal_object_print_value and c_val_print.
 643
 644    DONT_PRINT is an array of baseclass types that we
 645    should not print, or zero if called from top level.  */
 646
 647 void
 648 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 649                                   CORE_ADDR address, struct ui_file *stream,
 650                                   int recurse,
 651                                   const struct value_print_options *options,
 652                                   struct type **dont_print_vb,
 653                                   int dont_print_statmem)
 654 {
 655   int i, len, n_baseclasses;
 656   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 657
 658   CHECK_TYPEDEF (type);
 659
 660   fprintf_filtered (stream, "{");
 661   len = TYPE_NFIELDS (type);
 662   n_baseclasses = TYPE_N_BASECLASSES (type);
 663
 664   /* Print out baseclasses such that we don't print
 665      duplicates of virtual baseclasses.  */
 666   if (n_baseclasses > 0)
 667     pascal_object_print_value (type, valaddr, address, stream,
 668                                recurse + 1, options, dont_print_vb);
 669
 670   if (!len && n_baseclasses == 1)
 671     fprintf_filtered (stream, "<No data fields>");
 672   else
 673     {
 674       struct obstack tmp_obstack = dont_print_statmem_obstack;
 675       int fields_seen = 0;
 676
 677       if (dont_print_statmem == 0)
 678         {
 679           /* If we're at top level, carve out a completely fresh
 680              chunk of the obstack and use that until this particular
 681              invocation returns.  */
 682           obstack_finish (&dont_print_statmem_obstack);
 683         }
 684
 685       for (i = n_baseclasses; i < len; i++)
 686         {
 687           /* If requested, skip printing of static fields.  */
 688           if (!options->pascal_static_field_print
 689               && field_is_static (&TYPE_FIELD (type, i)))
 690             continue;
 691           if (fields_seen)
 692             fprintf_filtered (stream, ", ");
 693           else if (n_baseclasses > 0)
 694             {
 695               if (options->pretty)
 696                 {
 697                   fprintf_filtered (stream, "\n");
 698                   print_spaces_filtered (2 + 2 * recurse, stream);
 699                   fputs_filtered ("members of ", stream);
 700                   fputs_filtered (type_name_no_tag (type), stream);
 701                   fputs_filtered (": ", stream);
 702                 }
 703             }
 704           fields_seen = 1;
 705
 706           if (options->pretty)
 707             {
 708               fprintf_filtered (stream, "\n");
 709               print_spaces_filtered (2 + 2 * recurse, stream);
 710             }
 711           else
 712             {
 713               wrap_here (n_spaces (2 + 2 * recurse));
 714             }
 715           if (options->inspect_it)
 716             {
 717               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 718                 fputs_filtered ("\"( ptr \"", stream);
 719               else
 720                 fputs_filtered ("\"( nodef \"", stream);
 721               if (field_is_static (&TYPE_FIELD (type, i)))
 722                 fputs_filtered ("static ", stream);
 723               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 724                                        language_cplus,
 725                                        DMGL_PARAMS | DMGL_ANSI);
 726               fputs_filtered ("\" \"", stream);
 727               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 728                                        language_cplus,
 729                                        DMGL_PARAMS | DMGL_ANSI);
 730               fputs_filtered ("\") \"", stream);
 731             }
 732           else
 733             {
 734               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 735
 736               if (field_is_static (&TYPE_FIELD (type, i)))
 737                 fputs_filtered ("static ", stream);
 738               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 739                                        language_cplus,
 740                                        DMGL_PARAMS | DMGL_ANSI);
 741               annotate_field_name_end ();
 742               fputs_filtered (" = ", stream);
 743               annotate_field_value ();
 744             }
 745
 746           if (!field_is_static (&TYPE_FIELD (type, i))
 747               && TYPE_FIELD_PACKED (type, i))
 748             {
 749               struct value *v;
 750
 751               /* Bitfields require special handling, especially due to byte
 752                  order problems.  */
 753               if (TYPE_FIELD_IGNORE (type, i))
 754                 {
 755                   fputs_filtered ("<optimized out or zero length>", stream);
 756                 }
 757               else
 758                 {
 759                   struct value_print_options opts = *options;
 760                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 761                                    unpack_field_as_long (type, valaddr, i));
 762
 763                   opts.deref_ref = 0;
 764                   common_val_print (v, stream, recurse + 1, &opts,
 765                                     current_language);
 766                 }
 767             }
 768           else
 769             {
 770               if (TYPE_FIELD_IGNORE (type, i))
 771                 {
 772                   fputs_filtered ("<optimized out or zero length>", stream);
 773                 }
 774               else if (field_is_static (&TYPE_FIELD (type, i)))
 775                 {
 776                   /* struct value *v = value_static_field (type, i); v4.17 specific */
 777                   struct value *v;
 778                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 779                                    unpack_field_as_long (type, valaddr, i));
 780
 781                   if (v == NULL)
 782                     fputs_filtered ("<optimized out>", stream);
 783                   else
 784                     pascal_object_print_static_field (v, stream, recurse + 1,
 785                                                       options);
 786                 }
 787               else
 788                 {
 789                   struct value_print_options opts = *options;
 790                   opts.deref_ref = 0;
 791                   /* val_print (TYPE_FIELD_TYPE (type, i),
 792                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 793                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 794                      stream, format, 0, recurse + 1, pretty); */
 795                   val_print (TYPE_FIELD_TYPE (type, i),
 796                              valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
 797                              address + TYPE_FIELD_BITPOS (type, i) / 8,
 798                              stream, recurse + 1, &opts,
 799                              current_language);
 800                 }
 801             }
 802           annotate_field_end ();
 803         }
 804
 805       if (dont_print_statmem == 0)
 806         {
 807           /* Free the space used to deal with the printing
 808              of the members from top level.  */
 809           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 810           dont_print_statmem_obstack = tmp_obstack;
 811         }
 812
 813       if (options->pretty)
 814         {
 815           fprintf_filtered (stream, "\n");
 816           print_spaces_filtered (2 * recurse, stream);
 817         }
 818     }
 819   fprintf_filtered (stream, "}");
 820 }
 821
 822 /* Special val_print routine to avoid printing multiple copies of virtual
 823    baseclasses.  */
 824
 825 static void
 826 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 827                            CORE_ADDR address, struct ui_file *stream,
 828                            int recurse,
 829                            const struct value_print_options *options,
 830                            struct type **dont_print_vb)
 831 {
 832   struct type **last_dont_print
 833   = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 834   struct obstack tmp_obstack = dont_print_vb_obstack;
 835   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 836
 837   if (dont_print_vb == 0)
 838     {
 839       /* If we're at top level, carve out a completely fresh
 840          chunk of the obstack and use that until this particular
 841          invocation returns.  */
 842       /* Bump up the high-water mark.  Now alpha is omega.  */
 843       obstack_finish (&dont_print_vb_obstack);
 844     }
 845
 846   for (i = 0; i < n_baseclasses; i++)
 847     {
 848       int boffset;
 849       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 850       char *basename = type_name_no_tag (baseclass);
 851       const gdb_byte *base_valaddr;
 852
 853       if (BASETYPE_VIA_VIRTUAL (type, i))
 854         {
 855           struct type **first_dont_print
 856           = (struct type **) obstack_base (&dont_print_vb_obstack);
 857
 858           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 859           - first_dont_print;
 860
 861           while (--j >= 0)
 862             if (baseclass == first_dont_print[j])
 863               goto flush_it;
 864
 865           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 866         }
 867
 868       boffset = baseclass_offset (type, i, valaddr, address);
 869
 870       if (options->pretty)
 871         {
 872           fprintf_filtered (stream, "\n");
 873           print_spaces_filtered (2 * recurse, stream);
 874         }
 875       fputs_filtered ("<", stream);
 876       /* Not sure what the best notation is in the case where there is no
 877          baseclass name.  */
 878
 879       fputs_filtered (basename ? basename : "", stream);
 880       fputs_filtered ("> = ", stream);
 881
 882       /* The virtual base class pointer might have been clobbered by the
 883          user program. Make sure that it still points to a valid memory
 884          location.  */
 885
 886       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 887         {
 888           /* FIXME (alloc): not safe is baseclass is really really big. */
 889           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 890           base_valaddr = buf;
 891           if (target_read_memory (address + boffset, buf,
 892                                   TYPE_LENGTH (baseclass)) != 0)
 893             boffset = -1;
 894         }
 895       else
 896         base_valaddr = valaddr + boffset;
 897
 898       if (boffset == -1)
 899         fprintf_filtered (stream, "<invalid address>");
 900       else
 901         pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
 902                                           stream, recurse, options,
 903                      (struct type **) obstack_base (&dont_print_vb_obstack),
 904                                           0);
 905       fputs_filtered (", ", stream);
 906
 907     flush_it:
 908       ;
 909     }
 910
 911   if (dont_print_vb == 0)
 912     {
 913       /* Free the space used to deal with the printing
 914          of this type from top level.  */
 915       obstack_free (&dont_print_vb_obstack, last_dont_print);
 916       /* Reset watermark so that we can continue protecting
 917          ourselves from whatever we were protecting ourselves.  */
 918       dont_print_vb_obstack = tmp_obstack;
 919     }
 920 }
 921
 922 /* Print value of a static member.
 923    To avoid infinite recursion when printing a class that contains
 924    a static instance of the class, we keep the addresses of all printed
 925    static member classes in an obstack and refuse to print them more
 926    than once.
 927
 928    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 929    have the same meanings as in c_val_print.  */
 930
 931 static void
 932 pascal_object_print_static_field (struct value *val,
 933                                   struct ui_file *stream,
 934                                   int recurse,
 935                                   const struct value_print_options *options)
 936 {
 937   struct type *type = value_type (val);
 938   struct value_print_options opts;
 939
 940   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 941     {
 942       CORE_ADDR *first_dont_print, addr;
 943       int i;
 944
 945       first_dont_print
 946         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 947       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 948         - first_dont_print;
 949
 950       while (--i >= 0)
 951         {
 952           if (value_address (val) == first_dont_print[i])
 953             {
 954               fputs_filtered ("<same as static member of an already seen type>",
 955                               stream);
 956               return;
 957             }
 958         }
 959
 960       addr = value_address (val);
 961       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 962                     sizeof (CORE_ADDR));
 963
 964       CHECK_TYPEDEF (type);
 965       pascal_object_print_value_fields (type, value_contents (val), addr,
 966                                         stream, recurse, options, NULL, 1);
 967       return;
 968     }
 969
 970   opts = *options;
 971   opts.deref_ref = 0;
 972   common_val_print (val, stream, recurse, &opts, current_language);
 973 }
 974
 975 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
 976
 977 void
 978 _initialize_pascal_valprint (void)
 979 {
 980   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 981                            &user_print_options.pascal_static_field_print, _("\
 982 Set printing of pascal static members."), _("\
 983 Show printing of pascal static members."), NULL,
 984                            NULL,
 985                            show_pascal_static_field_print,
 986                            &setprintlist, &showprintlist);
 987 }