gdb/p-valprint.c

   1 /* Support for printing Pascal values for GDB, the GNU debugger.
   2
   3    Copyright (C) 2000-2014 Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 /* This file is derived from c-valprint.c */
  21
  22 #include "defs.h"
  23 #include "gdb_obstack.h"
  24 #include "symtab.h"
  25 #include "gdbtypes.h"
  26 #include "expression.h"
  27 #include "value.h"
  28 #include "command.h"
  29 #include "gdbcmd.h"
  30 #include "gdbcore.h"
  31 #include "demangle.h"
  32 #include "valprint.h"
  33 #include "typeprint.h"
  34 #include "language.h"
  35 #include "target.h"
  36 #include "annotate.h"
  37 #include "p-lang.h"
  38 #include "cp-abi.h"
  39 #include "cp-support.h"
  40 #include "exceptions.h"
  41 #include "objfiles.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->prettyformat_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 bound_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.minsym != NULL)
 231               && (vt_address == BMSYMBOL_VALUE_ADDRESS (msymbol)))
 232             {
 233               if (want_space)
 234                 fputs_filtered (" ", stream);
 235               fputs_filtered ("<", stream);
 236               fputs_filtered (MSYMBOL_PRINT_NAME (msymbol.minsym), 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.minsym != NULL)
 252                 wsym = lookup_symbol (MSYMBOL_LINKAGE_NAME (msymbol.minsym),
 253                                       block,
 254                                       VAR_DOMAIN, &is_this_fld);
 255
 256               if (wsym)
 257                 {
 258                   wtype = SYMBOL_TYPE (wsym);
 259                 }
 260               else
 261                 {
 262                   wtype = TYPE_TARGET_TYPE (type);
 263                 }
 264               vt_val = value_at (wtype, vt_address);
 265               common_val_print (vt_val, stream, recurse + 1, options,
 266                                 current_language);
 267               if (options->prettyformat)
 268                 {
 269                   fprintf_filtered (stream, "\n");
 270                   print_spaces_filtered (2 + 2 * recurse, stream);
 271                 }
 272             }
 273         }
 274
 275       return;
 276
 277     case TYPE_CODE_REF:
 278     case TYPE_CODE_ENUM:
 279     case TYPE_CODE_FLAGS:
 280     case TYPE_CODE_FUNC:
 281     case TYPE_CODE_RANGE:
 282     case TYPE_CODE_INT:
 283     case TYPE_CODE_FLT:
 284     case TYPE_CODE_VOID:
 285     case TYPE_CODE_ERROR:
 286     case TYPE_CODE_UNDEF:
 287     case TYPE_CODE_BOOL:
 288     case TYPE_CODE_CHAR:
 289       generic_val_print (type, valaddr, embedded_offset, address,
 290                          stream, recurse, original_value, options,
 291                          &p_decorations);
 292       break;
 293
 294     case TYPE_CODE_UNION:
 295       if (recurse && !options->unionprint)
 296         {
 297           fprintf_filtered (stream, "{...}");
 298           break;
 299         }
 300       /* Fall through.  */
 301     case TYPE_CODE_STRUCT:
 302       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 303         {
 304           /* Print the unmangled name if desired.  */
 305           /* Print vtable entry - we only get here if NOT using
 306              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.)  */
 307           /* Extract the address, assume that it is unsigned.  */
 308           print_address_demangle
 309             (options, gdbarch,
 310              extract_unsigned_integer (valaddr + embedded_offset
 311                                        + TYPE_FIELD_BITPOS (type,
 312                                                             VTBL_FNADDR_OFFSET) / 8,
 313                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type,
 314                                                                      VTBL_FNADDR_OFFSET)),
 315                                        byte_order),
 316              stream, demangle);
 317         }
 318       else
 319         {
 320           if (is_pascal_string_type (type, &length_pos, &length_size,
 321                                      &string_pos, &char_type, NULL))
 322             {
 323               len = extract_unsigned_integer (valaddr + embedded_offset
 324                                               + length_pos, length_size,
 325                                               byte_order);
 326               LA_PRINT_STRING (stream, char_type,
 327                                valaddr + embedded_offset + string_pos,
 328                                len, NULL, 0, options);
 329             }
 330           else
 331             pascal_object_print_value_fields (type, valaddr, embedded_offset,
 332                                               address, stream, recurse,
 333                                               original_value, options,
 334                                               NULL, 0);
 335         }
 336       break;
 337
 338     case TYPE_CODE_SET:
 339       elttype = TYPE_INDEX_TYPE (type);
 340       CHECK_TYPEDEF (elttype);
 341       if (TYPE_STUB (elttype))
 342         {
 343           fprintf_filtered (stream, "<incomplete type>");
 344           gdb_flush (stream);
 345           break;
 346         }
 347       else
 348         {
 349           struct type *range = elttype;
 350           LONGEST low_bound, high_bound;
 351           int i;
 352           int need_comma = 0;
 353
 354           fputs_filtered ("[", stream);
 355
 356           i = get_discrete_bounds (range, &low_bound, &high_bound);
 357           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
 358             {
 359               /* If we know the size of the set type, we can figure out the
 360               maximum value.  */
 361               i = 0;
 362               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
 363               TYPE_HIGH_BOUND (range) = high_bound;
 364             }
 365         maybe_bad_bstring:
 366           if (i < 0)
 367             {
 368               fputs_filtered ("<error value>", stream);
 369               goto done;
 370             }
 371
 372           for (i = low_bound; i <= high_bound; i++)
 373             {
 374               int element = value_bit_index (type,
 375                                              valaddr + embedded_offset, i);
 376
 377               if (element < 0)
 378                 {
 379                   i = element;
 380                   goto maybe_bad_bstring;
 381                 }
 382               if (element)
 383                 {
 384                   if (need_comma)
 385                     fputs_filtered (", ", stream);
 386                   print_type_scalar (range, i, stream);
 387                   need_comma = 1;
 388
 389                   if (i + 1 <= high_bound
 390                       && value_bit_index (type,
 391                                           valaddr + embedded_offset, ++i))
 392                     {
 393                       int j = i;
 394
 395                       fputs_filtered ("..", stream);
 396                       while (i + 1 <= high_bound
 397                              && value_bit_index (type,
 398                                                  valaddr + embedded_offset,
 399                                                  ++i))
 400                         j = i;
 401                       print_type_scalar (range, j, stream);
 402                     }
 403                 }
 404             }
 405         done:
 406           fputs_filtered ("]", stream);
 407         }
 408       break;
 409
 410     default:
 411       error (_("Invalid pascal type code %d in symbol table."),
 412              TYPE_CODE (type));
 413     }
 414   gdb_flush (stream);
 415 }
 416 \f
 417 void
 418 pascal_value_print (struct value *val, struct ui_file *stream,
 419                     const struct value_print_options *options)
 420 {
 421   struct type *type = value_type (val);
 422   struct value_print_options opts = *options;
 423
 424   opts.deref_ref = 1;
 425
 426   /* If it is a pointer, indicate what it points to.
 427
 428      Print type also if it is a reference.
 429
 430      Object pascal: if it is a member pointer, we will take care
 431      of that when we print it.  */
 432   if (TYPE_CODE (type) == TYPE_CODE_PTR
 433       || TYPE_CODE (type) == TYPE_CODE_REF)
 434     {
 435       /* Hack:  remove (char *) for char strings.  Their
 436          type is indicated by the quoted string anyway.  */
 437       if (TYPE_CODE (type) == TYPE_CODE_PTR
 438           && TYPE_NAME (type) == NULL
 439           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 440           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 441         {
 442           /* Print nothing.  */
 443         }
 444       else
 445         {
 446           fprintf_filtered (stream, "(");
 447           type_print (type, "", stream, -1);
 448           fprintf_filtered (stream, ") ");
 449         }
 450     }
 451   common_val_print (val, stream, 0, &opts, current_language);
 452 }
 453
 454
 455 static void
 456 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 457                                 struct cmd_list_element *c, const char *value)
 458 {
 459   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 460                     value);
 461 }
 462
 463 static struct obstack dont_print_vb_obstack;
 464 static struct obstack dont_print_statmem_obstack;
 465
 466 static void pascal_object_print_static_field (struct value *,
 467                                               struct ui_file *, int,
 468                                               const struct value_print_options *);
 469
 470 static void pascal_object_print_value (struct type *, const gdb_byte *,
 471                                        int,
 472                                        CORE_ADDR, struct ui_file *, int,
 473                                        const struct value *,
 474                                        const struct value_print_options *,
 475                                        struct type **);
 476
 477 /* It was changed to this after 2.4.5.  */
 478 const char pascal_vtbl_ptr_name[] =
 479 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 480
 481 /* Return truth value for assertion that TYPE is of the type
 482    "pointer to virtual function".  */
 483
 484 int
 485 pascal_object_is_vtbl_ptr_type (struct type *type)
 486 {
 487   const char *typename = type_name_no_tag (type);
 488
 489   return (typename != NULL
 490           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 491 }
 492
 493 /* Return truth value for the assertion that TYPE is of the type
 494    "pointer to virtual function table".  */
 495
 496 int
 497 pascal_object_is_vtbl_member (struct type *type)
 498 {
 499   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 500     {
 501       type = TYPE_TARGET_TYPE (type);
 502       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 503         {
 504           type = TYPE_TARGET_TYPE (type);
 505           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* If not using
 506                                                            thunks.  */
 507               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* If using thunks.  */
 508             {
 509               /* Virtual functions tables are full of pointers
 510                  to virtual functions.  */
 511               return pascal_object_is_vtbl_ptr_type (type);
 512             }
 513         }
 514     }
 515   return 0;
 516 }
 517
 518 /* Mutually recursive subroutines of pascal_object_print_value and
 519    c_val_print to print out a structure's fields:
 520    pascal_object_print_value_fields and pascal_object_print_value.
 521
 522    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 523    same meanings as in pascal_object_print_value and c_val_print.
 524
 525    DONT_PRINT is an array of baseclass types that we
 526    should not print, or zero if called from top level.  */
 527
 528 void
 529 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 530                                   int offset,
 531                                   CORE_ADDR address, struct ui_file *stream,
 532                                   int recurse,
 533                                   const struct value *val,
 534                                   const struct value_print_options *options,
 535                                   struct type **dont_print_vb,
 536                                   int dont_print_statmem)
 537 {
 538   int i, len, n_baseclasses;
 539   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 540
 541   CHECK_TYPEDEF (type);
 542
 543   fprintf_filtered (stream, "{");
 544   len = TYPE_NFIELDS (type);
 545   n_baseclasses = TYPE_N_BASECLASSES (type);
 546
 547   /* Print out baseclasses such that we don't print
 548      duplicates of virtual baseclasses.  */
 549   if (n_baseclasses > 0)
 550     pascal_object_print_value (type, valaddr, offset, address,
 551                                stream, recurse + 1, val,
 552                                options, dont_print_vb);
 553
 554   if (!len && n_baseclasses == 1)
 555     fprintf_filtered (stream, "<No data fields>");
 556   else
 557     {
 558       struct obstack tmp_obstack = dont_print_statmem_obstack;
 559       int fields_seen = 0;
 560
 561       if (dont_print_statmem == 0)
 562         {
 563           /* If we're at top level, carve out a completely fresh
 564              chunk of the obstack and use that until this particular
 565              invocation returns.  */
 566           obstack_finish (&dont_print_statmem_obstack);
 567         }
 568
 569       for (i = n_baseclasses; i < len; i++)
 570         {
 571           /* If requested, skip printing of static fields.  */
 572           if (!options->pascal_static_field_print
 573               && field_is_static (&TYPE_FIELD (type, i)))
 574             continue;
 575           if (fields_seen)
 576             fprintf_filtered (stream, ", ");
 577           else if (n_baseclasses > 0)
 578             {
 579               if (options->prettyformat)
 580                 {
 581                   fprintf_filtered (stream, "\n");
 582                   print_spaces_filtered (2 + 2 * recurse, stream);
 583                   fputs_filtered ("members of ", stream);
 584                   fputs_filtered (type_name_no_tag (type), stream);
 585                   fputs_filtered (": ", stream);
 586                 }
 587             }
 588           fields_seen = 1;
 589
 590           if (options->prettyformat)
 591             {
 592               fprintf_filtered (stream, "\n");
 593               print_spaces_filtered (2 + 2 * recurse, stream);
 594             }
 595           else
 596             {
 597               wrap_here (n_spaces (2 + 2 * recurse));
 598             }
 599
 600           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 601
 602           if (field_is_static (&TYPE_FIELD (type, i)))
 603             fputs_filtered ("static ", stream);
 604           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 605                                    language_cplus,
 606                                    DMGL_PARAMS | DMGL_ANSI);
 607           annotate_field_name_end ();
 608           fputs_filtered (" = ", stream);
 609           annotate_field_value ();
 610
 611           if (!field_is_static (&TYPE_FIELD (type, i))
 612               && TYPE_FIELD_PACKED (type, i))
 613             {
 614               struct value *v;
 615
 616               /* Bitfields require special handling, especially due to byte
 617                  order problems.  */
 618               if (TYPE_FIELD_IGNORE (type, i))
 619                 {
 620                   fputs_filtered ("<optimized out or zero length>", stream);
 621                 }
 622               else if (value_bits_synthetic_pointer (val,
 623                                                      TYPE_FIELD_BITPOS (type,
 624                                                                         i),
 625                                                      TYPE_FIELD_BITSIZE (type,
 626                                                                          i)))
 627                 {
 628                   fputs_filtered (_("<synthetic pointer>"), stream);
 629                 }
 630               else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i),
 631                                           TYPE_FIELD_BITSIZE (type, i)))
 632                 {
 633                   val_print_optimized_out (val, stream);
 634                 }
 635               else
 636                 {
 637                   struct value_print_options opts = *options;
 638
 639                   v = value_field_bitfield (type, i, valaddr, offset, val);
 640
 641                   opts.deref_ref = 0;
 642                   common_val_print (v, stream, recurse + 1, &opts,
 643                                     current_language);
 644                 }
 645             }
 646           else
 647             {
 648               if (TYPE_FIELD_IGNORE (type, i))
 649                 {
 650                   fputs_filtered ("<optimized out or zero length>", stream);
 651                 }
 652               else if (field_is_static (&TYPE_FIELD (type, i)))
 653                 {
 654                   /* struct value *v = value_static_field (type, i);
 655                      v4.17 specific.  */
 656                   struct value *v;
 657
 658                   v = value_field_bitfield (type, i, valaddr, offset, val);
 659
 660                   if (v == NULL)
 661                     val_print_optimized_out (NULL, stream);
 662                   else
 663                     pascal_object_print_static_field (v, stream, recurse + 1,
 664                                                       options);
 665                 }
 666               else
 667                 {
 668                   struct value_print_options opts = *options;
 669
 670                   opts.deref_ref = 0;
 671                   /* val_print (TYPE_FIELD_TYPE (type, i),
 672                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 673                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 674                      stream, format, 0, recurse + 1, pretty); */
 675                   val_print (TYPE_FIELD_TYPE (type, i),
 676                              valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
 677                              address, stream, recurse + 1, val, &opts,
 678                              current_language);
 679                 }
 680             }
 681           annotate_field_end ();
 682         }
 683
 684       if (dont_print_statmem == 0)
 685         {
 686           /* Free the space used to deal with the printing
 687              of the members from top level.  */
 688           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 689           dont_print_statmem_obstack = tmp_obstack;
 690         }
 691
 692       if (options->prettyformat)
 693         {
 694           fprintf_filtered (stream, "\n");
 695           print_spaces_filtered (2 * recurse, stream);
 696         }
 697     }
 698   fprintf_filtered (stream, "}");
 699 }
 700
 701 /* Special val_print routine to avoid printing multiple copies of virtual
 702    baseclasses.  */
 703
 704 static void
 705 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 706                            int offset,
 707                            CORE_ADDR address, struct ui_file *stream,
 708                            int recurse,
 709                            const struct value *val,
 710                            const struct value_print_options *options,
 711                            struct type **dont_print_vb)
 712 {
 713   struct type **last_dont_print
 714     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 715   struct obstack tmp_obstack = dont_print_vb_obstack;
 716   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 717
 718   if (dont_print_vb == 0)
 719     {
 720       /* If we're at top level, carve out a completely fresh
 721          chunk of the obstack and use that until this particular
 722          invocation returns.  */
 723       /* Bump up the high-water mark.  Now alpha is omega.  */
 724       obstack_finish (&dont_print_vb_obstack);
 725     }
 726
 727   for (i = 0; i < n_baseclasses; i++)
 728     {
 729       int boffset = 0;
 730       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 731       const char *basename = type_name_no_tag (baseclass);
 732       const gdb_byte *base_valaddr = NULL;
 733       int thisoffset;
 734       volatile struct gdb_exception ex;
 735       int skip = 0;
 736
 737       if (BASETYPE_VIA_VIRTUAL (type, i))
 738         {
 739           struct type **first_dont_print
 740             = (struct type **) obstack_base (&dont_print_vb_obstack);
 741
 742           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 743             - first_dont_print;
 744
 745           while (--j >= 0)
 746             if (baseclass == first_dont_print[j])
 747               goto flush_it;
 748
 749           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 750         }
 751
 752       thisoffset = offset;
 753
 754       TRY_CATCH (ex, RETURN_MASK_ERROR)
 755         {
 756           boffset = baseclass_offset (type, i, valaddr, offset, address, val);
 757         }
 758       if (ex.reason < 0 && ex.error == NOT_AVAILABLE_ERROR)
 759         skip = -1;
 760       else if (ex.reason < 0)
 761         skip = 1;
 762       else
 763         {
 764           skip = 0;
 765
 766           /* The virtual base class pointer might have been clobbered by the
 767              user program. Make sure that it still points to a valid memory
 768              location.  */
 769
 770           if (boffset < 0 || boffset >= TYPE_LENGTH (type))
 771             {
 772               gdb_byte *buf;
 773               struct cleanup *back_to;
 774
 775               buf = xmalloc (TYPE_LENGTH (baseclass));
 776               back_to = make_cleanup (xfree, buf);
 777
 778               base_valaddr = buf;
 779               if (target_read_memory (address + boffset, buf,
 780                                       TYPE_LENGTH (baseclass)) != 0)
 781                 skip = 1;
 782               address = address + boffset;
 783               thisoffset = 0;
 784               boffset = 0;
 785               do_cleanups (back_to);
 786             }
 787           else
 788             base_valaddr = valaddr;
 789         }
 790
 791       if (options->prettyformat)
 792         {
 793           fprintf_filtered (stream, "\n");
 794           print_spaces_filtered (2 * recurse, stream);
 795         }
 796       fputs_filtered ("<", stream);
 797       /* Not sure what the best notation is in the case where there is no
 798          baseclass name.  */
 799
 800       fputs_filtered (basename ? basename : "", stream);
 801       fputs_filtered ("> = ", stream);
 802
 803       if (skip < 0)
 804         val_print_unavailable (stream);
 805       else if (skip > 0)
 806         val_print_invalid_address (stream);
 807       else
 808         pascal_object_print_value_fields (baseclass, base_valaddr,
 809                                           thisoffset + boffset, address,
 810                                           stream, recurse, val, options,
 811                      (struct type **) obstack_base (&dont_print_vb_obstack),
 812                                           0);
 813       fputs_filtered (", ", stream);
 814
 815     flush_it:
 816       ;
 817     }
 818
 819   if (dont_print_vb == 0)
 820     {
 821       /* Free the space used to deal with the printing
 822          of this type from top level.  */
 823       obstack_free (&dont_print_vb_obstack, last_dont_print);
 824       /* Reset watermark so that we can continue protecting
 825          ourselves from whatever we were protecting ourselves.  */
 826       dont_print_vb_obstack = tmp_obstack;
 827     }
 828 }
 829
 830 /* Print value of a static member.
 831    To avoid infinite recursion when printing a class that contains
 832    a static instance of the class, we keep the addresses of all printed
 833    static member classes in an obstack and refuse to print them more
 834    than once.
 835
 836    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 837    have the same meanings as in c_val_print.  */
 838
 839 static void
 840 pascal_object_print_static_field (struct value *val,
 841                                   struct ui_file *stream,
 842                                   int recurse,
 843                                   const struct value_print_options *options)
 844 {
 845   struct type *type = value_type (val);
 846   struct value_print_options opts;
 847
 848   if (value_entirely_optimized_out (val))
 849     {
 850       val_print_optimized_out (val, stream);
 851       return;
 852     }
 853
 854   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 855     {
 856       CORE_ADDR *first_dont_print, addr;
 857       int i;
 858
 859       first_dont_print
 860         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 861       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 862         - first_dont_print;
 863
 864       while (--i >= 0)
 865         {
 866           if (value_address (val) == first_dont_print[i])
 867             {
 868               fputs_filtered ("\
 869 <same as static member of an already seen type>",
 870                               stream);
 871               return;
 872             }
 873         }
 874
 875       addr = value_address (val);
 876       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
 877                     sizeof (CORE_ADDR));
 878
 879       CHECK_TYPEDEF (type);
 880       pascal_object_print_value_fields (type,
 881                                         value_contents_for_printing (val),
 882                                         value_embedded_offset (val),
 883                                         addr,
 884                                         stream, recurse,
 885                                         val, options, NULL, 1);
 886       return;
 887     }
 888
 889   opts = *options;
 890   opts.deref_ref = 0;
 891   common_val_print (val, stream, recurse, &opts, current_language);
 892 }
 893
 894 /* -Wmissing-prototypes */
 895 extern initialize_file_ftype _initialize_pascal_valprint;
 896
 897 void
 898 _initialize_pascal_valprint (void)
 899 {
 900   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 901                            &user_print_options.pascal_static_field_print, _("\
 902 Set printing of pascal static members."), _("\
 903 Show printing of pascal static members."), NULL,
 904                            NULL,
 905                            show_pascal_static_field_print,
 906                            &setprintlist, &showprintlist);
 907 }