gdb/p-valprint.c

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