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