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                                        gdbarch_ptr_bit (current_gdbarch)
 260                                          / HOST_CHAR_BIT),
 261              1, stream);
 262           if (deref_ref)
 263             fputs_filtered (": ", stream);
 264         }
 265       /* De-reference the reference.  */
 266       if (deref_ref)
 267         {
 268           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 269             {
 270               struct value *deref_val =
 271               value_at
 272               (TYPE_TARGET_TYPE (type),
 273                unpack_pointer (lookup_pointer_type (builtin_type_void),
 274                                valaddr + embedded_offset));
 275               common_val_print (deref_val, stream, format, deref_ref,
 276                                 recurse + 1, pretty);
 277             }
 278           else
 279             fputs_filtered ("???", stream);
 280         }
 281       break;
 282
 283     case TYPE_CODE_UNION:
 284       if (recurse && !unionprint)
 285         {
 286           fprintf_filtered (stream, "{...}");
 287           break;
 288         }
 289       /* Fall through.  */
 290     case TYPE_CODE_STRUCT:
 291       if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
 292         {
 293           /* Print the unmangled name if desired.  */
 294           /* Print vtable entry - we only get here if NOT using
 295              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.) */
 296           /* Extract the address, assume that it is unsigned.  */
 297           print_address_demangle
 298             (extract_unsigned_integer (valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
 299                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET))),
 300              stream, demangle);
 301         }
 302       else
 303         {
 304           if (is_pascal_string_type (type, &length_pos, &length_size,
 305                                      &string_pos, &char_size, NULL))
 306             {
 307               len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size);
 308               LA_PRINT_STRING (stream, valaddr + embedded_offset + string_pos, len, char_size, 0);
 309             }
 310           else
 311             pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream, format,
 312                                               recurse, pretty, NULL, 0);
 313         }
 314       break;
 315
 316     case TYPE_CODE_ENUM:
 317       if (format)
 318         {
 319           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 320           break;
 321         }
 322       len = TYPE_NFIELDS (type);
 323       val = unpack_long (type, valaddr + embedded_offset);
 324       for (i = 0; i < len; i++)
 325         {
 326           QUIT;
 327           if (val == TYPE_FIELD_BITPOS (type, i))
 328             {
 329               break;
 330             }
 331         }
 332       if (i < len)
 333         {
 334           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 335         }
 336       else
 337         {
 338           print_longest (stream, 'd', 0, val);
 339         }
 340       break;
 341
 342     case TYPE_CODE_FLAGS:
 343       if (format)
 344           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 345       else
 346         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
 347       break;
 348
 349     case TYPE_CODE_FUNC:
 350       if (format)
 351         {
 352           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 353           break;
 354         }
 355       /* FIXME, we should consider, at least for ANSI C language, eliminating
 356          the distinction made between FUNCs and POINTERs to FUNCs.  */
 357       fprintf_filtered (stream, "{");
 358       type_print (type, "", stream, -1);
 359       fprintf_filtered (stream, "} ");
 360       /* Try to print what function it points to, and its address.  */
 361       print_address_demangle (address, stream, demangle);
 362       break;
 363
 364     case TYPE_CODE_BOOL:
 365       format = format ? format : output_format;
 366       if (format)
 367         print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 368       else
 369         {
 370           val = unpack_long (type, valaddr + embedded_offset);
 371           if (val == 0)
 372             fputs_filtered ("false", stream);
 373           else if (val == 1)
 374             fputs_filtered ("true", stream);
 375           else
 376             {
 377               fputs_filtered ("true (", stream);
 378               fprintf_filtered (stream, "%ld)", (long int) val);
 379             }
 380         }
 381       break;
 382
 383     case TYPE_CODE_RANGE:
 384       /* FIXME: create_range_type does not set the unsigned bit in a
 385          range type (I think it probably should copy it from the target
 386          type), so we won't print values which are too large to
 387          fit in a signed integer correctly.  */
 388       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
 389          print with the target type, though, because the size of our type
 390          and the target type might differ).  */
 391       /* FALLTHROUGH */
 392
 393     case TYPE_CODE_INT:
 394       format = format ? format : output_format;
 395       if (format)
 396         {
 397           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 398         }
 399       else
 400         {
 401           val_print_type_code_int (type, valaddr + embedded_offset, stream);
 402         }
 403       break;
 404
 405     case TYPE_CODE_CHAR:
 406       format = format ? format : output_format;
 407       if (format)
 408         {
 409           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 410         }
 411       else
 412         {
 413           val = unpack_long (type, valaddr + embedded_offset);
 414           if (TYPE_UNSIGNED (type))
 415             fprintf_filtered (stream, "%u", (unsigned int) val);
 416           else
 417             fprintf_filtered (stream, "%d", (int) val);
 418           fputs_filtered (" ", stream);
 419           LA_PRINT_CHAR ((unsigned char) val, stream);
 420         }
 421       break;
 422
 423     case TYPE_CODE_FLT:
 424       if (format)
 425         {
 426           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 427         }
 428       else
 429         {
 430           print_floating (valaddr + embedded_offset, type, stream);
 431         }
 432       break;
 433
 434     case TYPE_CODE_BITSTRING:
 435     case TYPE_CODE_SET:
 436       elttype = TYPE_INDEX_TYPE (type);
 437       CHECK_TYPEDEF (elttype);
 438       if (TYPE_STUB (elttype))
 439         {
 440           fprintf_filtered (stream, "<incomplete type>");
 441           gdb_flush (stream);
 442           break;
 443         }
 444       else
 445         {
 446           struct type *range = elttype;
 447           LONGEST low_bound, high_bound;
 448           int i;
 449           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
 450           int need_comma = 0;
 451
 452           if (is_bitstring)
 453             fputs_filtered ("B'", stream);
 454           else
 455             fputs_filtered ("[", stream);
 456
 457           i = get_discrete_bounds (range, &low_bound, &high_bound);
 458         maybe_bad_bstring:
 459           if (i < 0)
 460             {
 461               fputs_filtered ("<error value>", stream);
 462               goto done;
 463             }
 464
 465           for (i = low_bound; i <= high_bound; i++)
 466             {
 467               int element = value_bit_index (type, valaddr + embedded_offset, i);
 468               if (element < 0)
 469                 {
 470                   i = element;
 471                   goto maybe_bad_bstring;
 472                 }
 473               if (is_bitstring)
 474                 fprintf_filtered (stream, "%d", element);
 475               else if (element)
 476                 {
 477                   if (need_comma)
 478                     fputs_filtered (", ", stream);
 479                   print_type_scalar (range, i, stream);
 480                   need_comma = 1;
 481
 482                   if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
 483                     {
 484                       int j = i;
 485                       fputs_filtered ("..", stream);
 486                       while (i + 1 <= high_bound
 487                              && value_bit_index (type, valaddr + embedded_offset, ++i))
 488                         j = i;
 489                       print_type_scalar (range, j, stream);
 490                     }
 491                 }
 492             }
 493         done:
 494           if (is_bitstring)
 495             fputs_filtered ("'", stream);
 496           else
 497             fputs_filtered ("]", stream);
 498         }
 499       break;
 500
 501     case TYPE_CODE_VOID:
 502       fprintf_filtered (stream, "void");
 503       break;
 504
 505     case TYPE_CODE_ERROR:
 506       fprintf_filtered (stream, "<error type>");
 507       break;
 508
 509     case TYPE_CODE_UNDEF:
 510       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 511          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 512          and no complete type for struct foo in that file.  */
 513       fprintf_filtered (stream, "<incomplete type>");
 514       break;
 515
 516     default:
 517       error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
 518     }
 519   gdb_flush (stream);
 520   return (0);
 521 }
 522 \f
 523 int
 524 pascal_value_print (struct value *val, struct ui_file *stream, int format,
 525                     enum val_prettyprint pretty)
 526 {
 527   struct type *type = value_type (val);
 528
 529   /* If it is a pointer, indicate what it points to.
 530
 531      Print type also if it is a reference.
 532
 533      Object pascal: if it is a member pointer, we will take care
 534      of that when we print it.  */
 535   if (TYPE_CODE (type) == TYPE_CODE_PTR ||
 536       TYPE_CODE (type) == TYPE_CODE_REF)
 537     {
 538       /* Hack:  remove (char *) for char strings.  Their
 539          type is indicated by the quoted string anyway. */
 540       if (TYPE_CODE (type) == TYPE_CODE_PTR &&
 541           TYPE_NAME (type) == NULL &&
 542           TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 543           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 544         {
 545           /* Print nothing */
 546         }
 547       else
 548         {
 549           fprintf_filtered (stream, "(");
 550           type_print (type, "", stream, -1);
 551           fprintf_filtered (stream, ") ");
 552         }
 553     }
 554   return common_val_print (val, stream, format, 1, 0, pretty);
 555 }
 556
 557
 558 /******************************************************************************
 559                     Inserted from cp-valprint
 560 ******************************************************************************/
 561
 562 extern int vtblprint;           /* Controls printing of vtbl's */
 563 extern int objectprint;         /* Controls looking up an object's derived type
 564                                    using what we find in its vtables.  */
 565 static int pascal_static_field_print;   /* Controls printing of static fields. */
 566 static void
 567 show_pascal_static_field_print (struct ui_file *file, int from_tty,
 568                                 struct cmd_list_element *c, const char *value)
 569 {
 570   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
 571                     value);
 572 }
 573
 574 static struct obstack dont_print_vb_obstack;
 575 static struct obstack dont_print_statmem_obstack;
 576
 577 static void pascal_object_print_static_field (struct value *,
 578                                               struct ui_file *, int, int,
 579                                               enum val_prettyprint);
 580
 581 static void pascal_object_print_value (struct type *, const gdb_byte *,
 582                                        CORE_ADDR, struct ui_file *,
 583                                        int, int, enum val_prettyprint,
 584                                        struct type **);
 585
 586 /* It was changed to this after 2.4.5.  */
 587 const char pascal_vtbl_ptr_name[] =
 588 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 589
 590 /* Return truth value for assertion that TYPE is of the type
 591    "pointer to virtual function".  */
 592
 593 int
 594 pascal_object_is_vtbl_ptr_type (struct type *type)
 595 {
 596   char *typename = type_name_no_tag (type);
 597
 598   return (typename != NULL
 599           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
 600 }
 601
 602 /* Return truth value for the assertion that TYPE is of the type
 603    "pointer to virtual function table".  */
 604
 605 int
 606 pascal_object_is_vtbl_member (struct type *type)
 607 {
 608   if (TYPE_CODE (type) == TYPE_CODE_PTR)
 609     {
 610       type = TYPE_TARGET_TYPE (type);
 611       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 612         {
 613           type = TYPE_TARGET_TYPE (type);
 614           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
 615               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
 616             {
 617               /* Virtual functions tables are full of pointers
 618                  to virtual functions. */
 619               return pascal_object_is_vtbl_ptr_type (type);
 620             }
 621         }
 622     }
 623   return 0;
 624 }
 625
 626 /* Mutually recursive subroutines of pascal_object_print_value and
 627    c_val_print to print out a structure's fields:
 628    pascal_object_print_value_fields and pascal_object_print_value.
 629
 630    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
 631    same meanings as in pascal_object_print_value and c_val_print.
 632
 633    DONT_PRINT is an array of baseclass types that we
 634    should not print, or zero if called from top level.  */
 635
 636 void
 637 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
 638                                   CORE_ADDR address, struct ui_file *stream,
 639                                   int format, int recurse,
 640                                   enum val_prettyprint pretty,
 641                                   struct type **dont_print_vb,
 642                                   int dont_print_statmem)
 643 {
 644   int i, len, n_baseclasses;
 645   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 646
 647   CHECK_TYPEDEF (type);
 648
 649   fprintf_filtered (stream, "{");
 650   len = TYPE_NFIELDS (type);
 651   n_baseclasses = TYPE_N_BASECLASSES (type);
 652
 653   /* Print out baseclasses such that we don't print
 654      duplicates of virtual baseclasses.  */
 655   if (n_baseclasses > 0)
 656     pascal_object_print_value (type, valaddr, address, stream,
 657                                format, recurse + 1, pretty, dont_print_vb);
 658
 659   if (!len && n_baseclasses == 1)
 660     fprintf_filtered (stream, "<No data fields>");
 661   else
 662     {
 663       struct obstack tmp_obstack = dont_print_statmem_obstack;
 664       int fields_seen = 0;
 665
 666       if (dont_print_statmem == 0)
 667         {
 668           /* If we're at top level, carve out a completely fresh
 669              chunk of the obstack and use that until this particular
 670              invocation returns.  */
 671           obstack_finish (&dont_print_statmem_obstack);
 672         }
 673
 674       for (i = n_baseclasses; i < len; i++)
 675         {
 676           /* If requested, skip printing of static fields.  */
 677           if (!pascal_static_field_print && TYPE_FIELD_STATIC (type, i))
 678             continue;
 679           if (fields_seen)
 680             fprintf_filtered (stream, ", ");
 681           else if (n_baseclasses > 0)
 682             {
 683               if (pretty)
 684                 {
 685                   fprintf_filtered (stream, "\n");
 686                   print_spaces_filtered (2 + 2 * recurse, stream);
 687                   fputs_filtered ("members of ", stream);
 688                   fputs_filtered (type_name_no_tag (type), stream);
 689                   fputs_filtered (": ", stream);
 690                 }
 691             }
 692           fields_seen = 1;
 693
 694           if (pretty)
 695             {
 696               fprintf_filtered (stream, "\n");
 697               print_spaces_filtered (2 + 2 * recurse, stream);
 698             }
 699           else
 700             {
 701               wrap_here (n_spaces (2 + 2 * recurse));
 702             }
 703           if (inspect_it)
 704             {
 705               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
 706                 fputs_filtered ("\"( ptr \"", stream);
 707               else
 708                 fputs_filtered ("\"( nodef \"", stream);
 709               if (TYPE_FIELD_STATIC (type, i))
 710                 fputs_filtered ("static ", stream);
 711               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 712                                        language_cplus,
 713                                        DMGL_PARAMS | DMGL_ANSI);
 714               fputs_filtered ("\" \"", stream);
 715               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 716                                        language_cplus,
 717                                        DMGL_PARAMS | DMGL_ANSI);
 718               fputs_filtered ("\") \"", stream);
 719             }
 720           else
 721             {
 722               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 723
 724               if (TYPE_FIELD_STATIC (type, i))
 725                 fputs_filtered ("static ", stream);
 726               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
 727                                        language_cplus,
 728                                        DMGL_PARAMS | DMGL_ANSI);
 729               annotate_field_name_end ();
 730               fputs_filtered (" = ", stream);
 731               annotate_field_value ();
 732             }
 733
 734           if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i))
 735             {
 736               struct value *v;
 737
 738               /* Bitfields require special handling, especially due to byte
 739                  order problems.  */
 740               if (TYPE_FIELD_IGNORE (type, i))
 741                 {
 742                   fputs_filtered ("<optimized out or zero length>", stream);
 743                 }
 744               else
 745                 {
 746                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 747                                    unpack_field_as_long (type, valaddr, i));
 748
 749                   common_val_print (v, stream, format, 0, recurse + 1, pretty);
 750                 }
 751             }
 752           else
 753             {
 754               if (TYPE_FIELD_IGNORE (type, i))
 755                 {
 756                   fputs_filtered ("<optimized out or zero length>", stream);
 757                 }
 758               else if (TYPE_FIELD_STATIC (type, i))
 759                 {
 760                   /* struct value *v = value_static_field (type, i); v4.17 specific */
 761                   struct value *v;
 762                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 763                                    unpack_field_as_long (type, valaddr, i));
 764
 765                   if (v == NULL)
 766                     fputs_filtered ("<optimized out>", stream);
 767                   else
 768                     pascal_object_print_static_field (v, stream, format,
 769                                                       recurse + 1, pretty);
 770                 }
 771               else
 772                 {
 773                   /* val_print (TYPE_FIELD_TYPE (type, i),
 774                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 775                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 776                      stream, format, 0, recurse + 1, pretty); */
 777                   val_print (TYPE_FIELD_TYPE (type, i),
 778                              valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
 779                              address + TYPE_FIELD_BITPOS (type, i) / 8,
 780                              stream, format, 0, recurse + 1, pretty);
 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 }
 949
 950 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
 951
 952 void
 953 _initialize_pascal_valprint (void)
 954 {
 955   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 956                            &pascal_static_field_print, _("\
 957 Set printing of pascal static members."), _("\
 958 Show printing of pascal static members."), NULL,
 959                            NULL,
 960                            show_pascal_static_field_print,
 961                            &setprintlist, &showprintlist);
 962   /* Turn on printing of static fields.  */
 963   pascal_static_field_print = 1;
 964
 965 }