gdb/p-valprint.c

   1 /* Support for printing Pascal values for GDB, the GNU debugger.
   2
   3    Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011
   4    Free Software Foundation, Inc.
   5
   6    This file is part of GDB.
   7
   8    This program is free software; you can redistribute it and/or modify
   9    it under the terms of the GNU General Public License as published by
  10    the Free Software Foundation; either version 3 of the License, or
  11    (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public License
  19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21 /* This file is derived from c-valprint.c */
  22
  23 #include "defs.h"
  24 #include "gdb_obstack.h"
  25 #include "symtab.h"
  26 #include "gdbtypes.h"
  27 #include "expression.h"
  28 #include "value.h"
  29 #include "command.h"
  30 #include "gdbcmd.h"
  31 #include "gdbcore.h"
  32 #include "demangle.h"
  33 #include "valprint.h"
  34 #include "typeprint.h"
  35 #include "language.h"
  36 #include "target.h"
  37 #include "annotate.h"
  38 #include "p-lang.h"
  39 #include "cp-abi.h"
  40 #include "cp-support.h"
  41 \f
  42
  43 /* See val_print for a description of the various parameters of this
  44    function; they are identical.  The semantics of the return value is
  45    also identical to val_print.  */
  46
  47 int
  48 pascal_val_print (struct type *type, const gdb_byte *valaddr,
  49                   int embedded_offset, CORE_ADDR address,
  50                   struct ui_file *stream, int recurse,
  51                   const struct value *original_value,
  52                   const struct value_print_options *options)
  53 {
  54   struct gdbarch *gdbarch = get_type_arch (type);
  55   enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
  56   unsigned int i = 0;   /* Number of characters printed */
  57   unsigned len;
  58   LONGEST low_bound, high_bound;
  59   struct type *elttype;
  60   unsigned eltlen;
  61   int length_pos, length_size, string_pos;
  62   struct type *char_type;
  63   LONGEST val;
  64   CORE_ADDR addr;
  65
  66   CHECK_TYPEDEF (type);
  67   switch (TYPE_CODE (type))
  68     {
  69     case TYPE_CODE_ARRAY:
  70       if (get_array_bounds (type, &low_bound, &high_bound))
  71         {
  72           len = high_bound - low_bound + 1;
  73           elttype = check_typedef (TYPE_TARGET_TYPE (type));
  74           eltlen = TYPE_LENGTH (elttype);
  75           if (options->prettyprint_arrays)
  76             {
  77               print_spaces_filtered (2 + 2 * recurse, stream);
  78             }
  79           /* If 's' format is used, try to print out as string.
  80              If no format is given, print as string if element type
  81              is of TYPE_CODE_CHAR and element size is 1,2 or 4.  */
  82           if (options->format == 's'
  83               || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
  84                   && TYPE_CODE (elttype) == TYPE_CODE_CHAR
  85                   && options->format == 0))
  86             {
  87               /* If requested, look for the first null char and only print
  88                  elements up to it.  */
  89               if (options->stop_print_at_null)
  90                 {
  91                   unsigned int temp_len;
  92
  93                   /* Look for a NULL char.  */
  94                   for (temp_len = 0;
  95                        extract_unsigned_integer (valaddr + embedded_offset +
  96                                                  temp_len * eltlen, eltlen,
  97                                                  byte_order)
  98                        && temp_len < len && temp_len < options->print_max;
  99                        temp_len++);
 100                   len = temp_len;
 101                 }
 102
 103               LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
 104                                valaddr + embedded_offset, len, NULL, 0,
 105                                options);
 106               i = len;
 107             }
 108           else
 109             {
 110               fprintf_filtered (stream, "{");
 111               /* If this is a virtual function table, print the 0th
 112                  entry specially, and the rest of the members normally.  */
 113               if (pascal_object_is_vtbl_ptr_type (elttype))
 114                 {
 115                   i = 1;
 116                   fprintf_filtered (stream, "%d vtable entries", len - 1);
 117                 }
 118               else
 119                 {
 120                   i = 0;
 121                 }
 122               val_print_array_elements (type, valaddr, embedded_offset,
 123                                         address, stream, recurse,
 124                                         original_value, options, i);
 125               fprintf_filtered (stream, "}");
 126             }
 127           break;
 128         }
 129       /* Array of unspecified length: treat like pointer to first elt.  */
 130       addr = address;
 131       goto print_unpacked_pointer;
 132
 133     case TYPE_CODE_PTR:
 134       if (options->format && options->format != 's')
 135         {
 136           val_print_scalar_formatted (type, valaddr, embedded_offset,
 137                                       original_value, options, 0, stream);
 138           break;
 139         }
 140       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 141         {
 142           /* Print the unmangled name if desired.  */
 143           /* Print vtable entry - we only get here if we ARE using
 144              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.)  */
 145           /* Extract the address, assume that it is unsigned.  */
 146           addr = extract_unsigned_integer (valaddr + embedded_offset,
 147                                            TYPE_LENGTH (type), byte_order);
 148           print_address_demangle (gdbarch, addr, stream, demangle);
 149           break;
 150         }
 151       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 152
 153       addr = unpack_pointer (type, valaddr + embedded_offset);
 154     print_unpacked_pointer:
 155       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 156
 157       if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 158         {
 159           /* Try to print what function it points to.  */
 160           print_address_demangle (gdbarch, addr, stream, demangle);
 161           /* Return value is irrelevant except for string pointers.  */
 162           return (0);
 163         }
 164
 165       if (options->addressprint && options->format != 's')
 166         {
 167           fputs_filtered (paddress (gdbarch, addr), stream);
 168         }
 169
 170       /* For a pointer to char or unsigned char, also print the string
 171          pointed to, unless pointer is null.  */
 172       if (((TYPE_LENGTH (elttype) == 1
 173            && (TYPE_CODE (elttype) == TYPE_CODE_INT
 174               || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 175           || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
 176               && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 177           && (options->format == 0 || options->format == 's')
 178           && addr != 0)
 179         {
 180           /* No wide string yet.  */
 181           i = val_print_string (elttype, NULL, addr, -1, stream, options);
 182         }
 183       /* Also for pointers to pascal strings.  */
 184       /* Note: this is Free Pascal specific:
 185          as GDB does not recognize stabs pascal strings
 186          Pascal strings are mapped to records
 187          with lowercase names PM.  */
 188       if (is_pascal_string_type (elttype, &length_pos, &length_size,
 189                                  &string_pos, &char_type, NULL)
 190           && addr != 0)
 191         {
 192           ULONGEST string_length;
 193           void *buffer;
 194
 195           buffer = xmalloc (length_size);
 196           read_memory (addr + length_pos, buffer, length_size);
 197           string_length = extract_unsigned_integer (buffer, length_size,
 198                                                     byte_order);
 199           xfree (buffer);
 200           i = val_print_string (char_type, NULL,
 201                                 addr + string_pos, string_length,
 202                                 stream, options);
 203         }
 204       else if (pascal_object_is_vtbl_member (type))
 205         {
 206           /* Print vtbl's nicely.  */
 207           CORE_ADDR vt_address = unpack_pointer (type,
 208                                                  valaddr + embedded_offset);
 209           struct minimal_symbol *msymbol =
 210             lookup_minimal_symbol_by_pc (vt_address);
 211
 212           if ((msymbol != NULL)
 213               && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
 214             {
 215               fputs_filtered (" <", stream);
 216               fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
 217               fputs_filtered (">", stream);
 218             }
 219           if (vt_address && options->vtblprint)
 220             {
 221               struct value *vt_val;
 222               struct symbol *wsym = (struct symbol *) NULL;
 223               struct type *wtype;
 224               struct block *block = (struct block *) NULL;
 225               int is_this_fld;
 226
 227               if (msymbol != NULL)
 228                 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
 229                                       VAR_DOMAIN, &is_this_fld);
 230
 231               if (wsym)
 232                 {
 233                   wtype = SYMBOL_TYPE (wsym);
 234                 }
 235               else
 236                 {
 237                   wtype = TYPE_TARGET_TYPE (type);
 238                 }
 239               vt_val = value_at (wtype, vt_address);
 240               common_val_print (vt_val, stream, recurse + 1, options,
 241                                 current_language);
 242               if (options->pretty)
 243                 {
 244                   fprintf_filtered (stream, "\n");
 245                   print_spaces_filtered (2 + 2 * recurse, stream);
 246                 }
 247             }
 248         }
 249
 250       /* Return number of characters printed, including the terminating
 251          '\0' if we reached the end.  val_print_string takes care including
 252          the terminating '\0' if necessary.  */
 253       return i;
 254
 255       break;
 256
 257     case TYPE_CODE_REF:
 258       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 259       if (options->addressprint)
 260         {
 261           CORE_ADDR addr
 262             = extract_typed_address (valaddr + embedded_offset, type);
 263
 264           fprintf_filtered (stream, "@");
 265           fputs_filtered (paddress (gdbarch, addr), stream);
 266           if (options->deref_ref)
 267             fputs_filtered (": ", stream);
 268         }
 269       /* De-reference the reference.  */
 270       if (options->deref_ref)
 271         {
 272           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 273             {
 274               struct value *deref_val =
 275                 value_at
 276                 (TYPE_TARGET_TYPE (type),
 277                  unpack_pointer (type, valaddr + embedded_offset));
 278
 279               common_val_print (deref_val, stream, recurse + 1, options,
 280                                 current_language);
 281             }
 282           else
 283             fputs_filtered ("???", stream);
 284         }
 285       break;
 286
 287     case TYPE_CODE_UNION:
 288       if (recurse && !options->unionprint)
 289         {
 290           fprintf_filtered (stream, "{...}");
 291           break;
 292         }
 293       /* Fall through.  */
 294     case TYPE_CODE_STRUCT:
 295       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
 296         {
 297           /* Print the unmangled name if desired.  */
 298           /* Print vtable entry - we only get here if NOT using
 299              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.)  */
 300           /* Extract the address, assume that it is unsigned.  */
 301           print_address_demangle
 302             (gdbarch,
 303              extract_unsigned_integer (valaddr + embedded_offset
 304                                        + TYPE_FIELD_BITPOS (type,
 305                                                             VTBL_FNADDR_OFFSET) / 8,
 306                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type,
 307                                                                      VTBL_FNADDR_OFFSET)),
 308                                        byte_order),
 309              stream, demangle);
 310         }
 311       else
 312         {
 313           if (is_pascal_string_type (type, &length_pos, &length_size,
 314                                      &string_pos, &char_type, NULL))
 315             {
 316               len = extract_unsigned_integer (valaddr + embedded_offset
 317                                               + length_pos, length_size,
 318                                               byte_order);
 319               LA_PRINT_STRING (stream, char_type,
 320                                valaddr + embedded_offset + string_pos,
 321                                len, NULL, 0, options);
 322             }
 323           else
 324             pascal_object_print_value_fields (type, valaddr, embedded_offset,
 325                                               address, stream, recurse,
 326                                               original_value, options,
 327                                               NULL, 0);
 328         }
 329       break;
 330
 331     case TYPE_CODE_ENUM:
 332       if (options->format)
 333         {
 334           val_print_scalar_formatted (type, valaddr, embedded_offset,
 335                                       original_value, options, 0, stream);
 336           break;
 337         }
 338       len = TYPE_NFIELDS (type);
 339       val = unpack_long (type, valaddr + embedded_offset);
 340       for (i = 0; i < len; i++)
 341         {
 342           QUIT;
 343           if (val == TYPE_FIELD_BITPOS (type, i))
 344             {
 345               break;
 346             }
 347         }
 348       if (i < len)
 349         {
 350           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 351         }
 352       else
 353         {
 354           print_longest (stream, 'd', 0, val);
 355         }
 356       break;
 357
 358     case TYPE_CODE_FLAGS:
 359       if (options->format)
 360         val_print_scalar_formatted (type, valaddr, embedded_offset,
 361                                     original_value, options, 0, stream);
 362       else
 363         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
 364       break;
 365
 366     case TYPE_CODE_FUNC:
 367       if (options->format)
 368         {
 369           val_print_scalar_formatted (type, valaddr, embedded_offset,
 370                                       original_value, options, 0, stream);
 371           break;
 372         }
 373       /* FIXME, we should consider, at least for ANSI C language, eliminating
 374          the distinction made between FUNCs and POINTERs to FUNCs.  */
 375       fprintf_filtered (stream, "{");
 376       type_print (type, "", stream, -1);
 377       fprintf_filtered (stream, "} ");
 378       /* Try to print what function it points to, and its address.  */
 379       print_address_demangle (gdbarch, address, stream, demangle);
 380       break;
 381
 382     case TYPE_CODE_BOOL:
 383       if (options->format || options->output_format)
 384         {
 385           struct value_print_options opts = *options;
 386
 387           opts.format = (options->format ? options->format
 388                          : options->output_format);
 389           val_print_scalar_formatted (type, valaddr, embedded_offset,
 390                                       original_value, &opts, 0, stream);
 391         }
 392       else
 393         {
 394           val = unpack_long (type, valaddr + embedded_offset);
 395           if (val == 0)
 396             fputs_filtered ("false", stream);
 397           else if (val == 1)
 398             fputs_filtered ("true", stream);
 399           else
 400             {
 401               fputs_filtered ("true (", stream);
 402               fprintf_filtered (stream, "%ld)", (long int) val);
 403             }
 404         }
 405       break;
 406
 407     case TYPE_CODE_RANGE:
 408       /* FIXME: create_range_type does not set the unsigned bit in a
 409          range type (I think it probably should copy it from the target
 410          type), so we won't print values which are too large to
 411          fit in a signed integer correctly.  */
 412       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
 413          print with the target type, though, because the size of our type
 414          and the target type might differ).  */
 415       /* FALLTHROUGH */
 416
 417     case TYPE_CODE_INT:
 418       if (options->format || options->output_format)
 419         {
 420           struct value_print_options opts = *options;
 421
 422           opts.format = (options->format ? options->format
 423                          : options->output_format);
 424           val_print_scalar_formatted (type, valaddr, embedded_offset,
 425                                       original_value, &opts, 0, stream);
 426         }
 427       else
 428         {
 429           val_print_type_code_int (type, valaddr + embedded_offset, stream);
 430         }
 431       break;
 432
 433     case TYPE_CODE_CHAR:
 434       if (options->format || options->output_format)
 435         {
 436           struct value_print_options opts = *options;
 437
 438           opts.format = (options->format ? options->format
 439                          : options->output_format);
 440           val_print_scalar_formatted (type, valaddr, embedded_offset,
 441                                       original_value, &opts, 0, stream);
 442         }
 443       else
 444         {
 445           val = unpack_long (type, valaddr + embedded_offset);
 446           if (TYPE_UNSIGNED (type))
 447             fprintf_filtered (stream, "%u", (unsigned int) val);
 448           else
 449             fprintf_filtered (stream, "%d", (int) val);
 450           fputs_filtered (" ", stream);
 451           LA_PRINT_CHAR ((unsigned char) val, type, stream);
 452         }
 453       break;
 454
 455     case TYPE_CODE_FLT:
 456       if (options->format)
 457         {
 458           val_print_scalar_formatted (type, valaddr, embedded_offset,
 459                                       original_value, options, 0, stream);
 460         }
 461       else
 462         {
 463           print_floating (valaddr + embedded_offset, type, stream);
 464         }
 465       break;
 466
 467     case TYPE_CODE_BITSTRING:
 468     case TYPE_CODE_SET:
 469       elttype = TYPE_INDEX_TYPE (type);
 470       CHECK_TYPEDEF (elttype);
 471       if (TYPE_STUB (elttype))
 472         {
 473           fprintf_filtered (stream, "<incomplete type>");
 474           gdb_flush (stream);
 475           break;
 476         }
 477       else
 478         {
 479           struct type *range = elttype;
 480           LONGEST low_bound, high_bound;
 481           int i;
 482           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
 483           int need_comma = 0;
 484
 485           if (is_bitstring)
 486             fputs_filtered ("B'", stream);
 487           else
 488             fputs_filtered ("[", stream);
 489
 490           i = get_discrete_bounds (range, &low_bound, &high_bound);
 491           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
 492             {
 493               /* If we know the size of the set type, we can figure out the
 494               maximum value.  */
 495               i = 0;
 496               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
 497               TYPE_HIGH_BOUND (range) = high_bound;
 498             }
 499         maybe_bad_bstring:
 500           if (i < 0)
 501             {
 502               fputs_filtered ("<error value>", stream);
 503               goto done;
 504             }
 505
 506           for (i = low_bound; i <= high_bound; i++)
 507             {
 508               int element = value_bit_index (type,
 509                                              valaddr + embedded_offset, i);
 510
 511               if (element < 0)
 512                 {
 513                   i = element;
 514                   goto maybe_bad_bstring;
 515                 }
 516               if (is_bitstring)
 517                 fprintf_filtered (stream, "%d", element);
 518               else if (element)
 519                 {
 520                   if (need_comma)
 521                     fputs_filtered (", ", stream);
 522                   print_type_scalar (range, i, stream);
 523                   need_comma = 1;
 524
 525                   if (i + 1 <= high_bound
 526                       && value_bit_index (type,
 527                                           valaddr + embedded_offset, ++i))
 528                     {
 529                       int j = i;
 530
 531                       fputs_filtered ("..", stream);
 532                       while (i + 1 <= high_bound
 533                              && value_bit_index (type,
 534                                                  valaddr + embedded_offset,
 535                                                  ++i))
 536                         j = i;
 537                       print_type_scalar (range, j, stream);
 538                     }
 539                 }
 540             }
 541         done:
 542           if (is_bitstring)
 543             fputs_filtered ("'", stream);
 544           else
 545             fputs_filtered ("]", stream);
 546         }
 547       break;
 548
 549     case TYPE_CODE_VOID:
 550       fprintf_filtered (stream, "void");
 551       break;
 552
 553     case TYPE_CODE_ERROR:
 554       fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
 555       break;
 556
 557     case TYPE_CODE_UNDEF:
 558       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 559          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 560          and no complete type for struct foo in that file.  */
 561       fprintf_filtered (stream, "<incomplete type>");
 562       break;
 563
 564     default:
 565       error (_("Invalid pascal type code %d in symbol table."),
 566              TYPE_CODE (type));
 567     }
 568   gdb_flush (stream);
 569   return (0);
 570 }
 571 \f
 572 int
 573 pascal_value_print (struct value *val, struct ui_file *stream,
 574                     const struct value_print_options *options)
 575 {
 576   struct type *type = value_type (val);
 577   struct value_print_options opts = *options;
 578
 579   opts.deref_ref = 1;
 580
 581   /* If it is a pointer, indicate what it points to.
 582
 583      Print type also if it is a reference.
 584
 585      Object pascal: if it is a member pointer, we will take care
 586      of that when we print it.  */
 587   if (TYPE_CODE (type) == TYPE_CODE_PTR
 588       || TYPE_CODE (type) == TYPE_CODE_REF)
 589     {
 590       /* Hack:  remove (char *) for char strings.  Their
 591          type is indicated by the quoted string anyway.  */
 592       if (TYPE_CODE (type) == TYPE_CODE_PTR
 593           && TYPE_NAME (type) == NULL
 594           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 595           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 596         {
 597           /* Print nothing.  */
 598         }
 599       else
 600         {
 601           fprintf_filtered (stream, "(");
 602           type_print (type, "", stream, -1);
 603           fprintf_filtered (stream, ") ");
 604         }
 605     }
 606   return common_val_print (val, stream, 0, &opts, current_language);
 607 }
 608
 609
 610 static void
 611 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 612                                 struct cmd_list_element *c, const char *value)
 613 {
 614   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 615                     value);
 616 }
 617
 618 static struct obstack dont_print_vb_obstack;
 619 static struct obstack dont_print_statmem_obstack;
 620
 621 static void pascal_object_print_static_field (struct value *,
 622                                               struct ui_file *, int,
 623                                               const struct value_print_options *);
 624
 625 static void pascal_object_print_value (struct type *, const gdb_byte *,
 626                                        int,
 627                                        CORE_ADDR, struct ui_file *, int,
 628                                        const struct value *,
 629                                        const struct value_print_options *,
 630                                        struct type **);
 631
 632 /* It was changed to this after 2.4.5.  */
 633 const char pascal_vtbl_ptr_name[] =
 634 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 635
 636 /* Return truth value for assertion that TYPE is of the type
 637    "pointer to virtual function".  */
 638
 639 int
 640 pascal_object_is_vtbl_ptr_type (struct type *type)
 641 {
 642   char *typename = type_name_no_tag (type);
 643
 644   return (typename != NULL
 645           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 646 }
 647
 648 /* Return truth value for the assertion that TYPE is of the type
 649    "pointer to virtual function table".  */
 650
 651 int
 652 pascal_object_is_vtbl_member (struct type *type)
 653 {
 654   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 655     {
 656       type = TYPE_TARGET_TYPE (type);
 657       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 658         {
 659           type = TYPE_TARGET_TYPE (type);
 660           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* If not using
 661                                                            thunks.  */
 662               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* If using thunks.  */
 663             {
 664               /* Virtual functions tables are full of pointers
 665                  to virtual functions.  */
 666               return pascal_object_is_vtbl_ptr_type (type);
 667             }
 668         }
 669     }
 670   return 0;
 671 }
 672
 673 /* Mutually recursive subroutines of pascal_object_print_value and
 674    c_val_print to print out a structure's fields:
 675    pascal_object_print_value_fields and pascal_object_print_value.
 676
 677    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
 678    same meanings as in pascal_object_print_value and c_val_print.
 679
 680    DONT_PRINT is an array of baseclass types that we
 681    should not print, or zero if called from top level.  */
 682
 683 void
 684 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 685                                   int offset,
 686                                   CORE_ADDR address, struct ui_file *stream,
 687                                   int recurse,
 688                                   const struct value *val,
 689                                   const struct value_print_options *options,
 690                                   struct type **dont_print_vb,
 691                                   int dont_print_statmem)
 692 {
 693   int i, len, n_baseclasses;
 694   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 695
 696   CHECK_TYPEDEF (type);
 697
 698   fprintf_filtered (stream, "{");
 699   len = TYPE_NFIELDS (type);
 700   n_baseclasses = TYPE_N_BASECLASSES (type);
 701
 702   /* Print out baseclasses such that we don't print
 703      duplicates of virtual baseclasses.  */
 704   if (n_baseclasses > 0)
 705     pascal_object_print_value (type, valaddr, offset, address,
 706                                stream, recurse + 1, val,
 707                                options, dont_print_vb);
 708
 709   if (!len && n_baseclasses == 1)
 710     fprintf_filtered (stream, "<No data fields>");
 711   else
 712     {
 713       struct obstack tmp_obstack = dont_print_statmem_obstack;
 714       int fields_seen = 0;
 715
 716       if (dont_print_statmem == 0)
 717         {
 718           /* If we're at top level, carve out a completely fresh
 719              chunk of the obstack and use that until this particular
 720              invocation returns.  */
 721           obstack_finish (&dont_print_statmem_obstack);
 722         }
 723
 724       for (i = n_baseclasses; i < len; i++)
 725         {
 726           /* If requested, skip printing of static fields.  */
 727           if (!options->pascal_static_field_print
 728               && field_is_static (&TYPE_FIELD (type, i)))
 729             continue;
 730           if (fields_seen)
 731             fprintf_filtered (stream, ", ");
 732           else if (n_baseclasses > 0)
 733             {
 734               if (options->pretty)
 735                 {
 736                   fprintf_filtered (stream, "\n");
 737                   print_spaces_filtered (2 + 2 * recurse, stream);
 738                   fputs_filtered ("members of ", stream);
 739                   fputs_filtered (type_name_no_tag (type), stream);
 740                   fputs_filtered (": ", stream);
 741                 }
 742             }
 743           fields_seen = 1;
 744
 745           if (options->pretty)
 746             {
 747               fprintf_filtered (stream, "\n");
 748               print_spaces_filtered (2 + 2 * recurse, stream);
 749             }
 750           else
 751             {
 752               wrap_here (n_spaces (2 + 2 * recurse));
 753             }
 754           if (options->inspect_it)
 755             {
 756               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 757                 fputs_filtered ("\"( ptr \"", stream);
 758               else
 759                 fputs_filtered ("\"( nodef \"", stream);
 760               if (field_is_static (&TYPE_FIELD (type, i)))
 761                 fputs_filtered ("static ", stream);
 762               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 763                                        language_cplus,
 764                                        DMGL_PARAMS | DMGL_ANSI);
 765               fputs_filtered ("\" \"", stream);
 766               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 767                                        language_cplus,
 768                                        DMGL_PARAMS | DMGL_ANSI);
 769               fputs_filtered ("\") \"", stream);
 770             }
 771           else
 772             {
 773               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 774
 775               if (field_is_static (&TYPE_FIELD (type, i)))
 776                 fputs_filtered ("static ", stream);
 777               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 778                                        language_cplus,
 779                                        DMGL_PARAMS | DMGL_ANSI);
 780               annotate_field_name_end ();
 781               fputs_filtered (" = ", stream);
 782               annotate_field_value ();
 783             }
 784
 785           if (!field_is_static (&TYPE_FIELD (type, i))
 786               && TYPE_FIELD_PACKED (type, i))
 787             {
 788               struct value *v;
 789
 790               /* Bitfields require special handling, especially due to byte
 791                  order problems.  */
 792               if (TYPE_FIELD_IGNORE (type, i))
 793                 {
 794                   fputs_filtered ("<optimized out or zero length>", stream);
 795                 }
 796               else if (value_bits_synthetic_pointer (val,
 797                                                      TYPE_FIELD_BITPOS (type,
 798                                                                         i),
 799                                                      TYPE_FIELD_BITSIZE (type,
 800                                                                          i)))
 801                 {
 802                   fputs_filtered (_("<synthetic pointer>"), stream);
 803                 }
 804               else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i),
 805                                           TYPE_FIELD_BITSIZE (type, i)))
 806                 {
 807                   val_print_optimized_out (stream);
 808                 }
 809               else
 810                 {
 811                   struct value_print_options opts = *options;
 812
 813                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 814                                    unpack_field_as_long (type,
 815                                                          valaddr + offset, i));
 816
 817                   opts.deref_ref = 0;
 818                   common_val_print (v, stream, recurse + 1, &opts,
 819                                     current_language);
 820                 }
 821             }
 822           else
 823             {
 824               if (TYPE_FIELD_IGNORE (type, i))
 825                 {
 826                   fputs_filtered ("<optimized out or zero length>", stream);
 827                 }
 828               else if (field_is_static (&TYPE_FIELD (type, i)))
 829                 {
 830                   /* struct value *v = value_static_field (type, i);
 831                      v4.17 specific.  */
 832                   struct value *v;
 833
 834                   v = value_from_longest
 835                     (TYPE_FIELD_TYPE (type, i),
 836                      unpack_field_as_long (type, valaddr + offset, i));
 837
 838                   if (v == NULL)
 839                     val_print_optimized_out (stream);
 840                   else
 841                     pascal_object_print_static_field (v, stream, recurse + 1,
 842                                                       options);
 843                 }
 844               else
 845                 {
 846                   struct value_print_options opts = *options;
 847
 848                   opts.deref_ref = 0;
 849                   /* val_print (TYPE_FIELD_TYPE (type, i),
 850                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 851                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 852                      stream, format, 0, recurse + 1, pretty); */
 853                   val_print (TYPE_FIELD_TYPE (type, i),
 854                              valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
 855                              address, stream, recurse + 1, val, &opts,
 856                              current_language);
 857                 }
 858             }
 859           annotate_field_end ();
 860         }
 861
 862       if (dont_print_statmem == 0)
 863         {
 864           /* Free the space used to deal with the printing
 865              of the members from top level.  */
 866           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 867           dont_print_statmem_obstack = tmp_obstack;
 868         }
 869
 870       if (options->pretty)
 871         {
 872           fprintf_filtered (stream, "\n");
 873           print_spaces_filtered (2 * recurse, stream);
 874         }
 875     }
 876   fprintf_filtered (stream, "}");
 877 }
 878
 879 /* Special val_print routine to avoid printing multiple copies of virtual
 880    baseclasses.  */
 881
 882 static void
 883 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 884                            int offset,
 885                            CORE_ADDR address, struct ui_file *stream,
 886                            int recurse,
 887                            const struct value *val,
 888                            const struct value_print_options *options,
 889                            struct type **dont_print_vb)
 890 {
 891   struct type **last_dont_print
 892     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 893   struct obstack tmp_obstack = dont_print_vb_obstack;
 894   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 895
 896   if (dont_print_vb == 0)
 897     {
 898       /* If we're at top level, carve out a completely fresh
 899          chunk of the obstack and use that until this particular
 900          invocation returns.  */
 901       /* Bump up the high-water mark.  Now alpha is omega.  */
 902       obstack_finish (&dont_print_vb_obstack);
 903     }
 904
 905   for (i = 0; i < n_baseclasses; i++)
 906     {
 907       int boffset;
 908       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 909       char *basename = type_name_no_tag (baseclass);
 910       const gdb_byte *base_valaddr;
 911       int thisoffset;
 912
 913       if (BASETYPE_VIA_VIRTUAL (type, i))
 914         {
 915           struct type **first_dont_print
 916             = (struct type **) obstack_base (&dont_print_vb_obstack);
 917
 918           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 919             - first_dont_print;
 920
 921           while (--j >= 0)
 922             if (baseclass == first_dont_print[j])
 923               goto flush_it;
 924
 925           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 926         }
 927
 928       thisoffset = offset;
 929
 930       boffset = baseclass_offset (type, i, valaddr + offset, address + offset);
 931
 932       if (options->pretty)
 933         {
 934           fprintf_filtered (stream, "\n");
 935           print_spaces_filtered (2 * recurse, stream);
 936         }
 937       fputs_filtered ("<", stream);
 938       /* Not sure what the best notation is in the case where there is no
 939          baseclass name.  */
 940
 941       fputs_filtered (basename ? basename : "", stream);
 942       fputs_filtered ("> = ", stream);
 943
 944       /* The virtual base class pointer might have been clobbered by the
 945          user program.  Make sure that it still points to a valid memory
 946          location.  */
 947
 948       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 949         {
 950           /* FIXME (alloc): not safe is baseclass is really really big.  */
 951           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 952
 953           base_valaddr = buf;
 954           if (target_read_memory (address + boffset, buf,
 955                                   TYPE_LENGTH (baseclass)) != 0)
 956             boffset = -1;
 957           address = address + boffset;
 958           thisoffset = 0;
 959           boffset = 0;
 960         }
 961       else
 962         base_valaddr = valaddr;
 963
 964       if (boffset == -1)
 965         fprintf_filtered (stream, "<invalid address>");
 966       else
 967         pascal_object_print_value_fields (baseclass, base_valaddr,
 968                                           thisoffset + boffset, address,
 969                                           stream, recurse, val, options,
 970                      (struct type **) obstack_base (&dont_print_vb_obstack),
 971                                           0);
 972       fputs_filtered (", ", stream);
 973
 974     flush_it:
 975       ;
 976     }
 977
 978   if (dont_print_vb == 0)
 979     {
 980       /* Free the space used to deal with the printing
 981          of this type from top level.  */
 982       obstack_free (&dont_print_vb_obstack, last_dont_print);
 983       /* Reset watermark so that we can continue protecting
 984          ourselves from whatever we were protecting ourselves.  */
 985       dont_print_vb_obstack = tmp_obstack;
 986     }
 987 }
 988
 989 /* Print value of a static member.
 990    To avoid infinite recursion when printing a class that contains
 991    a static instance of the class, we keep the addresses of all printed
 992    static member classes in an obstack and refuse to print them more
 993    than once.
 994
 995    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 996    have the same meanings as in c_val_print.  */
 997
 998 static void
 999 pascal_object_print_static_field (struct value *val,
1000                                   struct ui_file *stream,
1001                                   int recurse,
1002                                   const struct value_print_options *options)
1003 {
1004   struct type *type = value_type (val);
1005   struct value_print_options opts;
1006
1007   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
1008     {
1009       CORE_ADDR *first_dont_print, addr;
1010       int i;
1011
1012       first_dont_print
1013         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
1014       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
1015         - first_dont_print;
1016
1017       while (--i >= 0)
1018         {
1019           if (value_address (val) == first_dont_print[i])
1020             {
1021               fputs_filtered ("\
1022 <same as static member of an already seen type>",
1023                               stream);
1024               return;
1025             }
1026         }
1027
1028       addr = value_address (val);
1029       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
1030                     sizeof (CORE_ADDR));
1031
1032       CHECK_TYPEDEF (type);
1033       pascal_object_print_value_fields (type,
1034                                         value_contents_for_printing (val),
1035                                         value_embedded_offset (val),
1036                                         addr,
1037                                         stream, recurse,
1038                                         val, options, NULL, 1);
1039       return;
1040     }
1041
1042   opts = *options;
1043   opts.deref_ref = 0;
1044   common_val_print (val, stream, recurse, &opts, current_language);
1045 }
1046
1047 /* -Wmissing-prototypes */
1048 extern initialize_file_ftype _initialize_pascal_valprint;
1049
1050 void
1051 _initialize_pascal_valprint (void)
1052 {
1053   add_setshow_boolean_cmd ("pascal_static-members", class_support,
1054                            &user_print_options.pascal_static_field_print, _("\
1055 Set printing of pascal static members."), _("\
1056 Show printing of pascal static members."), NULL,
1057                            NULL,
1058                            show_pascal_static_field_print,
1059                            &setprintlist, &showprintlist);
1060 }