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
 198           buffer = xmalloc (length_size);
 199           read_memory (addr + length_pos, buffer, length_size);
 200           string_length = extract_unsigned_integer (buffer, length_size,
 201                                                     byte_order);
 202           xfree (buffer);
 203           i = val_print_string (char_type ,addr + string_pos, string_length, stream, options);
 204         }
 205       else if (pascal_object_is_vtbl_member (type))
 206         {
 207           /* print vtbl's nicely */
 208           CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
 209           struct minimal_symbol *msymbol =
 210             lookup_minimal_symbol_by_pc (vt_address);
 211
 212           if ((msymbol != NULL)
 213               && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
 214             {
 215               fputs_filtered (" <", stream);
 216               fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
 217               fputs_filtered (">", stream);
 218             }
 219           if (vt_address && options->vtblprint)
 220             {
 221               struct value *vt_val;
 222               struct symbol *wsym = (struct symbol *) NULL;
 223               struct type *wtype;
 224               struct block *block = (struct block *) NULL;
 225               int is_this_fld;
 226
 227               if (msymbol != NULL)
 228                 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
 229                                       VAR_DOMAIN, &is_this_fld);
 230
 231               if (wsym)
 232                 {
 233                   wtype = SYMBOL_TYPE (wsym);
 234                 }
 235               else
 236                 {
 237                   wtype = TYPE_TARGET_TYPE (type);
 238                 }
 239               vt_val = value_at (wtype, vt_address);
 240               common_val_print (vt_val, stream, recurse + 1, options,
 241                                 current_language);
 242               if (options->pretty)
 243                 {
 244                   fprintf_filtered (stream, "\n");
 245                   print_spaces_filtered (2 + 2 * recurse, stream);
 246                 }
 247             }
 248         }
 249
 250       /* Return number of characters printed, including the terminating
 251          '\0' if we reached the end.  val_print_string takes care including
 252          the terminating '\0' if necessary.  */
 253       return i;
 254
 255       break;
 256
 257     case TYPE_CODE_REF:
 258       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 259       if (options->addressprint)
 260         {
 261           CORE_ADDR addr
 262             = extract_typed_address (valaddr + embedded_offset, type);
 263
 264           fprintf_filtered (stream, "@");
 265           fputs_filtered (paddress (gdbarch, addr), stream);
 266           if (options->deref_ref)
 267             fputs_filtered (": ", stream);
 268         }
 269       /* De-reference the reference.  */
 270       if (options->deref_ref)
 271         {
 272           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 273             {
 274               struct value *deref_val =
 275                 value_at
 276                 (TYPE_TARGET_TYPE (type),
 277                  unpack_pointer (type, valaddr + embedded_offset));
 278
 279               common_val_print (deref_val, stream, recurse + 1, options,
 280                                 current_language);
 281             }
 282           else
 283             fputs_filtered ("???", stream);
 284         }
 285       break;
 286
 287     case TYPE_CODE_UNION:
 288       if (recurse && !options->unionprint)
 289         {
 290           fprintf_filtered (stream, "{...}");
 291           break;
 292         }
 293       /* Fall through.  */
 294     case TYPE_CODE_STRUCT:
 295       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 296         {
 297           /* Print the unmangled name if desired.  */
 298           /* Print vtable entry - we only get here if NOT using
 299              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.) */
 300           /* Extract the address, assume that it is unsigned.  */
 301           print_address_demangle
 302             (gdbarch,
 303              extract_unsigned_integer (valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
 304                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET)), byte_order),
 305              stream, demangle);
 306         }
 307       else
 308         {
 309           if (is_pascal_string_type (type, &length_pos, &length_size,
 310                                      &string_pos, &char_type, NULL))
 311             {
 312               len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size, byte_order);
 313               LA_PRINT_STRING (stream, char_type,
 314                                valaddr + embedded_offset + string_pos,
 315                                len, NULL, 0, options);
 316             }
 317           else
 318             pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream,
 319                                               recurse, options, NULL, 0);
 320         }
 321       break;
 322
 323     case TYPE_CODE_ENUM:
 324       if (options->format)
 325         {
 326           print_scalar_formatted (valaddr + embedded_offset, type,
 327                                   options, 0, stream);
 328           break;
 329         }
 330       len = TYPE_NFIELDS (type);
 331       val = unpack_long (type, valaddr + embedded_offset);
 332       for (i = 0; i < len; i++)
 333         {
 334           QUIT;
 335           if (val == TYPE_FIELD_BITPOS (type, i))
 336             {
 337               break;
 338             }
 339         }
 340       if (i < len)
 341         {
 342           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 343         }
 344       else
 345         {
 346           print_longest (stream, 'd', 0, val);
 347         }
 348       break;
 349
 350     case TYPE_CODE_FLAGS:
 351       if (options->format)
 352           print_scalar_formatted (valaddr + embedded_offset, type,
 353                                   options, 0, stream);
 354       else
 355         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
 356       break;
 357
 358     case TYPE_CODE_FUNC:
 359       if (options->format)
 360         {
 361           print_scalar_formatted (valaddr + embedded_offset, type,
 362                                   options, 0, stream);
 363           break;
 364         }
 365       /* FIXME, we should consider, at least for ANSI C language, eliminating
 366          the distinction made between FUNCs and POINTERs to FUNCs.  */
 367       fprintf_filtered (stream, "{");
 368       type_print (type, "", stream, -1);
 369       fprintf_filtered (stream, "} ");
 370       /* Try to print what function it points to, and its address.  */
 371       print_address_demangle (gdbarch, address, stream, demangle);
 372       break;
 373
 374     case TYPE_CODE_BOOL:
 375       if (options->format || options->output_format)
 376         {
 377           struct value_print_options opts = *options;
 378
 379           opts.format = (options->format ? options->format
 380                          : options->output_format);
 381           print_scalar_formatted (valaddr + embedded_offset, type,
 382                                   &opts, 0, stream);
 383         }
 384       else
 385         {
 386           val = unpack_long (type, valaddr + embedded_offset);
 387           if (val == 0)
 388             fputs_filtered ("false", stream);
 389           else if (val == 1)
 390             fputs_filtered ("true", stream);
 391           else
 392             {
 393               fputs_filtered ("true (", stream);
 394               fprintf_filtered (stream, "%ld)", (long int) val);
 395             }
 396         }
 397       break;
 398
 399     case TYPE_CODE_RANGE:
 400       /* FIXME: create_range_type does not set the unsigned bit in a
 401          range type (I think it probably should copy it from the target
 402          type), so we won't print values which are too large to
 403          fit in a signed integer correctly.  */
 404       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
 405          print with the target type, though, because the size of our type
 406          and the target type might differ).  */
 407       /* FALLTHROUGH */
 408
 409     case TYPE_CODE_INT:
 410       if (options->format || options->output_format)
 411         {
 412           struct value_print_options opts = *options;
 413
 414           opts.format = (options->format ? options->format
 415                          : options->output_format);
 416           print_scalar_formatted (valaddr + embedded_offset, type,
 417                                   &opts, 0, stream);
 418         }
 419       else
 420         {
 421           val_print_type_code_int (type, valaddr + embedded_offset, stream);
 422         }
 423       break;
 424
 425     case TYPE_CODE_CHAR:
 426       if (options->format || options->output_format)
 427         {
 428           struct value_print_options opts = *options;
 429
 430           opts.format = (options->format ? options->format
 431                          : options->output_format);
 432           print_scalar_formatted (valaddr + embedded_offset, type,
 433                                   &opts, 0, stream);
 434         }
 435       else
 436         {
 437           val = unpack_long (type, valaddr + embedded_offset);
 438           if (TYPE_UNSIGNED (type))
 439             fprintf_filtered (stream, "%u", (unsigned int) val);
 440           else
 441             fprintf_filtered (stream, "%d", (int) val);
 442           fputs_filtered (" ", stream);
 443           LA_PRINT_CHAR ((unsigned char) val, type, stream);
 444         }
 445       break;
 446
 447     case TYPE_CODE_FLT:
 448       if (options->format)
 449         {
 450           print_scalar_formatted (valaddr + embedded_offset, type,
 451                                   options, 0, stream);
 452         }
 453       else
 454         {
 455           print_floating (valaddr + embedded_offset, type, stream);
 456         }
 457       break;
 458
 459     case TYPE_CODE_BITSTRING:
 460     case TYPE_CODE_SET:
 461       elttype = TYPE_INDEX_TYPE (type);
 462       CHECK_TYPEDEF (elttype);
 463       if (TYPE_STUB (elttype))
 464         {
 465           fprintf_filtered (stream, "<incomplete type>");
 466           gdb_flush (stream);
 467           break;
 468         }
 469       else
 470         {
 471           struct type *range = elttype;
 472           LONGEST low_bound, high_bound;
 473           int i;
 474           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
 475           int need_comma = 0;
 476
 477           if (is_bitstring)
 478             fputs_filtered ("B'", stream);
 479           else
 480             fputs_filtered ("[", stream);
 481
 482           i = get_discrete_bounds (range, &low_bound, &high_bound);
 483         maybe_bad_bstring:
 484           if (i < 0)
 485             {
 486               fputs_filtered ("<error value>", stream);
 487               goto done;
 488             }
 489
 490           for (i = low_bound; i <= high_bound; i++)
 491             {
 492               int element = value_bit_index (type, valaddr + embedded_offset, i);
 493
 494               if (element < 0)
 495                 {
 496                   i = element;
 497                   goto maybe_bad_bstring;
 498                 }
 499               if (is_bitstring)
 500                 fprintf_filtered (stream, "%d", element);
 501               else if (element)
 502                 {
 503                   if (need_comma)
 504                     fputs_filtered (", ", stream);
 505                   print_type_scalar (range, i, stream);
 506                   need_comma = 1;
 507
 508                   if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
 509                     {
 510                       int j = i;
 511
 512                       fputs_filtered ("..", stream);
 513                       while (i + 1 <= high_bound
 514                              && value_bit_index (type, valaddr + embedded_offset, ++i))
 515                         j = i;
 516                       print_type_scalar (range, j, stream);
 517                     }
 518                 }
 519             }
 520         done:
 521           if (is_bitstring)
 522             fputs_filtered ("'", stream);
 523           else
 524             fputs_filtered ("]", stream);
 525         }
 526       break;
 527
 528     case TYPE_CODE_VOID:
 529       fprintf_filtered (stream, "void");
 530       break;
 531
 532     case TYPE_CODE_ERROR:
 533       fprintf_filtered (stream, "<error type>");
 534       break;
 535
 536     case TYPE_CODE_UNDEF:
 537       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 538          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 539          and no complete type for struct foo in that file.  */
 540       fprintf_filtered (stream, "<incomplete type>");
 541       break;
 542
 543     default:
 544       error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
 545     }
 546   gdb_flush (stream);
 547   return (0);
 548 }
 549 \f
 550 int
 551 pascal_value_print (struct value *val, struct ui_file *stream,
 552                     const struct value_print_options *options)
 553 {
 554   struct type *type = value_type (val);
 555   struct value_print_options opts = *options;
 556
 557   opts.deref_ref = 1;
 558
 559   /* If it is a pointer, indicate what it points to.
 560
 561      Print type also if it is a reference.
 562
 563      Object pascal: if it is a member pointer, we will take care
 564      of that when we print it.  */
 565   if (TYPE_CODE (type) == TYPE_CODE_PTR
 566       || TYPE_CODE (type) == TYPE_CODE_REF)
 567     {
 568       /* Hack:  remove (char *) for char strings.  Their
 569          type is indicated by the quoted string anyway. */
 570       if (TYPE_CODE (type) == TYPE_CODE_PTR
 571           && TYPE_NAME (type) == NULL
 572           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 573           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 574         {
 575           /* Print nothing */
 576         }
 577       else
 578         {
 579           fprintf_filtered (stream, "(");
 580           type_print (type, "", stream, -1);
 581           fprintf_filtered (stream, ") ");
 582         }
 583     }
 584   return common_val_print (val, stream, 0, &opts, current_language);
 585 }
 586
 587
 588 static void
 589 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 590                                 struct cmd_list_element *c, const char *value)
 591 {
 592   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 593                     value);
 594 }
 595
 596 static struct obstack dont_print_vb_obstack;
 597 static struct obstack dont_print_statmem_obstack;
 598
 599 static void pascal_object_print_static_field (struct value *,
 600                                               struct ui_file *, int,
 601                                               const struct value_print_options *);
 602
 603 static void pascal_object_print_value (struct type *, const gdb_byte *,
 604                                        CORE_ADDR, struct ui_file *, int,
 605                                        const struct value_print_options *,
 606                                        struct type **);
 607
 608 /* It was changed to this after 2.4.5.  */
 609 const char pascal_vtbl_ptr_name[] =
 610 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 611
 612 /* Return truth value for assertion that TYPE is of the type
 613    "pointer to virtual function".  */
 614
 615 int
 616 pascal_object_is_vtbl_ptr_type (struct type *type)
 617 {
 618   char *typename = type_name_no_tag (type);
 619
 620   return (typename != NULL
 621           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 622 }
 623
 624 /* Return truth value for the assertion that TYPE is of the type
 625    "pointer to virtual function table".  */
 626
 627 int
 628 pascal_object_is_vtbl_member (struct type *type)
 629 {
 630   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 631     {
 632       type = TYPE_TARGET_TYPE (type);
 633       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 634         {
 635           type = TYPE_TARGET_TYPE (type);
 636           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
 637               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
 638             {
 639               /* Virtual functions tables are full of pointers
 640                  to virtual functions. */
 641               return pascal_object_is_vtbl_ptr_type (type);
 642             }
 643         }
 644     }
 645   return 0;
 646 }
 647
 648 /* Mutually recursive subroutines of pascal_object_print_value and
 649    c_val_print to print out a structure's fields:
 650    pascal_object_print_value_fields and pascal_object_print_value.
 651
 652    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 653    same meanings as in pascal_object_print_value and c_val_print.
 654
 655    DONT_PRINT is an array of baseclass types that we
 656    should not print, or zero if called from top level.  */
 657
 658 void
 659 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 660                                   CORE_ADDR address, struct ui_file *stream,
 661                                   int recurse,
 662                                   const struct value_print_options *options,
 663                                   struct type **dont_print_vb,
 664                                   int dont_print_statmem)
 665 {
 666   int i, len, n_baseclasses;
 667   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 668
 669   CHECK_TYPEDEF (type);
 670
 671   fprintf_filtered (stream, "{");
 672   len = TYPE_NFIELDS (type);
 673   n_baseclasses = TYPE_N_BASECLASSES (type);
 674
 675   /* Print out baseclasses such that we don't print
 676      duplicates of virtual baseclasses.  */
 677   if (n_baseclasses > 0)
 678     pascal_object_print_value (type, valaddr, address, stream,
 679                                recurse + 1, options, dont_print_vb);
 680
 681   if (!len && n_baseclasses == 1)
 682     fprintf_filtered (stream, "<No data fields>");
 683   else
 684     {
 685       struct obstack tmp_obstack = dont_print_statmem_obstack;
 686       int fields_seen = 0;
 687
 688       if (dont_print_statmem == 0)
 689         {
 690           /* If we're at top level, carve out a completely fresh
 691              chunk of the obstack and use that until this particular
 692              invocation returns.  */
 693           obstack_finish (&dont_print_statmem_obstack);
 694         }
 695
 696       for (i = n_baseclasses; i < len; i++)
 697         {
 698           /* If requested, skip printing of static fields.  */
 699           if (!options->pascal_static_field_print
 700               && field_is_static (&TYPE_FIELD (type, i)))
 701             continue;
 702           if (fields_seen)
 703             fprintf_filtered (stream, ", ");
 704           else if (n_baseclasses > 0)
 705             {
 706               if (options->pretty)
 707                 {
 708                   fprintf_filtered (stream, "\n");
 709                   print_spaces_filtered (2 + 2 * recurse, stream);
 710                   fputs_filtered ("members of ", stream);
 711                   fputs_filtered (type_name_no_tag (type), stream);
 712                   fputs_filtered (": ", stream);
 713                 }
 714             }
 715           fields_seen = 1;
 716
 717           if (options->pretty)
 718             {
 719               fprintf_filtered (stream, "\n");
 720               print_spaces_filtered (2 + 2 * recurse, stream);
 721             }
 722           else
 723             {
 724               wrap_here (n_spaces (2 + 2 * recurse));
 725             }
 726           if (options->inspect_it)
 727             {
 728               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 729                 fputs_filtered ("\"( ptr \"", stream);
 730               else
 731                 fputs_filtered ("\"( nodef \"", stream);
 732               if (field_is_static (&TYPE_FIELD (type, i)))
 733                 fputs_filtered ("static ", stream);
 734               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 735                                        language_cplus,
 736                                        DMGL_PARAMS | DMGL_ANSI);
 737               fputs_filtered ("\" \"", stream);
 738               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 739                                        language_cplus,
 740                                        DMGL_PARAMS | DMGL_ANSI);
 741               fputs_filtered ("\") \"", stream);
 742             }
 743           else
 744             {
 745               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 746
 747               if (field_is_static (&TYPE_FIELD (type, i)))
 748                 fputs_filtered ("static ", stream);
 749               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 750                                        language_cplus,
 751                                        DMGL_PARAMS | DMGL_ANSI);
 752               annotate_field_name_end ();
 753               fputs_filtered (" = ", stream);
 754               annotate_field_value ();
 755             }
 756
 757           if (!field_is_static (&TYPE_FIELD (type, i))
 758               && TYPE_FIELD_PACKED (type, i))
 759             {
 760               struct value *v;
 761
 762               /* Bitfields require special handling, especially due to byte
 763                  order problems.  */
 764               if (TYPE_FIELD_IGNORE (type, i))
 765                 {
 766                   fputs_filtered ("<optimized out or zero length>", stream);
 767                 }
 768               else
 769                 {
 770                   struct value_print_options opts = *options;
 771
 772                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 773                                    unpack_field_as_long (type, valaddr, i));
 774
 775                   opts.deref_ref = 0;
 776                   common_val_print (v, stream, recurse + 1, &opts,
 777                                     current_language);
 778                 }
 779             }
 780           else
 781             {
 782               if (TYPE_FIELD_IGNORE (type, i))
 783                 {
 784                   fputs_filtered ("<optimized out or zero length>", stream);
 785                 }
 786               else if (field_is_static (&TYPE_FIELD (type, i)))
 787                 {
 788                   /* struct value *v = value_static_field (type, i); v4.17 specific */
 789                   struct value *v;
 790
 791                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 792                                    unpack_field_as_long (type, valaddr, i));
 793
 794                   if (v == NULL)
 795                     fputs_filtered ("<optimized out>", stream);
 796                   else
 797                     pascal_object_print_static_field (v, stream, recurse + 1,
 798                                                       options);
 799                 }
 800               else
 801                 {
 802                   struct value_print_options opts = *options;
 803
 804                   opts.deref_ref = 0;
 805                   /* val_print (TYPE_FIELD_TYPE (type, i),
 806                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 807                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 808                      stream, format, 0, recurse + 1, pretty); */
 809                   val_print (TYPE_FIELD_TYPE (type, i),
 810                              valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
 811                              address + TYPE_FIELD_BITPOS (type, i) / 8,
 812                              stream, recurse + 1, &opts,
 813                              current_language);
 814                 }
 815             }
 816           annotate_field_end ();
 817         }
 818
 819       if (dont_print_statmem == 0)
 820         {
 821           /* Free the space used to deal with the printing
 822              of the members from top level.  */
 823           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 824           dont_print_statmem_obstack = tmp_obstack;
 825         }
 826
 827       if (options->pretty)
 828         {
 829           fprintf_filtered (stream, "\n");
 830           print_spaces_filtered (2 * recurse, stream);
 831         }
 832     }
 833   fprintf_filtered (stream, "}");
 834 }
 835
 836 /* Special val_print routine to avoid printing multiple copies of virtual
 837    baseclasses.  */
 838
 839 static void
 840 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 841                            CORE_ADDR address, struct ui_file *stream,
 842                            int recurse,
 843                            const struct value_print_options *options,
 844                            struct type **dont_print_vb)
 845 {
 846   struct type **last_dont_print
 847     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 848   struct obstack tmp_obstack = dont_print_vb_obstack;
 849   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 850
 851   if (dont_print_vb == 0)
 852     {
 853       /* If we're at top level, carve out a completely fresh
 854          chunk of the obstack and use that until this particular
 855          invocation returns.  */
 856       /* Bump up the high-water mark.  Now alpha is omega.  */
 857       obstack_finish (&dont_print_vb_obstack);
 858     }
 859
 860   for (i = 0; i < n_baseclasses; i++)
 861     {
 862       int boffset;
 863       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 864       char *basename = type_name_no_tag (baseclass);
 865       const gdb_byte *base_valaddr;
 866
 867       if (BASETYPE_VIA_VIRTUAL (type, i))
 868         {
 869           struct type **first_dont_print
 870             = (struct type **) obstack_base (&dont_print_vb_obstack);
 871
 872           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 873             - first_dont_print;
 874
 875           while (--j >= 0)
 876             if (baseclass == first_dont_print[j])
 877               goto flush_it;
 878
 879           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 880         }
 881
 882       boffset = baseclass_offset (type, i, valaddr, address);
 883
 884       if (options->pretty)
 885         {
 886           fprintf_filtered (stream, "\n");
 887           print_spaces_filtered (2 * recurse, stream);
 888         }
 889       fputs_filtered ("<", stream);
 890       /* Not sure what the best notation is in the case where there is no
 891          baseclass name.  */
 892
 893       fputs_filtered (basename ? basename : "", stream);
 894       fputs_filtered ("> = ", stream);
 895
 896       /* The virtual base class pointer might have been clobbered by the
 897          user program. Make sure that it still points to a valid memory
 898          location.  */
 899
 900       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 901         {
 902           /* FIXME (alloc): not safe is baseclass is really really big. */
 903           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 904
 905           base_valaddr = buf;
 906           if (target_read_memory (address + boffset, buf,
 907                                   TYPE_LENGTH (baseclass)) != 0)
 908             boffset = -1;
 909         }
 910       else
 911         base_valaddr = valaddr + boffset;
 912
 913       if (boffset == -1)
 914         fprintf_filtered (stream, "<invalid address>");
 915       else
 916         pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
 917                                           stream, recurse, options,
 918                      (struct type **) obstack_base (&dont_print_vb_obstack),
 919                                           0);
 920       fputs_filtered (", ", stream);
 921
 922     flush_it:
 923       ;
 924     }
 925
 926   if (dont_print_vb == 0)
 927     {
 928       /* Free the space used to deal with the printing
 929          of this type from top level.  */
 930       obstack_free (&dont_print_vb_obstack, last_dont_print);
 931       /* Reset watermark so that we can continue protecting
 932          ourselves from whatever we were protecting ourselves.  */
 933       dont_print_vb_obstack = tmp_obstack;
 934     }
 935 }
 936
 937 /* Print value of a static member.
 938    To avoid infinite recursion when printing a class that contains
 939    a static instance of the class, we keep the addresses of all printed
 940    static member classes in an obstack and refuse to print them more
 941    than once.
 942
 943    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 944    have the same meanings as in c_val_print.  */
 945
 946 static void
 947 pascal_object_print_static_field (struct value *val,
 948                                   struct ui_file *stream,
 949                                   int recurse,
 950                                   const struct value_print_options *options)
 951 {
 952   struct type *type = value_type (val);
 953   struct value_print_options opts;
 954
 955   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 956     {
 957       CORE_ADDR *first_dont_print, addr;
 958       int i;
 959
 960       first_dont_print
 961         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 962       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 963         - first_dont_print;
 964
 965       while (--i >= 0)
 966         {
 967           if (value_address (val) == first_dont_print[i])
 968             {
 969               fputs_filtered ("<same as static member of an already seen type>",
 970                               stream);
 971               return;
 972             }
 973         }
 974
 975       addr = value_address (val);
 976       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 977                     sizeof (CORE_ADDR));
 978
 979       CHECK_TYPEDEF (type);
 980       pascal_object_print_value_fields (type, value_contents (val), addr,
 981                                         stream, recurse, options, NULL, 1);
 982       return;
 983     }
 984
 985   opts = *options;
 986   opts.deref_ref = 0;
 987   common_val_print (val, stream, recurse, &opts, current_language);
 988 }
 989
 990 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
 991
 992 void
 993 _initialize_pascal_valprint (void)
 994 {
 995   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 996                            &user_print_options.pascal_static_field_print, _("\
 997 Set printing of pascal static members."), _("\
 998 Show printing of pascal static members."), NULL,
 999                            NULL,
1000                            show_pascal_static_field_print,
1001                            &setprintlist, &showprintlist);
1002 }