gdb/p-valprint.c

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