gdb/p-valprint.c

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