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               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           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
 584 static struct obstack dont_print_vb_obstack;
 585 static struct obstack dont_print_statmem_obstack;
 586
 587 static void pascal_object_print_static_field (struct type *, struct value *,
 588                                               struct ui_file *, int, int,
 589                                               enum val_prettyprint);
 590
 591 static void pascal_object_print_value (struct type *, const bfd_byte *,
 592                                        CORE_ADDR, struct ui_file *,
 593                                        int, int, enum val_prettyprint,
 594                                        struct type **);
 595
 596 void
 597 pascal_object_print_class_method (const bfd_byte *valaddr, struct type *type,
 598                                   struct ui_file *stream)
 599 {
 600   struct type *domain;
 601   struct fn_field *f = NULL;
 602   int j = 0;
 603   int len2;
 604   int offset;
 605   char *kind = "";
 606   CORE_ADDR addr;
 607   struct symbol *sym;
 608   unsigned len;
 609   unsigned int i;
 610   struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
 611
 612   domain = TYPE_DOMAIN_TYPE (target_type);
 613   if (domain == (struct type *) NULL)
 614     {
 615       fprintf_filtered (stream, "<unknown>");
 616       return;
 617     }
 618   addr = unpack_pointer (lookup_pointer_type (builtin_type_void), valaddr);
 619   if (METHOD_PTR_IS_VIRTUAL (addr))
 620     {
 621       offset = METHOD_PTR_TO_VOFFSET (addr);
 622       len = TYPE_NFN_FIELDS (domain);
 623       for (i = 0; i < len; i++)
 624         {
 625           f = TYPE_FN_FIELDLIST1 (domain, i);
 626           len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
 627
 628           check_stub_method_group (domain, i);
 629           for (j = 0; j < len2; j++)
 630             {
 631               if (TYPE_FN_FIELD_VOFFSET (f, j) == offset)
 632                 {
 633                   kind = "virtual ";
 634                   goto common;
 635                 }
 636             }
 637         }
 638     }
 639   else
 640     {
 641       sym = find_pc_function (addr);
 642       if (sym == 0)
 643         {
 644           error ("invalid pointer to member function");
 645         }
 646       len = TYPE_NFN_FIELDS (domain);
 647       for (i = 0; i < len; i++)
 648         {
 649           f = TYPE_FN_FIELDLIST1 (domain, i);
 650           len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
 651
 652           check_stub_method_group (domain, i);
 653           for (j = 0; j < len2; j++)
 654             {
 655               if (DEPRECATED_STREQ (DEPRECATED_SYMBOL_NAME (sym), TYPE_FN_FIELD_PHYSNAME (f, j)))
 656                 goto common;
 657             }
 658         }
 659     }
 660 common:
 661   if (i < len)
 662     {
 663       char *demangled_name;
 664
 665       fprintf_filtered (stream, "&");
 666       fputs_filtered (kind, stream);
 667       demangled_name = cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f, j),
 668                                        DMGL_ANSI | DMGL_PARAMS);
 669       if (demangled_name == NULL)
 670         fprintf_filtered (stream, "<badly mangled name %s>",
 671                           TYPE_FN_FIELD_PHYSNAME (f, j));
 672       else
 673         {
 674           fputs_filtered (demangled_name, stream);
 675           xfree (demangled_name);
 676         }
 677     }
 678   else
 679     {
 680       fprintf_filtered (stream, "(");
 681       type_print (type, "", stream, -1);
 682       fprintf_filtered (stream, ") %d", (int) addr >> 3);
 683     }
 684 }
 685
 686 /* It was changed to this after 2.4.5.  */
 687 const char pascal_vtbl_ptr_name[] =
 688 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 689
 690 /* Return truth value for assertion that TYPE is of the type
 691    "pointer to virtual function".  */
 692
 693 int
 694 pascal_object_is_vtbl_ptr_type (struct type *type)
 695 {
 696   char *typename = type_name_no_tag (type);
 697
 698   return (typename != NULL
 699           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 700 }
 701
 702 /* Return truth value for the assertion that TYPE is of the type
 703    "pointer to virtual function table".  */
 704
 705 int
 706 pascal_object_is_vtbl_member (struct type *type)
 707 {
 708   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 709     {
 710       type = TYPE_TARGET_TYPE (type);
 711       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 712         {
 713           type = TYPE_TARGET_TYPE (type);
 714           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
 715               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
 716             {
 717               /* Virtual functions tables are full of pointers
 718                  to virtual functions. */
 719               return pascal_object_is_vtbl_ptr_type (type);
 720             }
 721         }
 722     }
 723   return 0;
 724 }
 725
 726 /* Mutually recursive subroutines of pascal_object_print_value and
 727    c_val_print to print out a structure's fields:
 728    pascal_object_print_value_fields and pascal_object_print_value.
 729
 730    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
 731    same meanings as in pascal_object_print_value and c_val_print.
 732
 733    DONT_PRINT is an array of baseclass types that we
 734    should not print, or zero if called from top level.  */
 735
 736 void
 737 pascal_object_print_value_fields (struct type *type, const bfd_byte *valaddr,
 738                                   CORE_ADDR address, struct ui_file *stream,
 739                                   int format, int recurse,
 740                                   enum val_prettyprint pretty,
 741                                   struct type **dont_print_vb,
 742                                   int dont_print_statmem)
 743 {
 744   int i, len, n_baseclasses;
 745   struct obstack tmp_obstack;
 746   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 747
 748   CHECK_TYPEDEF (type);
 749
 750   fprintf_filtered (stream, "{");
 751   len = TYPE_NFIELDS (type);
 752   n_baseclasses = TYPE_N_BASECLASSES (type);
 753
 754   /* Print out baseclasses such that we don't print
 755      duplicates of virtual baseclasses.  */
 756   if (n_baseclasses > 0)
 757     pascal_object_print_value (type, valaddr, address, stream,
 758                                format, recurse + 1, pretty, dont_print_vb);
 759
 760   if (!len && n_baseclasses == 1)
 761     fprintf_filtered (stream, "<No data fields>");
 762   else
 763     {
 764       int fields_seen = 0;
 765
 766       if (dont_print_statmem == 0)
 767         {
 768           /* If we're at top level, carve out a completely fresh
 769              chunk of the obstack and use that until this particular
 770              invocation returns.  */
 771           tmp_obstack = dont_print_statmem_obstack;
 772           obstack_finish (&dont_print_statmem_obstack);
 773         }
 774
 775       for (i = n_baseclasses; i < len; i++)
 776         {
 777           /* If requested, skip printing of static fields.  */
 778           if (!pascal_static_field_print && TYPE_FIELD_STATIC (type, i))
 779             continue;
 780           if (fields_seen)
 781             fprintf_filtered (stream, ", ");
 782           else if (n_baseclasses > 0)
 783             {
 784               if (pretty)
 785                 {
 786                   fprintf_filtered (stream, "\n");
 787                   print_spaces_filtered (2 + 2 * recurse, stream);
 788                   fputs_filtered ("members of ", stream);
 789                   fputs_filtered (type_name_no_tag (type), stream);
 790                   fputs_filtered (": ", stream);
 791                 }
 792             }
 793           fields_seen = 1;
 794
 795           if (pretty)
 796             {
 797               fprintf_filtered (stream, "\n");
 798               print_spaces_filtered (2 + 2 * recurse, stream);
 799             }
 800           else
 801             {
 802               wrap_here (n_spaces (2 + 2 * recurse));
 803             }
 804           if (inspect_it)
 805             {
 806               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 807                 fputs_filtered ("\"( ptr \"", stream);
 808               else
 809                 fputs_filtered ("\"( nodef \"", stream);
 810               if (TYPE_FIELD_STATIC (type, i))
 811                 fputs_filtered ("static ", stream);
 812               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 813                                        language_cplus,
 814                                        DMGL_PARAMS | DMGL_ANSI);
 815               fputs_filtered ("\" \"", stream);
 816               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 817                                        language_cplus,
 818                                        DMGL_PARAMS | DMGL_ANSI);
 819               fputs_filtered ("\") \"", stream);
 820             }
 821           else
 822             {
 823               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 824
 825               if (TYPE_FIELD_STATIC (type, i))
 826                 fputs_filtered ("static ", stream);
 827               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 828                                        language_cplus,
 829                                        DMGL_PARAMS | DMGL_ANSI);
 830               annotate_field_name_end ();
 831               fputs_filtered (" = ", stream);
 832               annotate_field_value ();
 833             }
 834
 835           if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i))
 836             {
 837               struct value *v;
 838
 839               /* Bitfields require special handling, especially due to byte
 840                  order problems.  */
 841               if (TYPE_FIELD_IGNORE (type, i))
 842                 {
 843                   fputs_filtered ("<optimized out or zero length>", stream);
 844                 }
 845               else
 846                 {
 847                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 848                                    unpack_field_as_long (type, valaddr, i));
 849
 850                   val_print (TYPE_FIELD_TYPE (type, i), value_contents (v), 0, 0,
 851                              stream, format, 0, recurse + 1, pretty);
 852                 }
 853             }
 854           else
 855             {
 856               if (TYPE_FIELD_IGNORE (type, i))
 857                 {
 858                   fputs_filtered ("<optimized out or zero length>", stream);
 859                 }
 860               else if (TYPE_FIELD_STATIC (type, i))
 861                 {
 862                   /* struct value *v = value_static_field (type, i); v4.17 specific */
 863                   struct value *v;
 864                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 865                                    unpack_field_as_long (type, valaddr, i));
 866
 867                   if (v == NULL)
 868                     fputs_filtered ("<optimized out>", stream);
 869                   else
 870                     pascal_object_print_static_field (TYPE_FIELD_TYPE (type, i), v,
 871                                                 stream, format, recurse + 1,
 872                                                       pretty);
 873                 }
 874               else
 875                 {
 876                   /* val_print (TYPE_FIELD_TYPE (type, i),
 877                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 878                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 879                      stream, format, 0, recurse + 1, pretty); */
 880                   val_print (TYPE_FIELD_TYPE (type, i),
 881                              valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
 882                              address + TYPE_FIELD_BITPOS (type, i) / 8,
 883                              stream, format, 0, recurse + 1, pretty);
 884                 }
 885             }
 886           annotate_field_end ();
 887         }
 888
 889       if (dont_print_statmem == 0)
 890         {
 891           /* Free the space used to deal with the printing
 892              of the members from top level.  */
 893           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 894           dont_print_statmem_obstack = tmp_obstack;
 895         }
 896
 897       if (pretty)
 898         {
 899           fprintf_filtered (stream, "\n");
 900           print_spaces_filtered (2 * recurse, stream);
 901         }
 902     }
 903   fprintf_filtered (stream, "}");
 904 }
 905
 906 /* Special val_print routine to avoid printing multiple copies of virtual
 907    baseclasses.  */
 908
 909 void
 910 pascal_object_print_value (struct type *type, const bfd_byte *valaddr,
 911                            CORE_ADDR address, struct ui_file *stream,
 912                            int format, int recurse,
 913                            enum val_prettyprint pretty,
 914                            struct type **dont_print_vb)
 915 {
 916   struct obstack tmp_obstack;
 917   struct type **last_dont_print
 918   = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 919   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 920
 921   if (dont_print_vb == 0)
 922     {
 923       /* If we're at top level, carve out a completely fresh
 924          chunk of the obstack and use that until this particular
 925          invocation returns.  */
 926       tmp_obstack = dont_print_vb_obstack;
 927       /* Bump up the high-water mark.  Now alpha is omega.  */
 928       obstack_finish (&dont_print_vb_obstack);
 929     }
 930
 931   for (i = 0; i < n_baseclasses; i++)
 932     {
 933       int boffset;
 934       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 935       char *basename = TYPE_NAME (baseclass);
 936       const bfd_byte *base_valaddr;
 937
 938       if (BASETYPE_VIA_VIRTUAL (type, i))
 939         {
 940           struct type **first_dont_print
 941           = (struct type **) obstack_base (&dont_print_vb_obstack);
 942
 943           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 944           - first_dont_print;
 945
 946           while (--j >= 0)
 947             if (baseclass == first_dont_print[j])
 948               goto flush_it;
 949
 950           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 951         }
 952
 953       boffset = baseclass_offset (type, i, valaddr, address);
 954
 955       if (pretty)
 956         {
 957           fprintf_filtered (stream, "\n");
 958           print_spaces_filtered (2 * recurse, stream);
 959         }
 960       fputs_filtered ("<", stream);
 961       /* Not sure what the best notation is in the case where there is no
 962          baseclass name.  */
 963
 964       fputs_filtered (basename ? basename : "", stream);
 965       fputs_filtered ("> = ", stream);
 966
 967       /* The virtual base class pointer might have been clobbered by the
 968          user program. Make sure that it still points to a valid memory
 969          location.  */
 970
 971       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 972         {
 973           /* FIXME (alloc): not safe is baseclass is really really big. */
 974           bfd_byte *buf = alloca (TYPE_LENGTH (baseclass));
 975           base_valaddr = buf;
 976           if (target_read_memory (address + boffset, buf,
 977                                   TYPE_LENGTH (baseclass)) != 0)
 978             boffset = -1;
 979         }
 980       else
 981         base_valaddr = valaddr + boffset;
 982
 983       if (boffset == -1)
 984         fprintf_filtered (stream, "<invalid address>");
 985       else
 986         pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
 987                                           stream, format, recurse, pretty,
 988                      (struct type **) obstack_base (&dont_print_vb_obstack),
 989                                           0);
 990       fputs_filtered (", ", stream);
 991
 992     flush_it:
 993       ;
 994     }
 995
 996   if (dont_print_vb == 0)
 997     {
 998       /* Free the space used to deal with the printing
 999          of this type from top level.  */
1000       obstack_free (&dont_print_vb_obstack, last_dont_print);
1001       /* Reset watermark so that we can continue protecting
1002          ourselves from whatever we were protecting ourselves.  */
1003       dont_print_vb_obstack = tmp_obstack;
1004     }
1005 }
1006
1007 /* Print value of a static member.
1008    To avoid infinite recursion when printing a class that contains
1009    a static instance of the class, we keep the addresses of all printed
1010    static member classes in an obstack and refuse to print them more
1011    than once.
1012
1013    VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1014    have the same meanings as in c_val_print.  */
1015
1016 static void
1017 pascal_object_print_static_field (struct type *type, struct value *val,
1018                                   struct ui_file *stream, int format,
1019                                   int recurse, enum val_prettyprint pretty)
1020 {
1021   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
1022     {
1023       CORE_ADDR *first_dont_print;
1024       int i;
1025
1026       first_dont_print
1027         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
1028       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
1029         - first_dont_print;
1030
1031       while (--i >= 0)
1032         {
1033           if (VALUE_ADDRESS (val) == first_dont_print[i])
1034             {
1035               fputs_filtered ("<same as static member of an already seen type>",
1036                               stream);
1037               return;
1038             }
1039         }
1040
1041       obstack_grow (&dont_print_statmem_obstack, (char *) &VALUE_ADDRESS (val),
1042                     sizeof (CORE_ADDR));
1043
1044       CHECK_TYPEDEF (type);
1045       pascal_object_print_value_fields (type, value_contents (val), VALUE_ADDRESS (val),
1046                                   stream, format, recurse, pretty, NULL, 1);
1047       return;
1048     }
1049   val_print (type, value_contents (val), 0, VALUE_ADDRESS (val),
1050              stream, format, 0, recurse, pretty);
1051 }
1052
1053 void
1054 pascal_object_print_class_member (const bfd_byte *valaddr, struct type *domain,
1055                                   struct ui_file *stream, char *prefix)
1056 {
1057
1058   /* VAL is a byte offset into the structure type DOMAIN.
1059      Find the name of the field for that offset and
1060      print it.  */
1061   int extra = 0;
1062   int bits = 0;
1063   unsigned int i;
1064   unsigned len = TYPE_NFIELDS (domain);
1065   /* @@ Make VAL into bit offset */
1066   LONGEST val = unpack_long (builtin_type_int, valaddr) << 3;
1067   for (i = TYPE_N_BASECLASSES (domain); i < len; i++)
1068     {
1069       int bitpos = TYPE_FIELD_BITPOS (domain, i);
1070       QUIT;
1071       if (val == bitpos)
1072         break;
1073       if (val < bitpos && i != 0)
1074         {
1075           /* Somehow pointing into a field.  */
1076           i -= 1;
1077           extra = (val - TYPE_FIELD_BITPOS (domain, i));
1078           if (extra & 0x7)
1079             bits = 1;
1080           else
1081             extra >>= 3;
1082           break;
1083         }
1084     }
1085   if (i < len)
1086     {
1087       char *name;
1088       fputs_filtered (prefix, stream);
1089       name = type_name_no_tag (domain);
1090       if (name)
1091         fputs_filtered (name, stream);
1092       else
1093         pascal_type_print_base (domain, stream, 0, 0);
1094       fprintf_filtered (stream, "::");
1095       fputs_filtered (TYPE_FIELD_NAME (domain, i), stream);
1096       if (extra)
1097         fprintf_filtered (stream, " + %d bytes", extra);
1098       if (bits)
1099         fprintf_filtered (stream, " (offset in bits)");
1100     }
1101   else
1102     fprintf_filtered (stream, "%ld", (long int) (val >> 3));
1103 }
1104
1105 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
1106
1107 void
1108 _initialize_pascal_valprint (void)
1109 {
1110   deprecated_add_show_from_set
1111     (add_set_cmd ("pascal_static-members", class_support, var_boolean,
1112                   (char *) &pascal_static_field_print,
1113                   "Set printing of pascal static members.",
1114                   &setprintlist),
1115      &showprintlist);
1116   /* Turn on printing of static fields.  */
1117   pascal_static_field_print = 1;
1118
1119 }