gdb/p-valprint.c

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