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                                        int,
 633                                        CORE_ADDR, struct ui_file *, int,
 634                                        const struct value *,
 635                                        const struct value_print_options *,
 636                                        struct type **);
 637
 638 /* It was changed to this after 2.4.5.  */
 639 const char pascal_vtbl_ptr_name[] =
 640 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 641
 642 /* Return truth value for assertion that TYPE is of the type
 643    "pointer to virtual function".  */
 644
 645 int
 646 pascal_object_is_vtbl_ptr_type (struct type *type)
 647 {
 648   char *typename = type_name_no_tag (type);
 649
 650   return (typename != NULL
 651           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 652 }
 653
 654 /* Return truth value for the assertion that TYPE is of the type
 655    "pointer to virtual function table".  */
 656
 657 int
 658 pascal_object_is_vtbl_member (struct type *type)
 659 {
 660   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 661     {
 662       type = TYPE_TARGET_TYPE (type);
 663       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 664         {
 665           type = TYPE_TARGET_TYPE (type);
 666           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* If not using
 667                                                            thunks.  */
 668               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* If using thunks.  */
 669             {
 670               /* Virtual functions tables are full of pointers
 671                  to virtual functions.  */
 672               return pascal_object_is_vtbl_ptr_type (type);
 673             }
 674         }
 675     }
 676   return 0;
 677 }
 678
 679 /* Mutually recursive subroutines of pascal_object_print_value and
 680    c_val_print to print out a structure's fields:
 681    pascal_object_print_value_fields and pascal_object_print_value.
 682
 683    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 684    same meanings as in pascal_object_print_value and c_val_print.
 685
 686    DONT_PRINT is an array of baseclass types that we
 687    should not print, or zero if called from top level.  */
 688
 689 void
 690 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 691                                   int offset,
 692                                   CORE_ADDR address, struct ui_file *stream,
 693                                   int recurse,
 694                                   const struct value *val,
 695                                   const struct value_print_options *options,
 696                                   struct type **dont_print_vb,
 697                                   int dont_print_statmem)
 698 {
 699   int i, len, n_baseclasses;
 700   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 701
 702   CHECK_TYPEDEF (type);
 703
 704   fprintf_filtered (stream, "{");
 705   len = TYPE_NFIELDS (type);
 706   n_baseclasses = TYPE_N_BASECLASSES (type);
 707
 708   /* Print out baseclasses such that we don't print
 709      duplicates of virtual baseclasses.  */
 710   if (n_baseclasses > 0)
 711     pascal_object_print_value (type, valaddr, offset, address,
 712                                stream, recurse + 1, val,
 713                                options, dont_print_vb);
 714
 715   if (!len && n_baseclasses == 1)
 716     fprintf_filtered (stream, "<No data fields>");
 717   else
 718     {
 719       struct obstack tmp_obstack = dont_print_statmem_obstack;
 720       int fields_seen = 0;
 721
 722       if (dont_print_statmem == 0)
 723         {
 724           /* If we're at top level, carve out a completely fresh
 725              chunk of the obstack and use that until this particular
 726              invocation returns.  */
 727           obstack_finish (&dont_print_statmem_obstack);
 728         }
 729
 730       for (i = n_baseclasses; i < len; i++)
 731         {
 732           /* If requested, skip printing of static fields.  */
 733           if (!options->pascal_static_field_print
 734               && field_is_static (&TYPE_FIELD (type, i)))
 735             continue;
 736           if (fields_seen)
 737             fprintf_filtered (stream, ", ");
 738           else if (n_baseclasses > 0)
 739             {
 740               if (options->pretty)
 741                 {
 742                   fprintf_filtered (stream, "\n");
 743                   print_spaces_filtered (2 + 2 * recurse, stream);
 744                   fputs_filtered ("members of ", stream);
 745                   fputs_filtered (type_name_no_tag (type), stream);
 746                   fputs_filtered (": ", stream);
 747                 }
 748             }
 749           fields_seen = 1;
 750
 751           if (options->pretty)
 752             {
 753               fprintf_filtered (stream, "\n");
 754               print_spaces_filtered (2 + 2 * recurse, stream);
 755             }
 756           else
 757             {
 758               wrap_here (n_spaces (2 + 2 * recurse));
 759             }
 760           if (options->inspect_it)
 761             {
 762               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 763                 fputs_filtered ("\"( ptr \"", stream);
 764               else
 765                 fputs_filtered ("\"( nodef \"", stream);
 766               if (field_is_static (&TYPE_FIELD (type, i)))
 767                 fputs_filtered ("static ", stream);
 768               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 769                                        language_cplus,
 770                                        DMGL_PARAMS | DMGL_ANSI);
 771               fputs_filtered ("\" \"", stream);
 772               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 773                                        language_cplus,
 774                                        DMGL_PARAMS | DMGL_ANSI);
 775               fputs_filtered ("\") \"", stream);
 776             }
 777           else
 778             {
 779               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 780
 781               if (field_is_static (&TYPE_FIELD (type, i)))
 782                 fputs_filtered ("static ", stream);
 783               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 784                                        language_cplus,
 785                                        DMGL_PARAMS | DMGL_ANSI);
 786               annotate_field_name_end ();
 787               fputs_filtered (" = ", stream);
 788               annotate_field_value ();
 789             }
 790
 791           if (!field_is_static (&TYPE_FIELD (type, i))
 792               && TYPE_FIELD_PACKED (type, i))
 793             {
 794               struct value *v;
 795
 796               /* Bitfields require special handling, especially due to byte
 797                  order problems.  */
 798               if (TYPE_FIELD_IGNORE (type, i))
 799                 {
 800                   fputs_filtered ("<optimized out or zero length>", stream);
 801                 }
 802               else if (value_bits_synthetic_pointer (val,
 803                                                      TYPE_FIELD_BITPOS (type,
 804                                                                         i),
 805                                                      TYPE_FIELD_BITSIZE (type,
 806                                                                          i)))
 807                 {
 808                   fputs_filtered (_("<synthetic pointer>"), stream);
 809                 }
 810               else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i),
 811                                           TYPE_FIELD_BITSIZE (type, i)))
 812                 {
 813                   val_print_optimized_out (stream);
 814                 }
 815               else
 816                 {
 817                   struct value_print_options opts = *options;
 818
 819                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 820                                    unpack_field_as_long (type,
 821                                                          valaddr + offset, i));
 822
 823                   opts.deref_ref = 0;
 824                   common_val_print (v, stream, recurse + 1, &opts,
 825                                     current_language);
 826                 }
 827             }
 828           else
 829             {
 830               if (TYPE_FIELD_IGNORE (type, i))
 831                 {
 832                   fputs_filtered ("<optimized out or zero length>", stream);
 833                 }
 834               else if (field_is_static (&TYPE_FIELD (type, i)))
 835                 {
 836                   /* struct value *v = value_static_field (type, i);
 837                      v4.17 specific.  */
 838                   struct value *v;
 839
 840                   v = value_from_longest
 841                     (TYPE_FIELD_TYPE (type, i),
 842                      unpack_field_as_long (type, valaddr + offset, i));
 843
 844                   if (v == NULL)
 845                     val_print_optimized_out (stream);
 846                   else
 847                     pascal_object_print_static_field (v, stream, recurse + 1,
 848                                                       options);
 849                 }
 850               else
 851                 {
 852                   struct value_print_options opts = *options;
 853
 854                   opts.deref_ref = 0;
 855                   /* val_print (TYPE_FIELD_TYPE (type, i),
 856                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 857                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 858                      stream, format, 0, recurse + 1, pretty); */
 859                   val_print (TYPE_FIELD_TYPE (type, i),
 860                              valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
 861                              address, stream, recurse + 1, val, &opts,
 862                              current_language);
 863                 }
 864             }
 865           annotate_field_end ();
 866         }
 867
 868       if (dont_print_statmem == 0)
 869         {
 870           /* Free the space used to deal with the printing
 871              of the members from top level.  */
 872           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 873           dont_print_statmem_obstack = tmp_obstack;
 874         }
 875
 876       if (options->pretty)
 877         {
 878           fprintf_filtered (stream, "\n");
 879           print_spaces_filtered (2 * recurse, stream);
 880         }
 881     }
 882   fprintf_filtered (stream, "}");
 883 }
 884
 885 /* Special val_print routine to avoid printing multiple copies of virtual
 886    baseclasses.  */
 887
 888 static void
 889 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 890                            int offset,
 891                            CORE_ADDR address, struct ui_file *stream,
 892                            int recurse,
 893                            const struct value *val,
 894                            const struct value_print_options *options,
 895                            struct type **dont_print_vb)
 896 {
 897   struct type **last_dont_print
 898     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 899   struct obstack tmp_obstack = dont_print_vb_obstack;
 900   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 901
 902   if (dont_print_vb == 0)
 903     {
 904       /* If we're at top level, carve out a completely fresh
 905          chunk of the obstack and use that until this particular
 906          invocation returns.  */
 907       /* Bump up the high-water mark.  Now alpha is omega.  */
 908       obstack_finish (&dont_print_vb_obstack);
 909     }
 910
 911   for (i = 0; i < n_baseclasses; i++)
 912     {
 913       int boffset;
 914       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 915       char *basename = type_name_no_tag (baseclass);
 916       const gdb_byte *base_valaddr;
 917       int thisoffset;
 918
 919       if (BASETYPE_VIA_VIRTUAL (type, i))
 920         {
 921           struct type **first_dont_print
 922             = (struct type **) obstack_base (&dont_print_vb_obstack);
 923
 924           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 925             - first_dont_print;
 926
 927           while (--j >= 0)
 928             if (baseclass == first_dont_print[j])
 929               goto flush_it;
 930
 931           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 932         }
 933
 934       thisoffset = offset;
 935
 936       boffset = baseclass_offset (type, i, valaddr + offset, address + offset);
 937
 938       if (options->pretty)
 939         {
 940           fprintf_filtered (stream, "\n");
 941           print_spaces_filtered (2 * recurse, stream);
 942         }
 943       fputs_filtered ("<", stream);
 944       /* Not sure what the best notation is in the case where there is no
 945          baseclass name.  */
 946
 947       fputs_filtered (basename ? basename : "", stream);
 948       fputs_filtered ("> = ", stream);
 949
 950       /* The virtual base class pointer might have been clobbered by the
 951          user program.  Make sure that it still points to a valid memory
 952          location.  */
 953
 954       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 955         {
 956           /* FIXME (alloc): not safe is baseclass is really really big.  */
 957           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 958
 959           base_valaddr = buf;
 960           if (target_read_memory (address + boffset, buf,
 961                                   TYPE_LENGTH (baseclass)) != 0)
 962             boffset = -1;
 963           address = address + boffset;
 964           thisoffset = 0;
 965           boffset = 0;
 966         }
 967       else
 968         base_valaddr = valaddr;
 969
 970       if (boffset == -1)
 971         fprintf_filtered (stream, "<invalid address>");
 972       else
 973         pascal_object_print_value_fields (baseclass, base_valaddr,
 974                                           thisoffset + boffset, address,
 975                                           stream, recurse, val, options,
 976                      (struct type **) obstack_base (&dont_print_vb_obstack),
 977                                           0);
 978       fputs_filtered (", ", stream);
 979
 980     flush_it:
 981       ;
 982     }
 983
 984   if (dont_print_vb == 0)
 985     {
 986       /* Free the space used to deal with the printing
 987          of this type from top level.  */
 988       obstack_free (&dont_print_vb_obstack, last_dont_print);
 989       /* Reset watermark so that we can continue protecting
 990          ourselves from whatever we were protecting ourselves.  */
 991       dont_print_vb_obstack = tmp_obstack;
 992     }
 993 }
 994
 995 /* Print value of a static member.
 996    To avoid infinite recursion when printing a class that contains
 997    a static instance of the class, we keep the addresses of all printed
 998    static member classes in an obstack and refuse to print them more
 999    than once.
1000
1001    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
1002    have the same meanings as in c_val_print.  */
1003
1004 static void
1005 pascal_object_print_static_field (struct value *val,
1006                                   struct ui_file *stream,
1007                                   int recurse,
1008                                   const struct value_print_options *options)
1009 {
1010   struct type *type = value_type (val);
1011   struct value_print_options opts;
1012
1013   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
1014     {
1015       CORE_ADDR *first_dont_print, addr;
1016       int i;
1017
1018       first_dont_print
1019         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
1020       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
1021         - first_dont_print;
1022
1023       while (--i >= 0)
1024         {
1025           if (value_address (val) == first_dont_print[i])
1026             {
1027               fputs_filtered ("\
1028 <same as static member of an already seen type>",
1029                               stream);
1030               return;
1031             }
1032         }
1033
1034       addr = value_address (val);
1035       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
1036                     sizeof (CORE_ADDR));
1037
1038       CHECK_TYPEDEF (type);
1039       pascal_object_print_value_fields (type,
1040                                         value_contents_for_printing (val),
1041                                         value_embedded_offset (val),
1042                                         addr,
1043                                         stream, recurse,
1044                                         val, options, NULL, 1);
1045       return;
1046     }
1047
1048   opts = *options;
1049   opts.deref_ref = 0;
1050   common_val_print (val, stream, recurse, &opts, current_language);
1051 }
1052
1053 /* -Wmissing-prototypes */
1054 extern initialize_file_ftype _initialize_pascal_valprint;
1055
1056 void
1057 _initialize_pascal_valprint (void)
1058 {
1059   add_setshow_boolean_cmd ("pascal_static-members", class_support,
1060                            &user_print_options.pascal_static_field_print, _("\
1061 Set printing of pascal static members."), _("\
1062 Show printing of pascal static members."), NULL,
1063                            NULL,
1064                            show_pascal_static_field_print,
1065                            &setprintlist, &showprintlist);
1066 }