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