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