gdb/p-valprint.c

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