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