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