gdb/p-valprint.c

   1 /* Support for printing Pascal values for GDB, the GNU debugger.
   2
   3    Copyright (C) 2000-2001, 2003, 2005-2012 Free Software Foundation,
   4    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 #include "exceptions.h"
  42 \f
  43
  44 /* Decorations for Pascal.  */
  45
  46 static const struct generic_val_print_decorations p_decorations =
  47 {
  48   "",
  49   " + ",
  50   " * I",
  51   "true",
  52   "false",
  53   "void"
  54 };
  55
  56 /* See val_print for a description of the various parameters of this
  57    function; they are identical.  */
  58
  59 void
  60 pascal_val_print (struct type *type, const gdb_byte *valaddr,
  61                   int embedded_offset, CORE_ADDR address,
  62                   struct ui_file *stream, int recurse,
  63                   const struct value *original_value,
  64                   const struct value_print_options *options)
  65 {
  66   struct gdbarch *gdbarch = get_type_arch (type);
  67   enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
  68   unsigned int i = 0;   /* Number of characters printed */
  69   unsigned len;
  70   LONGEST low_bound, high_bound;
  71   struct type *elttype;
  72   unsigned eltlen;
  73   int length_pos, length_size, string_pos;
  74   struct type *char_type;
  75   CORE_ADDR addr;
  76   int want_space = 0;
  77
  78   CHECK_TYPEDEF (type);
  79   switch (TYPE_CODE (type))
  80     {
  81     case TYPE_CODE_ARRAY:
  82       if (get_array_bounds (type, &low_bound, &high_bound))
  83         {
  84           len = high_bound - low_bound + 1;
  85           elttype = check_typedef (TYPE_TARGET_TYPE (type));
  86           eltlen = TYPE_LENGTH (elttype);
  87           if (options->prettyprint_arrays)
  88             {
  89               print_spaces_filtered (2 + 2 * recurse, stream);
  90             }
  91           /* If 's' format is used, try to print out as string.
  92              If no format is given, print as string if element type
  93              is of TYPE_CODE_CHAR and element size is 1,2 or 4.  */
  94           if (options->format == 's'
  95               || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
  96                   && TYPE_CODE (elttype) == TYPE_CODE_CHAR
  97                   && options->format == 0))
  98             {
  99               /* If requested, look for the first null char and only print
 100                  elements up to it.  */
 101               if (options->stop_print_at_null)
 102                 {
 103                   unsigned int temp_len;
 104
 105                   /* Look for a NULL char.  */
 106                   for (temp_len = 0;
 107                        extract_unsigned_integer (valaddr + embedded_offset +
 108                                                  temp_len * eltlen, eltlen,
 109                                                  byte_order)
 110                        && temp_len < len && temp_len < options->print_max;
 111                        temp_len++);
 112                   len = temp_len;
 113                 }
 114
 115               LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
 116                                valaddr + embedded_offset, len, NULL, 0,
 117                                options);
 118               i = len;
 119             }
 120           else
 121             {
 122               fprintf_filtered (stream, "{");
 123               /* If this is a virtual function table, print the 0th
 124                  entry specially, and the rest of the members normally.  */
 125               if (pascal_object_is_vtbl_ptr_type (elttype))
 126                 {
 127                   i = 1;
 128                   fprintf_filtered (stream, "%d vtable entries", len - 1);
 129                 }
 130               else
 131                 {
 132                   i = 0;
 133                 }
 134               val_print_array_elements (type, valaddr, embedded_offset,
 135                                         address, stream, recurse,
 136                                         original_value, options, i);
 137               fprintf_filtered (stream, "}");
 138             }
 139           break;
 140         }
 141       /* Array of unspecified length: treat like pointer to first elt.  */
 142       addr = address + embedded_offset;
 143       goto print_unpacked_pointer;
 144
 145     case TYPE_CODE_PTR:
 146       if (options->format && options->format != 's')
 147         {
 148           val_print_scalar_formatted (type, valaddr, embedded_offset,
 149                                       original_value, options, 0, stream);
 150           break;
 151         }
 152       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 153         {
 154           /* Print the unmangled name if desired.  */
 155           /* Print vtable entry - we only get here if we ARE using
 156              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.)  */
 157           /* Extract the address, assume that it is unsigned.  */
 158           addr = extract_unsigned_integer (valaddr + embedded_offset,
 159                                            TYPE_LENGTH (type), byte_order);
 160           print_address_demangle (options, gdbarch, addr, stream, demangle);
 161           break;
 162         }
 163       check_typedef (TYPE_TARGET_TYPE (type));
 164
 165       addr = unpack_pointer (type, valaddr + embedded_offset);
 166     print_unpacked_pointer:
 167       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 168
 169       if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 170         {
 171           /* Try to print what function it points to.  */
 172           print_address_demangle (options, gdbarch, addr, stream, demangle);
 173           return;
 174         }
 175
 176       if (options->addressprint && options->format != 's')
 177         {
 178           fputs_filtered (paddress (gdbarch, addr), stream);
 179           want_space = 1;
 180         }
 181
 182       /* For a pointer to char or unsigned char, also print the string
 183          pointed to, unless pointer is null.  */
 184       if (((TYPE_LENGTH (elttype) == 1
 185            && (TYPE_CODE (elttype) == TYPE_CODE_INT
 186               || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 187           || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
 188               && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 189           && (options->format == 0 || options->format == 's')
 190           && addr != 0)
 191         {
 192           if (want_space)
 193             fputs_filtered (" ", stream);
 194           /* No wide string yet.  */
 195           i = val_print_string (elttype, NULL, addr, -1, stream, options);
 196         }
 197       /* Also for pointers to pascal strings.  */
 198       /* Note: this is Free Pascal specific:
 199          as GDB does not recognize stabs pascal strings
 200          Pascal strings are mapped to records
 201          with lowercase names PM.  */
 202       if (is_pascal_string_type (elttype, &length_pos, &length_size,
 203                                  &string_pos, &char_type, NULL)
 204           && addr != 0)
 205         {
 206           ULONGEST string_length;
 207           void *buffer;
 208
 209           if (want_space)
 210             fputs_filtered (" ", stream);
 211           buffer = xmalloc (length_size);
 212           read_memory (addr + length_pos, buffer, length_size);
 213           string_length = extract_unsigned_integer (buffer, length_size,
 214                                                     byte_order);
 215           xfree (buffer);
 216           i = val_print_string (char_type, NULL,
 217                                 addr + string_pos, string_length,
 218                                 stream, options);
 219         }
 220       else if (pascal_object_is_vtbl_member (type))
 221         {
 222           /* Print vtbl's nicely.  */
 223           CORE_ADDR vt_address = unpack_pointer (type,
 224                                                  valaddr + embedded_offset);
 225           struct minimal_symbol *msymbol =
 226             lookup_minimal_symbol_by_pc (vt_address);
 227
 228           /* If 'symbol_print' is set, we did the work above.  */
 229           if (!options->symbol_print
 230               && (msymbol != NULL)
 231               && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
 232             {
 233               if (want_space)
 234                 fputs_filtered (" ", stream);
 235               fputs_filtered ("<", stream);
 236               fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
 237               fputs_filtered (">", stream);
 238               want_space = 1;
 239             }
 240           if (vt_address && options->vtblprint)
 241             {
 242               struct value *vt_val;
 243               struct symbol *wsym = (struct symbol *) NULL;
 244               struct type *wtype;
 245               struct block *block = (struct block *) NULL;
 246               struct field_of_this_result is_this_fld;
 247
 248               if (want_space)
 249                 fputs_filtered (" ", stream);
 250
 251               if (msymbol != NULL)
 252                 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
 253                                       VAR_DOMAIN, &is_this_fld);
 254
 255               if (wsym)
 256                 {
 257                   wtype = SYMBOL_TYPE (wsym);
 258                 }
 259               else
 260                 {
 261                   wtype = TYPE_TARGET_TYPE (type);
 262                 }
 263               vt_val = value_at (wtype, vt_address);
 264               common_val_print (vt_val, stream, recurse + 1, options,
 265                                 current_language);
 266               if (options->pretty)
 267                 {
 268                   fprintf_filtered (stream, "\n");
 269                   print_spaces_filtered (2 + 2 * recurse, stream);
 270                 }
 271             }
 272         }
 273
 274       return;
 275
 276     case TYPE_CODE_REF:
 277     case TYPE_CODE_ENUM:
 278     case TYPE_CODE_FLAGS:
 279     case TYPE_CODE_FUNC:
 280     case TYPE_CODE_RANGE:
 281     case TYPE_CODE_INT:
 282     case TYPE_CODE_FLT:
 283     case TYPE_CODE_VOID:
 284     case TYPE_CODE_ERROR:
 285     case TYPE_CODE_UNDEF:
 286     case TYPE_CODE_BOOL:
 287     case TYPE_CODE_CHAR:
 288       generic_val_print (type, valaddr, embedded_offset, address,
 289                          stream, recurse, original_value, options,
 290                          &p_decorations);
 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             (options, 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_SET:
 338       elttype = TYPE_INDEX_TYPE (type);
 339       CHECK_TYPEDEF (elttype);
 340       if (TYPE_STUB (elttype))
 341         {
 342           fprintf_filtered (stream, "<incomplete type>");
 343           gdb_flush (stream);
 344           break;
 345         }
 346       else
 347         {
 348           struct type *range = elttype;
 349           LONGEST low_bound, high_bound;
 350           int i;
 351           int need_comma = 0;
 352
 353           fputs_filtered ("[", stream);
 354
 355           i = get_discrete_bounds (range, &low_bound, &high_bound);
 356           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
 357             {
 358               /* If we know the size of the set type, we can figure out the
 359               maximum value.  */
 360               i = 0;
 361               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
 362               TYPE_HIGH_BOUND (range) = high_bound;
 363             }
 364         maybe_bad_bstring:
 365           if (i < 0)
 366             {
 367               fputs_filtered ("<error value>", stream);
 368               goto done;
 369             }
 370
 371           for (i = low_bound; i <= high_bound; i++)
 372             {
 373               int element = value_bit_index (type,
 374                                              valaddr + embedded_offset, i);
 375
 376               if (element < 0)
 377                 {
 378                   i = element;
 379                   goto maybe_bad_bstring;
 380                 }
 381               if (element)
 382                 {
 383                   if (need_comma)
 384                     fputs_filtered (", ", stream);
 385                   print_type_scalar (range, i, stream);
 386                   need_comma = 1;
 387
 388                   if (i + 1 <= high_bound
 389                       && value_bit_index (type,
 390                                           valaddr + embedded_offset, ++i))
 391                     {
 392                       int j = i;
 393
 394                       fputs_filtered ("..", stream);
 395                       while (i + 1 <= high_bound
 396                              && value_bit_index (type,
 397                                                  valaddr + embedded_offset,
 398                                                  ++i))
 399                         j = i;
 400                       print_type_scalar (range, j, stream);
 401                     }
 402                 }
 403             }
 404         done:
 405           fputs_filtered ("]", stream);
 406         }
 407       break;
 408
 409     default:
 410       error (_("Invalid pascal type code %d in symbol table."),
 411              TYPE_CODE (type));
 412     }
 413   gdb_flush (stream);
 414 }
 415 \f
 416 void
 417 pascal_value_print (struct value *val, struct ui_file *stream,
 418                     const struct value_print_options *options)
 419 {
 420   struct type *type = value_type (val);
 421   struct value_print_options opts = *options;
 422
 423   opts.deref_ref = 1;
 424
 425   /* If it is a pointer, indicate what it points to.
 426
 427      Print type also if it is a reference.
 428
 429      Object pascal: if it is a member pointer, we will take care
 430      of that when we print it.  */
 431   if (TYPE_CODE (type) == TYPE_CODE_PTR
 432       || TYPE_CODE (type) == TYPE_CODE_REF)
 433     {
 434       /* Hack:  remove (char *) for char strings.  Their
 435          type is indicated by the quoted string anyway.  */
 436       if (TYPE_CODE (type) == TYPE_CODE_PTR
 437           && TYPE_NAME (type) == NULL
 438           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 439           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 440         {
 441           /* Print nothing.  */
 442         }
 443       else
 444         {
 445           fprintf_filtered (stream, "(");
 446           type_print (type, "", stream, -1);
 447           fprintf_filtered (stream, ") ");
 448         }
 449     }
 450   common_val_print (val, stream, 0, &opts, current_language);
 451 }
 452
 453
 454 static void
 455 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 456                                 struct cmd_list_element *c, const char *value)
 457 {
 458   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 459                     value);
 460 }
 461
 462 static struct obstack dont_print_vb_obstack;
 463 static struct obstack dont_print_statmem_obstack;
 464
 465 static void pascal_object_print_static_field (struct value *,
 466                                               struct ui_file *, int,
 467                                               const struct value_print_options *);
 468
 469 static void pascal_object_print_value (struct type *, const gdb_byte *,
 470                                        int,
 471                                        CORE_ADDR, struct ui_file *, int,
 472                                        const struct value *,
 473                                        const struct value_print_options *,
 474                                        struct type **);
 475
 476 /* It was changed to this after 2.4.5.  */
 477 const char pascal_vtbl_ptr_name[] =
 478 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 479
 480 /* Return truth value for assertion that TYPE is of the type
 481    "pointer to virtual function".  */
 482
 483 int
 484 pascal_object_is_vtbl_ptr_type (struct type *type)
 485 {
 486   const char *typename = type_name_no_tag (type);
 487
 488   return (typename != NULL
 489           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 490 }
 491
 492 /* Return truth value for the assertion that TYPE is of the type
 493    "pointer to virtual function table".  */
 494
 495 int
 496 pascal_object_is_vtbl_member (struct type *type)
 497 {
 498   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 499     {
 500       type = TYPE_TARGET_TYPE (type);
 501       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 502         {
 503           type = TYPE_TARGET_TYPE (type);
 504           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* If not using
 505                                                            thunks.  */
 506               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* If using thunks.  */
 507             {
 508               /* Virtual functions tables are full of pointers
 509                  to virtual functions.  */
 510               return pascal_object_is_vtbl_ptr_type (type);
 511             }
 512         }
 513     }
 514   return 0;
 515 }
 516
 517 /* Mutually recursive subroutines of pascal_object_print_value and
 518    c_val_print to print out a structure's fields:
 519    pascal_object_print_value_fields and pascal_object_print_value.
 520
 521    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 522    same meanings as in pascal_object_print_value and c_val_print.
 523
 524    DONT_PRINT is an array of baseclass types that we
 525    should not print, or zero if called from top level.  */
 526
 527 void
 528 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 529                                   int offset,
 530                                   CORE_ADDR address, struct ui_file *stream,
 531                                   int recurse,
 532                                   const struct value *val,
 533                                   const struct value_print_options *options,
 534                                   struct type **dont_print_vb,
 535                                   int dont_print_statmem)
 536 {
 537   int i, len, n_baseclasses;
 538   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 539
 540   CHECK_TYPEDEF (type);
 541
 542   fprintf_filtered (stream, "{");
 543   len = TYPE_NFIELDS (type);
 544   n_baseclasses = TYPE_N_BASECLASSES (type);
 545
 546   /* Print out baseclasses such that we don't print
 547      duplicates of virtual baseclasses.  */
 548   if (n_baseclasses > 0)
 549     pascal_object_print_value (type, valaddr, offset, address,
 550                                stream, recurse + 1, val,
 551                                options, dont_print_vb);
 552
 553   if (!len && n_baseclasses == 1)
 554     fprintf_filtered (stream, "<No data fields>");
 555   else
 556     {
 557       struct obstack tmp_obstack = dont_print_statmem_obstack;
 558       int fields_seen = 0;
 559
 560       if (dont_print_statmem == 0)
 561         {
 562           /* If we're at top level, carve out a completely fresh
 563              chunk of the obstack and use that until this particular
 564              invocation returns.  */
 565           obstack_finish (&dont_print_statmem_obstack);
 566         }
 567
 568       for (i = n_baseclasses; i < len; i++)
 569         {
 570           /* If requested, skip printing of static fields.  */
 571           if (!options->pascal_static_field_print
 572               && field_is_static (&TYPE_FIELD (type, i)))
 573             continue;
 574           if (fields_seen)
 575             fprintf_filtered (stream, ", ");
 576           else if (n_baseclasses > 0)
 577             {
 578               if (options->pretty)
 579                 {
 580                   fprintf_filtered (stream, "\n");
 581                   print_spaces_filtered (2 + 2 * recurse, stream);
 582                   fputs_filtered ("members of ", stream);
 583                   fputs_filtered (type_name_no_tag (type), stream);
 584                   fputs_filtered (": ", stream);
 585                 }
 586             }
 587           fields_seen = 1;
 588
 589           if (options->pretty)
 590             {
 591               fprintf_filtered (stream, "\n");
 592               print_spaces_filtered (2 + 2 * recurse, stream);
 593             }
 594           else
 595             {
 596               wrap_here (n_spaces (2 + 2 * recurse));
 597             }
 598           if (options->inspect_it)
 599             {
 600               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 601                 fputs_filtered ("\"( ptr \"", stream);
 602               else
 603                 fputs_filtered ("\"( nodef \"", stream);
 604               if (field_is_static (&TYPE_FIELD (type, i)))
 605                 fputs_filtered ("static ", stream);
 606               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 607                                        language_cplus,
 608                                        DMGL_PARAMS | DMGL_ANSI);
 609               fputs_filtered ("\" \"", stream);
 610               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 611                                        language_cplus,
 612                                        DMGL_PARAMS | DMGL_ANSI);
 613               fputs_filtered ("\") \"", stream);
 614             }
 615           else
 616             {
 617               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 618
 619               if (field_is_static (&TYPE_FIELD (type, i)))
 620                 fputs_filtered ("static ", stream);
 621               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 622                                        language_cplus,
 623                                        DMGL_PARAMS | DMGL_ANSI);
 624               annotate_field_name_end ();
 625               fputs_filtered (" = ", stream);
 626               annotate_field_value ();
 627             }
 628
 629           if (!field_is_static (&TYPE_FIELD (type, i))
 630               && TYPE_FIELD_PACKED (type, i))
 631             {
 632               struct value *v;
 633
 634               /* Bitfields require special handling, especially due to byte
 635                  order problems.  */
 636               if (TYPE_FIELD_IGNORE (type, i))
 637                 {
 638                   fputs_filtered ("<optimized out or zero length>", stream);
 639                 }
 640               else if (value_bits_synthetic_pointer (val,
 641                                                      TYPE_FIELD_BITPOS (type,
 642                                                                         i),
 643                                                      TYPE_FIELD_BITSIZE (type,
 644                                                                          i)))
 645                 {
 646                   fputs_filtered (_("<synthetic pointer>"), stream);
 647                 }
 648               else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i),
 649                                           TYPE_FIELD_BITSIZE (type, i)))
 650                 {
 651                   val_print_optimized_out (stream);
 652                 }
 653               else
 654                 {
 655                   struct value_print_options opts = *options;
 656
 657                   v = value_field_bitfield (type, i, valaddr, offset, val);
 658
 659                   opts.deref_ref = 0;
 660                   common_val_print (v, stream, recurse + 1, &opts,
 661                                     current_language);
 662                 }
 663             }
 664           else
 665             {
 666               if (TYPE_FIELD_IGNORE (type, i))
 667                 {
 668                   fputs_filtered ("<optimized out or zero length>", stream);
 669                 }
 670               else if (field_is_static (&TYPE_FIELD (type, i)))
 671                 {
 672                   /* struct value *v = value_static_field (type, i);
 673                      v4.17 specific.  */
 674                   struct value *v;
 675
 676                   v = value_field_bitfield (type, i, valaddr, offset, val);
 677
 678                   if (v == NULL)
 679                     val_print_optimized_out (stream);
 680                   else
 681                     pascal_object_print_static_field (v, stream, recurse + 1,
 682                                                       options);
 683                 }
 684               else
 685                 {
 686                   struct value_print_options opts = *options;
 687
 688                   opts.deref_ref = 0;
 689                   /* val_print (TYPE_FIELD_TYPE (type, i),
 690                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 691                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 692                      stream, format, 0, recurse + 1, pretty); */
 693                   val_print (TYPE_FIELD_TYPE (type, i),
 694                              valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
 695                              address, stream, recurse + 1, val, &opts,
 696                              current_language);
 697                 }
 698             }
 699           annotate_field_end ();
 700         }
 701
 702       if (dont_print_statmem == 0)
 703         {
 704           /* Free the space used to deal with the printing
 705              of the members from top level.  */
 706           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 707           dont_print_statmem_obstack = tmp_obstack;
 708         }
 709
 710       if (options->pretty)
 711         {
 712           fprintf_filtered (stream, "\n");
 713           print_spaces_filtered (2 * recurse, stream);
 714         }
 715     }
 716   fprintf_filtered (stream, "}");
 717 }
 718
 719 /* Special val_print routine to avoid printing multiple copies of virtual
 720    baseclasses.  */
 721
 722 static void
 723 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 724                            int offset,
 725                            CORE_ADDR address, struct ui_file *stream,
 726                            int recurse,
 727                            const struct value *val,
 728                            const struct value_print_options *options,
 729                            struct type **dont_print_vb)
 730 {
 731   struct type **last_dont_print
 732     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 733   struct obstack tmp_obstack = dont_print_vb_obstack;
 734   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 735
 736   if (dont_print_vb == 0)
 737     {
 738       /* If we're at top level, carve out a completely fresh
 739          chunk of the obstack and use that until this particular
 740          invocation returns.  */
 741       /* Bump up the high-water mark.  Now alpha is omega.  */
 742       obstack_finish (&dont_print_vb_obstack);
 743     }
 744
 745   for (i = 0; i < n_baseclasses; i++)
 746     {
 747       int boffset = 0;
 748       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 749       const char *basename = type_name_no_tag (baseclass);
 750       const gdb_byte *base_valaddr = NULL;
 751       int thisoffset;
 752       volatile struct gdb_exception ex;
 753       int skip = 0;
 754
 755       if (BASETYPE_VIA_VIRTUAL (type, i))
 756         {
 757           struct type **first_dont_print
 758             = (struct type **) obstack_base (&dont_print_vb_obstack);
 759
 760           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 761             - first_dont_print;
 762
 763           while (--j >= 0)
 764             if (baseclass == first_dont_print[j])
 765               goto flush_it;
 766
 767           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 768         }
 769
 770       thisoffset = offset;
 771
 772       TRY_CATCH (ex, RETURN_MASK_ERROR)
 773         {
 774           boffset = baseclass_offset (type, i, valaddr, offset, address, val);
 775         }
 776       if (ex.reason < 0 && ex.error == NOT_AVAILABLE_ERROR)
 777         skip = -1;
 778       else if (ex.reason < 0)
 779         skip = 1;
 780       else
 781         {
 782           skip = 0;
 783
 784           /* The virtual base class pointer might have been clobbered by the
 785              user program. Make sure that it still points to a valid memory
 786              location.  */
 787
 788           if (boffset < 0 || boffset >= TYPE_LENGTH (type))
 789             {
 790               gdb_byte *buf;
 791               struct cleanup *back_to;
 792
 793               buf = xmalloc (TYPE_LENGTH (baseclass));
 794               back_to = make_cleanup (xfree, buf);
 795
 796               base_valaddr = buf;
 797               if (target_read_memory (address + boffset, buf,
 798                                       TYPE_LENGTH (baseclass)) != 0)
 799                 skip = 1;
 800               address = address + boffset;
 801               thisoffset = 0;
 802               boffset = 0;
 803               do_cleanups (back_to);
 804             }
 805           else
 806             base_valaddr = valaddr;
 807         }
 808
 809       if (options->pretty)
 810         {
 811           fprintf_filtered (stream, "\n");
 812           print_spaces_filtered (2 * recurse, stream);
 813         }
 814       fputs_filtered ("<", stream);
 815       /* Not sure what the best notation is in the case where there is no
 816          baseclass name.  */
 817
 818       fputs_filtered (basename ? basename : "", stream);
 819       fputs_filtered ("> = ", stream);
 820
 821       if (skip < 0)
 822         val_print_unavailable (stream);
 823       else if (skip > 0)
 824         val_print_invalid_address (stream);
 825       else
 826         pascal_object_print_value_fields (baseclass, base_valaddr,
 827                                           thisoffset + boffset, address,
 828                                           stream, recurse, val, options,
 829                      (struct type **) obstack_base (&dont_print_vb_obstack),
 830                                           0);
 831       fputs_filtered (", ", stream);
 832
 833     flush_it:
 834       ;
 835     }
 836
 837   if (dont_print_vb == 0)
 838     {
 839       /* Free the space used to deal with the printing
 840          of this type from top level.  */
 841       obstack_free (&dont_print_vb_obstack, last_dont_print);
 842       /* Reset watermark so that we can continue protecting
 843          ourselves from whatever we were protecting ourselves.  */
 844       dont_print_vb_obstack = tmp_obstack;
 845     }
 846 }
 847
 848 /* Print value of a static member.
 849    To avoid infinite recursion when printing a class that contains
 850    a static instance of the class, we keep the addresses of all printed
 851    static member classes in an obstack and refuse to print them more
 852    than once.
 853
 854    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 855    have the same meanings as in c_val_print.  */
 856
 857 static void
 858 pascal_object_print_static_field (struct value *val,
 859                                   struct ui_file *stream,
 860                                   int recurse,
 861                                   const struct value_print_options *options)
 862 {
 863   struct type *type = value_type (val);
 864   struct value_print_options opts;
 865
 866   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 867     {
 868       CORE_ADDR *first_dont_print, addr;
 869       int i;
 870
 871       first_dont_print
 872         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 873       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 874         - first_dont_print;
 875
 876       while (--i >= 0)
 877         {
 878           if (value_address (val) == first_dont_print[i])
 879             {
 880               fputs_filtered ("\
 881 <same as static member of an already seen type>",
 882                               stream);
 883               return;
 884             }
 885         }
 886
 887       addr = value_address (val);
 888       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 889                     sizeof (CORE_ADDR));
 890
 891       CHECK_TYPEDEF (type);
 892       pascal_object_print_value_fields (type,
 893                                         value_contents_for_printing (val),
 894                                         value_embedded_offset (val),
 895                                         addr,
 896                                         stream, recurse,
 897                                         val, options, NULL, 1);
 898       return;
 899     }
 900
 901   opts = *options;
 902   opts.deref_ref = 0;
 903   common_val_print (val, stream, recurse, &opts, current_language);
 904 }
 905
 906 /* -Wmissing-prototypes */
 907 extern initialize_file_ftype _initialize_pascal_valprint;
 908
 909 void
 910 _initialize_pascal_valprint (void)
 911 {
 912   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 913                            &user_print_options.pascal_static_field_print, _("\
 914 Set printing of pascal static members."), _("\
 915 Show printing of pascal static members."), NULL,
 916                            NULL,
 917                            show_pascal_static_field_print,
 918                            &setprintlist, &showprintlist);
 919 }