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   struct value_print_options opts = *options;
 548
 549   opts.deref_ref = 1;
 550
 551   /* If it is a pointer, indicate what it points to.
 552
 553      Print type also if it is a reference.
 554
 555      Object pascal: if it is a member pointer, we will take care
 556      of that when we print it.  */
 557   if (TYPE_CODE (type) == TYPE_CODE_PTR
 558       || TYPE_CODE (type) == TYPE_CODE_REF)
 559     {
 560       /* Hack:  remove (char *) for char strings.  Their
 561          type is indicated by the quoted string anyway. */
 562       if (TYPE_CODE (type) == TYPE_CODE_PTR
 563           && TYPE_NAME (type) == NULL
 564           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 565           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 566         {
 567           /* Print nothing */
 568         }
 569       else
 570         {
 571           fprintf_filtered (stream, "(");
 572           type_print (type, "", stream, -1);
 573           fprintf_filtered (stream, ") ");
 574         }
 575     }
 576   return common_val_print (val, stream, 0, &opts, current_language);
 577 }
 578
 579
 580 static void
 581 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 582                                 struct cmd_list_element *c, const char *value)
 583 {
 584   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 585                     value);
 586 }
 587
 588 static struct obstack dont_print_vb_obstack;
 589 static struct obstack dont_print_statmem_obstack;
 590
 591 static void pascal_object_print_static_field (struct value *,
 592                                               struct ui_file *, int,
 593                                               const struct value_print_options *);
 594
 595 static void pascal_object_print_value (struct type *, const gdb_byte *,
 596                                        CORE_ADDR, struct ui_file *, int,
 597                                        const struct value_print_options *,
 598                                        struct type **);
 599
 600 /* It was changed to this after 2.4.5.  */
 601 const char pascal_vtbl_ptr_name[] =
 602 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 603
 604 /* Return truth value for assertion that TYPE is of the type
 605    "pointer to virtual function".  */
 606
 607 int
 608 pascal_object_is_vtbl_ptr_type (struct type *type)
 609 {
 610   char *typename = type_name_no_tag (type);
 611
 612   return (typename != NULL
 613           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 614 }
 615
 616 /* Return truth value for the assertion that TYPE is of the type
 617    "pointer to virtual function table".  */
 618
 619 int
 620 pascal_object_is_vtbl_member (struct type *type)
 621 {
 622   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 623     {
 624       type = TYPE_TARGET_TYPE (type);
 625       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 626         {
 627           type = TYPE_TARGET_TYPE (type);
 628           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
 629               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
 630             {
 631               /* Virtual functions tables are full of pointers
 632                  to virtual functions. */
 633               return pascal_object_is_vtbl_ptr_type (type);
 634             }
 635         }
 636     }
 637   return 0;
 638 }
 639
 640 /* Mutually recursive subroutines of pascal_object_print_value and
 641    c_val_print to print out a structure's fields:
 642    pascal_object_print_value_fields and pascal_object_print_value.
 643
 644    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 645    same meanings as in pascal_object_print_value and c_val_print.
 646
 647    DONT_PRINT is an array of baseclass types that we
 648    should not print, or zero if called from top level.  */
 649
 650 void
 651 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 652                                   CORE_ADDR address, struct ui_file *stream,
 653                                   int recurse,
 654                                   const struct value_print_options *options,
 655                                   struct type **dont_print_vb,
 656                                   int dont_print_statmem)
 657 {
 658   int i, len, n_baseclasses;
 659   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 660
 661   CHECK_TYPEDEF (type);
 662
 663   fprintf_filtered (stream, "{");
 664   len = TYPE_NFIELDS (type);
 665   n_baseclasses = TYPE_N_BASECLASSES (type);
 666
 667   /* Print out baseclasses such that we don't print
 668      duplicates of virtual baseclasses.  */
 669   if (n_baseclasses > 0)
 670     pascal_object_print_value (type, valaddr, address, stream,
 671                                recurse + 1, options, dont_print_vb);
 672
 673   if (!len && n_baseclasses == 1)
 674     fprintf_filtered (stream, "<No data fields>");
 675   else
 676     {
 677       struct obstack tmp_obstack = dont_print_statmem_obstack;
 678       int fields_seen = 0;
 679
 680       if (dont_print_statmem == 0)
 681         {
 682           /* If we're at top level, carve out a completely fresh
 683              chunk of the obstack and use that until this particular
 684              invocation returns.  */
 685           obstack_finish (&dont_print_statmem_obstack);
 686         }
 687
 688       for (i = n_baseclasses; i < len; i++)
 689         {
 690           /* If requested, skip printing of static fields.  */
 691           if (!options->pascal_static_field_print
 692               && field_is_static (&TYPE_FIELD (type, i)))
 693             continue;
 694           if (fields_seen)
 695             fprintf_filtered (stream, ", ");
 696           else if (n_baseclasses > 0)
 697             {
 698               if (options->pretty)
 699                 {
 700                   fprintf_filtered (stream, "\n");
 701                   print_spaces_filtered (2 + 2 * recurse, stream);
 702                   fputs_filtered ("members of ", stream);
 703                   fputs_filtered (type_name_no_tag (type), stream);
 704                   fputs_filtered (": ", stream);
 705                 }
 706             }
 707           fields_seen = 1;
 708
 709           if (options->pretty)
 710             {
 711               fprintf_filtered (stream, "\n");
 712               print_spaces_filtered (2 + 2 * recurse, stream);
 713             }
 714           else
 715             {
 716               wrap_here (n_spaces (2 + 2 * recurse));
 717             }
 718           if (options->inspect_it)
 719             {
 720               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 721                 fputs_filtered ("\"( ptr \"", stream);
 722               else
 723                 fputs_filtered ("\"( nodef \"", stream);
 724               if (field_is_static (&TYPE_FIELD (type, i)))
 725                 fputs_filtered ("static ", stream);
 726               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 727                                        language_cplus,
 728                                        DMGL_PARAMS | DMGL_ANSI);
 729               fputs_filtered ("\" \"", stream);
 730               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 731                                        language_cplus,
 732                                        DMGL_PARAMS | DMGL_ANSI);
 733               fputs_filtered ("\") \"", stream);
 734             }
 735           else
 736             {
 737               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 738
 739               if (field_is_static (&TYPE_FIELD (type, i)))
 740                 fputs_filtered ("static ", stream);
 741               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 742                                        language_cplus,
 743                                        DMGL_PARAMS | DMGL_ANSI);
 744               annotate_field_name_end ();
 745               fputs_filtered (" = ", stream);
 746               annotate_field_value ();
 747             }
 748
 749           if (!field_is_static (&TYPE_FIELD (type, i))
 750               && TYPE_FIELD_PACKED (type, i))
 751             {
 752               struct value *v;
 753
 754               /* Bitfields require special handling, especially due to byte
 755                  order problems.  */
 756               if (TYPE_FIELD_IGNORE (type, i))
 757                 {
 758                   fputs_filtered ("<optimized out or zero length>", stream);
 759                 }
 760               else
 761                 {
 762                   struct value_print_options opts = *options;
 763                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 764                                    unpack_field_as_long (type, valaddr, i));
 765
 766                   opts.deref_ref = 0;
 767                   common_val_print (v, stream, recurse + 1, &opts,
 768                                     current_language);
 769                 }
 770             }
 771           else
 772             {
 773               if (TYPE_FIELD_IGNORE (type, i))
 774                 {
 775                   fputs_filtered ("<optimized out or zero length>", stream);
 776                 }
 777               else if (field_is_static (&TYPE_FIELD (type, i)))
 778                 {
 779                   /* struct value *v = value_static_field (type, i); v4.17 specific */
 780                   struct value *v;
 781                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 782                                    unpack_field_as_long (type, valaddr, i));
 783
 784                   if (v == NULL)
 785                     fputs_filtered ("<optimized out>", stream);
 786                   else
 787                     pascal_object_print_static_field (v, stream, recurse + 1,
 788                                                       options);
 789                 }
 790               else
 791                 {
 792                   struct value_print_options opts = *options;
 793                   opts.deref_ref = 0;
 794                   /* val_print (TYPE_FIELD_TYPE (type, i),
 795                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 796                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 797                      stream, format, 0, recurse + 1, pretty); */
 798                   val_print (TYPE_FIELD_TYPE (type, i),
 799                              valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
 800                              address + TYPE_FIELD_BITPOS (type, i) / 8,
 801                              stream, recurse + 1, &opts,
 802                              current_language);
 803                 }
 804             }
 805           annotate_field_end ();
 806         }
 807
 808       if (dont_print_statmem == 0)
 809         {
 810           /* Free the space used to deal with the printing
 811              of the members from top level.  */
 812           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 813           dont_print_statmem_obstack = tmp_obstack;
 814         }
 815
 816       if (options->pretty)
 817         {
 818           fprintf_filtered (stream, "\n");
 819           print_spaces_filtered (2 * recurse, stream);
 820         }
 821     }
 822   fprintf_filtered (stream, "}");
 823 }
 824
 825 /* Special val_print routine to avoid printing multiple copies of virtual
 826    baseclasses.  */
 827
 828 static void
 829 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 830                            CORE_ADDR address, struct ui_file *stream,
 831                            int recurse,
 832                            const struct value_print_options *options,
 833                            struct type **dont_print_vb)
 834 {
 835   struct type **last_dont_print
 836   = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 837   struct obstack tmp_obstack = dont_print_vb_obstack;
 838   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 839
 840   if (dont_print_vb == 0)
 841     {
 842       /* If we're at top level, carve out a completely fresh
 843          chunk of the obstack and use that until this particular
 844          invocation returns.  */
 845       /* Bump up the high-water mark.  Now alpha is omega.  */
 846       obstack_finish (&dont_print_vb_obstack);
 847     }
 848
 849   for (i = 0; i < n_baseclasses; i++)
 850     {
 851       int boffset;
 852       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 853       char *basename = type_name_no_tag (baseclass);
 854       const gdb_byte *base_valaddr;
 855
 856       if (BASETYPE_VIA_VIRTUAL (type, i))
 857         {
 858           struct type **first_dont_print
 859           = (struct type **) obstack_base (&dont_print_vb_obstack);
 860
 861           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 862           - first_dont_print;
 863
 864           while (--j >= 0)
 865             if (baseclass == first_dont_print[j])
 866               goto flush_it;
 867
 868           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 869         }
 870
 871       boffset = baseclass_offset (type, i, valaddr, address);
 872
 873       if (options->pretty)
 874         {
 875           fprintf_filtered (stream, "\n");
 876           print_spaces_filtered (2 * recurse, stream);
 877         }
 878       fputs_filtered ("<", stream);
 879       /* Not sure what the best notation is in the case where there is no
 880          baseclass name.  */
 881
 882       fputs_filtered (basename ? basename : "", stream);
 883       fputs_filtered ("> = ", stream);
 884
 885       /* The virtual base class pointer might have been clobbered by the
 886          user program. Make sure that it still points to a valid memory
 887          location.  */
 888
 889       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 890         {
 891           /* FIXME (alloc): not safe is baseclass is really really big. */
 892           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 893           base_valaddr = buf;
 894           if (target_read_memory (address + boffset, buf,
 895                                   TYPE_LENGTH (baseclass)) != 0)
 896             boffset = -1;
 897         }
 898       else
 899         base_valaddr = valaddr + boffset;
 900
 901       if (boffset == -1)
 902         fprintf_filtered (stream, "<invalid address>");
 903       else
 904         pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
 905                                           stream, recurse, options,
 906                      (struct type **) obstack_base (&dont_print_vb_obstack),
 907                                           0);
 908       fputs_filtered (", ", stream);
 909
 910     flush_it:
 911       ;
 912     }
 913
 914   if (dont_print_vb == 0)
 915     {
 916       /* Free the space used to deal with the printing
 917          of this type from top level.  */
 918       obstack_free (&dont_print_vb_obstack, last_dont_print);
 919       /* Reset watermark so that we can continue protecting
 920          ourselves from whatever we were protecting ourselves.  */
 921       dont_print_vb_obstack = tmp_obstack;
 922     }
 923 }
 924
 925 /* Print value of a static member.
 926    To avoid infinite recursion when printing a class that contains
 927    a static instance of the class, we keep the addresses of all printed
 928    static member classes in an obstack and refuse to print them more
 929    than once.
 930
 931    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 932    have the same meanings as in c_val_print.  */
 933
 934 static void
 935 pascal_object_print_static_field (struct value *val,
 936                                   struct ui_file *stream,
 937                                   int recurse,
 938                                   const struct value_print_options *options)
 939 {
 940   struct type *type = value_type (val);
 941   struct value_print_options opts;
 942
 943   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 944     {
 945       CORE_ADDR *first_dont_print, addr;
 946       int i;
 947
 948       first_dont_print
 949         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 950       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 951         - first_dont_print;
 952
 953       while (--i >= 0)
 954         {
 955           if (value_address (val) == first_dont_print[i])
 956             {
 957               fputs_filtered ("<same as static member of an already seen type>",
 958                               stream);
 959               return;
 960             }
 961         }
 962
 963       addr = value_address (val);
 964       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 965                     sizeof (CORE_ADDR));
 966
 967       CHECK_TYPEDEF (type);
 968       pascal_object_print_value_fields (type, value_contents (val), addr,
 969                                         stream, recurse, options, NULL, 1);
 970       return;
 971     }
 972
 973   opts = *options;
 974   opts.deref_ref = 0;
 975   common_val_print (val, stream, recurse, &opts, current_language);
 976 }
 977
 978 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
 979
 980 void
 981 _initialize_pascal_valprint (void)
 982 {
 983   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 984                            &user_print_options.pascal_static_field_print, _("\
 985 Set printing of pascal static members."), _("\
 986 Show printing of pascal static members."), NULL,
 987                            NULL,
 988                            show_pascal_static_field_print,
 989                            &setprintlist, &showprintlist);
 990 }