gdb/p-valprint.c

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