gdb/p-valprint.c

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