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_field_bitfield (type, i, valaddr, offset, val);
 814
 815                   opts.deref_ref = 0;
 816                   common_val_print (v, stream, recurse + 1, &opts,
 817                                     current_language);
 818                 }
 819             }
 820           else
 821             {
 822               if (TYPE_FIELD_IGNORE (type, i))
 823                 {
 824                   fputs_filtered ("<optimized out or zero length>", stream);
 825                 }
 826               else if (field_is_static (&TYPE_FIELD (type, i)))
 827                 {
 828                   /* struct value *v = value_static_field (type, i);
 829                      v4.17 specific.  */
 830                   struct value *v;
 831
 832                   v = value_field_bitfield (type, i, valaddr, offset, val);
 833
 834                   if (v == NULL)
 835                     val_print_optimized_out (stream);
 836                   else
 837                     pascal_object_print_static_field (v, stream, recurse + 1,
 838                                                       options);
 839                 }
 840               else
 841                 {
 842                   struct value_print_options opts = *options;
 843
 844                   opts.deref_ref = 0;
 845                   /* val_print (TYPE_FIELD_TYPE (type, i),
 846                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 847                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 848                      stream, format, 0, recurse + 1, pretty); */
 849                   val_print (TYPE_FIELD_TYPE (type, i),
 850                              valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
 851                              address, stream, recurse + 1, val, &opts,
 852                              current_language);
 853                 }
 854             }
 855           annotate_field_end ();
 856         }
 857
 858       if (dont_print_statmem == 0)
 859         {
 860           /* Free the space used to deal with the printing
 861              of the members from top level.  */
 862           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 863           dont_print_statmem_obstack = tmp_obstack;
 864         }
 865
 866       if (options->pretty)
 867         {
 868           fprintf_filtered (stream, "\n");
 869           print_spaces_filtered (2 * recurse, stream);
 870         }
 871     }
 872   fprintf_filtered (stream, "}");
 873 }
 874
 875 /* Special val_print routine to avoid printing multiple copies of virtual
 876    baseclasses.  */
 877
 878 static void
 879 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 880                            int offset,
 881                            CORE_ADDR address, struct ui_file *stream,
 882                            int recurse,
 883                            const struct value *val,
 884                            const struct value_print_options *options,
 885                            struct type **dont_print_vb)
 886 {
 887   struct type **last_dont_print
 888     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 889   struct obstack tmp_obstack = dont_print_vb_obstack;
 890   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 891
 892   if (dont_print_vb == 0)
 893     {
 894       /* If we're at top level, carve out a completely fresh
 895          chunk of the obstack and use that until this particular
 896          invocation returns.  */
 897       /* Bump up the high-water mark.  Now alpha is omega.  */
 898       obstack_finish (&dont_print_vb_obstack);
 899     }
 900
 901   for (i = 0; i < n_baseclasses; i++)
 902     {
 903       int boffset;
 904       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 905       char *basename = type_name_no_tag (baseclass);
 906       const gdb_byte *base_valaddr;
 907       int thisoffset;
 908
 909       if (BASETYPE_VIA_VIRTUAL (type, i))
 910         {
 911           struct type **first_dont_print
 912             = (struct type **) obstack_base (&dont_print_vb_obstack);
 913
 914           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 915             - first_dont_print;
 916
 917           while (--j >= 0)
 918             if (baseclass == first_dont_print[j])
 919               goto flush_it;
 920
 921           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 922         }
 923
 924       thisoffset = offset;
 925
 926       boffset = baseclass_offset (type, i, valaddr + offset, address + offset);
 927
 928       if (options->pretty)
 929         {
 930           fprintf_filtered (stream, "\n");
 931           print_spaces_filtered (2 * recurse, stream);
 932         }
 933       fputs_filtered ("<", stream);
 934       /* Not sure what the best notation is in the case where there is no
 935          baseclass name.  */
 936
 937       fputs_filtered (basename ? basename : "", stream);
 938       fputs_filtered ("> = ", stream);
 939
 940       /* The virtual base class pointer might have been clobbered by the
 941          user program.  Make sure that it still points to a valid memory
 942          location.  */
 943
 944       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 945         {
 946           /* FIXME (alloc): not safe is baseclass is really really big.  */
 947           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 948
 949           base_valaddr = buf;
 950           if (target_read_memory (address + boffset, buf,
 951                                   TYPE_LENGTH (baseclass)) != 0)
 952             boffset = -1;
 953           address = address + boffset;
 954           thisoffset = 0;
 955           boffset = 0;
 956         }
 957       else
 958         base_valaddr = valaddr;
 959
 960       if (boffset == -1)
 961         fprintf_filtered (stream, "<invalid address>");
 962       else
 963         pascal_object_print_value_fields (baseclass, base_valaddr,
 964                                           thisoffset + boffset, address,
 965                                           stream, recurse, val, options,
 966                      (struct type **) obstack_base (&dont_print_vb_obstack),
 967                                           0);
 968       fputs_filtered (", ", stream);
 969
 970     flush_it:
 971       ;
 972     }
 973
 974   if (dont_print_vb == 0)
 975     {
 976       /* Free the space used to deal with the printing
 977          of this type from top level.  */
 978       obstack_free (&dont_print_vb_obstack, last_dont_print);
 979       /* Reset watermark so that we can continue protecting
 980          ourselves from whatever we were protecting ourselves.  */
 981       dont_print_vb_obstack = tmp_obstack;
 982     }
 983 }
 984
 985 /* Print value of a static member.
 986    To avoid infinite recursion when printing a class that contains
 987    a static instance of the class, we keep the addresses of all printed
 988    static member classes in an obstack and refuse to print them more
 989    than once.
 990
 991    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
 992    have the same meanings as in c_val_print.  */
 993
 994 static void
 995 pascal_object_print_static_field (struct value *val,
 996                                   struct ui_file *stream,
 997                                   int recurse,
 998                                   const struct value_print_options *options)
 999 {
1000   struct type *type = value_type (val);
1001   struct value_print_options opts;
1002
1003   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
1004     {
1005       CORE_ADDR *first_dont_print, addr;
1006       int i;
1007
1008       first_dont_print
1009         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
1010       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
1011         - first_dont_print;
1012
1013       while (--i >= 0)
1014         {
1015           if (value_address (val) == first_dont_print[i])
1016             {
1017               fputs_filtered ("\
1018 <same as static member of an already seen type>",
1019                               stream);
1020               return;
1021             }
1022         }
1023
1024       addr = value_address (val);
1025       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
1026                     sizeof (CORE_ADDR));
1027
1028       CHECK_TYPEDEF (type);
1029       pascal_object_print_value_fields (type,
1030                                         value_contents_for_printing (val),
1031                                         value_embedded_offset (val),
1032                                         addr,
1033                                         stream, recurse,
1034                                         val, options, NULL, 1);
1035       return;
1036     }
1037
1038   opts = *options;
1039   opts.deref_ref = 0;
1040   common_val_print (val, stream, recurse, &opts, current_language);
1041 }
1042
1043 /* -Wmissing-prototypes */
1044 extern initialize_file_ftype _initialize_pascal_valprint;
1045
1046 void
1047 _initialize_pascal_valprint (void)
1048 {
1049   add_setshow_boolean_cmd ("pascal_static-members", class_support,
1050                            &user_print_options.pascal_static_field_print, _("\
1051 Set printing of pascal static members."), _("\
1052 Show printing of pascal static members."), NULL,
1053                            NULL,
1054                            show_pascal_static_field_print,
1055                            &setprintlist, &showprintlist);
1056 }