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 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_m2)
  91                    && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
  92               && (format == 0 || format == 's'))
  93             {
  94               /* If requested, look for the first null char and only print
  95                  elements up to it.  */
  96               if (stop_print_at_null)
  97                 {
  98                   unsigned int temp_len;
  99
 100                   /* Look for a NULL char. */
 101                   for (temp_len = 0;
 102                        (valaddr + embedded_offset)[temp_len]
 103                        && temp_len < len && temp_len < print_max;
 104                        temp_len++);
 105                   len = temp_len;
 106                 }
 107
 108               LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 1, 0);
 109               i = len;
 110             }
 111           else
 112             {
 113               fprintf_filtered (stream, "{");
 114               /* If this is a virtual function table, print the 0th
 115                  entry specially, and the rest of the members normally.  */
 116               if (pascal_object_is_vtbl_ptr_type (elttype))
 117                 {
 118                   i = 1;
 119                   fprintf_filtered (stream, "%d vtable entries", len - 1);
 120                 }
 121               else
 122                 {
 123                   i = 0;
 124                 }
 125               val_print_array_elements (type, valaddr + embedded_offset, address, stream,
 126                                      format, deref_ref, recurse, pretty, i);
 127               fprintf_filtered (stream, "}");
 128             }
 129           break;
 130         }
 131       /* Array of unspecified length: treat like pointer to first elt.  */
 132       addr = address;
 133       goto print_unpacked_pointer;
 134
 135     case TYPE_CODE_PTR:
 136       if (format && format != 's')
 137         {
 138           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 139           break;
 140         }
 141       if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
 142         {
 143           /* Print the unmangled name if desired.  */
 144           /* Print vtable entry - we only get here if we ARE using
 145              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.) */
 146           /* Extract the address, assume that it is unsigned.  */
 147           print_address_demangle (extract_unsigned_integer (valaddr + embedded_offset, TYPE_LENGTH (type)),
 148                                   stream, demangle);
 149           break;
 150         }
 151       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 152         {
 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               deprecated_print_address_numeric (addr, 1, 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               && (format == 0 || format == 's')
 175               && addr != 0)
 176             {
 177               /* no wide string yet */
 178               i = val_print_string (addr, -1, 1, stream);
 179             }
 180           /* also for pointers to pascal strings */
 181           /* Note: this is Free Pascal specific:
 182              as GDB does not recognize stabs pascal strings
 183              Pascal strings are mapped to records
 184              with lowercase names PM  */
 185           if (is_pascal_string_type (elttype, &length_pos, &length_size,
 186                                      &string_pos, &char_size, NULL)
 187               && addr != 0)
 188             {
 189               ULONGEST string_length;
 190               void *buffer;
 191               buffer = xmalloc (length_size);
 192               read_memory (addr + length_pos, buffer, length_size);
 193               string_length = extract_unsigned_integer (buffer, length_size);
 194               xfree (buffer);
 195               i = val_print_string (addr + string_pos, string_length, char_size, stream);
 196             }
 197           else if (pascal_object_is_vtbl_member (type))
 198             {
 199               /* print vtbl's nicely */
 200               CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
 201
 202               struct minimal_symbol *msymbol =
 203               lookup_minimal_symbol_by_pc (vt_address);
 204               if ((msymbol != NULL)
 205                   && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
 206                 {
 207                   fputs_filtered (" <", stream);
 208                   fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
 209                   fputs_filtered (">", stream);
 210                 }
 211               if (vt_address && vtblprint)
 212                 {
 213                   struct value *vt_val;
 214                   struct symbol *wsym = (struct symbol *) NULL;
 215                   struct type *wtype;
 216                   struct block *block = (struct block *) NULL;
 217                   int is_this_fld;
 218
 219                   if (msymbol != NULL)
 220                     wsym = lookup_symbol (DEPRECATED_SYMBOL_NAME (msymbol), block,
 221                                           VAR_DOMAIN, &is_this_fld, NULL);
 222
 223                   if (wsym)
 224                     {
 225                       wtype = SYMBOL_TYPE (wsym);
 226                     }
 227                   else
 228                     {
 229                       wtype = TYPE_TARGET_TYPE (type);
 230                     }
 231                   vt_val = value_at (wtype, vt_address);
 232                   common_val_print (vt_val, stream, format, deref_ref,
 233                                     recurse + 1, pretty);
 234                   if (pretty)
 235                     {
 236                       fprintf_filtered (stream, "\n");
 237                       print_spaces_filtered (2 + 2 * recurse, stream);
 238                     }
 239                 }
 240             }
 241
 242           /* Return number of characters printed, including the terminating
 243              '\0' if we reached the end.  val_print_string takes care including
 244              the terminating '\0' if necessary.  */
 245           return i;
 246         }
 247       break;
 248
 249     case TYPE_CODE_REF:
 250       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 251       if (addressprint)
 252         {
 253           fprintf_filtered (stream, "@");
 254           /* Extract the address, assume that it is unsigned.  */
 255           deprecated_print_address_numeric
 256             (extract_unsigned_integer (valaddr + embedded_offset,
 257                                        gdbarch_ptr_bit (current_gdbarch)
 258                                          / HOST_CHAR_BIT),
 259              1, stream);
 260           if (deref_ref)
 261             fputs_filtered (": ", stream);
 262         }
 263       /* De-reference the reference.  */
 264       if (deref_ref)
 265         {
 266           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 267             {
 268               struct value *deref_val =
 269               value_at
 270               (TYPE_TARGET_TYPE (type),
 271                unpack_pointer (lookup_pointer_type (builtin_type_void),
 272                                valaddr + embedded_offset));
 273               common_val_print (deref_val, stream, format, deref_ref,
 274                                 recurse + 1, pretty);
 275             }
 276           else
 277             fputs_filtered ("???", stream);
 278         }
 279       break;
 280
 281     case TYPE_CODE_UNION:
 282       if (recurse && !unionprint)
 283         {
 284           fprintf_filtered (stream, "{...}");
 285           break;
 286         }
 287       /* Fall through.  */
 288     case TYPE_CODE_STRUCT:
 289       if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
 290         {
 291           /* Print the unmangled name if desired.  */
 292           /* Print vtable entry - we only get here if NOT using
 293              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.) */
 294           /* Extract the address, assume that it is unsigned.  */
 295           print_address_demangle
 296             (extract_unsigned_integer (valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
 297                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET))),
 298              stream, demangle);
 299         }
 300       else
 301         {
 302           if (is_pascal_string_type (type, &length_pos, &length_size,
 303                                      &string_pos, &char_size, NULL))
 304             {
 305               len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size);
 306               LA_PRINT_STRING (stream, valaddr + embedded_offset + string_pos, len, char_size, 0);
 307             }
 308           else
 309             pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream, format,
 310                                               recurse, pretty, NULL, 0);
 311         }
 312       break;
 313
 314     case TYPE_CODE_ENUM:
 315       if (format)
 316         {
 317           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 318           break;
 319         }
 320       len = TYPE_NFIELDS (type);
 321       val = unpack_long (type, valaddr + embedded_offset);
 322       for (i = 0; i < len; i++)
 323         {
 324           QUIT;
 325           if (val == TYPE_FIELD_BITPOS (type, i))
 326             {
 327               break;
 328             }
 329         }
 330       if (i < len)
 331         {
 332           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 333         }
 334       else
 335         {
 336           print_longest (stream, 'd', 0, val);
 337         }
 338       break;
 339
 340     case TYPE_CODE_FLAGS:
 341       if (format)
 342           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 343       else
 344         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
 345       break;
 346
 347     case TYPE_CODE_FUNC:
 348       if (format)
 349         {
 350           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 351           break;
 352         }
 353       /* FIXME, we should consider, at least for ANSI C language, eliminating
 354          the distinction made between FUNCs and POINTERs to FUNCs.  */
 355       fprintf_filtered (stream, "{");
 356       type_print (type, "", stream, -1);
 357       fprintf_filtered (stream, "} ");
 358       /* Try to print what function it points to, and its address.  */
 359       print_address_demangle (address, stream, demangle);
 360       break;
 361
 362     case TYPE_CODE_BOOL:
 363       format = format ? format : output_format;
 364       if (format)
 365         print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 366       else
 367         {
 368           val = unpack_long (type, valaddr + embedded_offset);
 369           if (val == 0)
 370             fputs_filtered ("false", stream);
 371           else if (val == 1)
 372             fputs_filtered ("true", stream);
 373           else
 374             {
 375               fputs_filtered ("true (", stream);
 376               fprintf_filtered (stream, "%ld)", (long int) val);
 377             }
 378         }
 379       break;
 380
 381     case TYPE_CODE_RANGE:
 382       /* FIXME: create_range_type does not set the unsigned bit in a
 383          range type (I think it probably should copy it from the target
 384          type), so we won't print values which are too large to
 385          fit in a signed integer correctly.  */
 386       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
 387          print with the target type, though, because the size of our type
 388          and the target type might differ).  */
 389       /* FALLTHROUGH */
 390
 391     case TYPE_CODE_INT:
 392       format = format ? format : output_format;
 393       if (format)
 394         {
 395           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 396         }
 397       else
 398         {
 399           val_print_type_code_int (type, valaddr + embedded_offset, stream);
 400         }
 401       break;
 402
 403     case TYPE_CODE_CHAR:
 404       format = format ? format : output_format;
 405       if (format)
 406         {
 407           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 408         }
 409       else
 410         {
 411           val = unpack_long (type, valaddr + embedded_offset);
 412           if (TYPE_UNSIGNED (type))
 413             fprintf_filtered (stream, "%u", (unsigned int) val);
 414           else
 415             fprintf_filtered (stream, "%d", (int) val);
 416           fputs_filtered (" ", stream);
 417           LA_PRINT_CHAR ((unsigned char) val, stream);
 418         }
 419       break;
 420
 421     case TYPE_CODE_FLT:
 422       if (format)
 423         {
 424           print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
 425         }
 426       else
 427         {
 428           print_floating (valaddr + embedded_offset, type, stream);
 429         }
 430       break;
 431
 432     case TYPE_CODE_BITSTRING:
 433     case TYPE_CODE_SET:
 434       elttype = TYPE_INDEX_TYPE (type);
 435       CHECK_TYPEDEF (elttype);
 436       if (TYPE_STUB (elttype))
 437         {
 438           fprintf_filtered (stream, "<incomplete type>");
 439           gdb_flush (stream);
 440           break;
 441         }
 442       else
 443         {
 444           struct type *range = elttype;
 445           LONGEST low_bound, high_bound;
 446           int i;
 447           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
 448           int need_comma = 0;
 449
 450           if (is_bitstring)
 451             fputs_filtered ("B'", stream);
 452           else
 453             fputs_filtered ("[", stream);
 454
 455           i = get_discrete_bounds (range, &low_bound, &high_bound);
 456         maybe_bad_bstring:
 457           if (i < 0)
 458             {
 459               fputs_filtered ("<error value>", stream);
 460               goto done;
 461             }
 462
 463           for (i = low_bound; i <= high_bound; i++)
 464             {
 465               int element = value_bit_index (type, valaddr + embedded_offset, i);
 466               if (element < 0)
 467                 {
 468                   i = element;
 469                   goto maybe_bad_bstring;
 470                 }
 471               if (is_bitstring)
 472                 fprintf_filtered (stream, "%d", element);
 473               else if (element)
 474                 {
 475                   if (need_comma)
 476                     fputs_filtered (", ", stream);
 477                   print_type_scalar (range, i, stream);
 478                   need_comma = 1;
 479
 480                   if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
 481                     {
 482                       int j = i;
 483                       fputs_filtered ("..", stream);
 484                       while (i + 1 <= high_bound
 485                              && value_bit_index (type, valaddr + embedded_offset, ++i))
 486                         j = i;
 487                       print_type_scalar (range, j, stream);
 488                     }
 489                 }
 490             }
 491         done:
 492           if (is_bitstring)
 493             fputs_filtered ("'", stream);
 494           else
 495             fputs_filtered ("]", stream);
 496         }
 497       break;
 498
 499     case TYPE_CODE_VOID:
 500       fprintf_filtered (stream, "void");
 501       break;
 502
 503     case TYPE_CODE_ERROR:
 504       fprintf_filtered (stream, "<error type>");
 505       break;
 506
 507     case TYPE_CODE_UNDEF:
 508       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 509          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 510          and no complete type for struct foo in that file.  */
 511       fprintf_filtered (stream, "<incomplete type>");
 512       break;
 513
 514     default:
 515       error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
 516     }
 517   gdb_flush (stream);
 518   return (0);
 519 }
 520 \f
 521 int
 522 pascal_value_print (struct value *val, struct ui_file *stream, int format,
 523                     enum val_prettyprint pretty)
 524 {
 525   struct type *type = value_type (val);
 526
 527   /* If it is a pointer, indicate what it points to.
 528
 529      Print type also if it is a reference.
 530
 531      Object pascal: if it is a member pointer, we will take care
 532      of that when we print it.  */
 533   if (TYPE_CODE (type) == TYPE_CODE_PTR ||
 534       TYPE_CODE (type) == TYPE_CODE_REF)
 535     {
 536       /* Hack:  remove (char *) for char strings.  Their
 537          type is indicated by the quoted string anyway. */
 538       if (TYPE_CODE (type) == TYPE_CODE_PTR &&
 539           TYPE_NAME (type) == NULL &&
 540           TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
 541           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
 542         {
 543           /* Print nothing */
 544         }
 545       else
 546         {
 547           fprintf_filtered (stream, "(");
 548           type_print (type, "", stream, -1);
 549           fprintf_filtered (stream, ") ");
 550         }
 551     }
 552   return common_val_print (val, stream, format, 1, 0, pretty);
 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, pretty);
 748                 }
 749             }
 750           else
 751             {
 752               if (TYPE_FIELD_IGNORE (type, i))
 753                 {
 754                   fputs_filtered ("<optimized out or zero length>", stream);
 755                 }
 756               else if (TYPE_FIELD_STATIC (type, i))
 757                 {
 758                   /* struct value *v = value_static_field (type, i); v4.17 specific */
 759                   struct value *v;
 760                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
 761                                    unpack_field_as_long (type, valaddr, i));
 762
 763                   if (v == NULL)
 764                     fputs_filtered ("<optimized out>", stream);
 765                   else
 766                     pascal_object_print_static_field (v, stream, format,
 767                                                       recurse + 1, pretty);
 768                 }
 769               else
 770                 {
 771                   /* val_print (TYPE_FIELD_TYPE (type, i),
 772                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
 773                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
 774                      stream, format, 0, recurse + 1, pretty); */
 775                   val_print (TYPE_FIELD_TYPE (type, i),
 776                              valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
 777                              address + TYPE_FIELD_BITPOS (type, i) / 8,
 778                              stream, format, 0, recurse + 1, pretty);
 779                 }
 780             }
 781           annotate_field_end ();
 782         }
 783
 784       if (dont_print_statmem == 0)
 785         {
 786           /* Free the space used to deal with the printing
 787              of the members from top level.  */
 788           obstack_free (&dont_print_statmem_obstack, last_dont_print);
 789           dont_print_statmem_obstack = tmp_obstack;
 790         }
 791
 792       if (pretty)
 793         {
 794           fprintf_filtered (stream, "\n");
 795           print_spaces_filtered (2 * recurse, stream);
 796         }
 797     }
 798   fprintf_filtered (stream, "}");
 799 }
 800
 801 /* Special val_print routine to avoid printing multiple copies of virtual
 802    baseclasses.  */
 803
 804 static void
 805 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
 806                            CORE_ADDR address, struct ui_file *stream,
 807                            int format, int recurse,
 808                            enum val_prettyprint pretty,
 809                            struct type **dont_print_vb)
 810 {
 811   struct type **last_dont_print
 812   = (struct type **) obstack_next_free (&dont_print_vb_obstack);
 813   struct obstack tmp_obstack = dont_print_vb_obstack;
 814   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 815
 816   if (dont_print_vb == 0)
 817     {
 818       /* If we're at top level, carve out a completely fresh
 819          chunk of the obstack and use that until this particular
 820          invocation returns.  */
 821       /* Bump up the high-water mark.  Now alpha is omega.  */
 822       obstack_finish (&dont_print_vb_obstack);
 823     }
 824
 825   for (i = 0; i < n_baseclasses; i++)
 826     {
 827       int boffset;
 828       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
 829       char *basename = type_name_no_tag (baseclass);
 830       const gdb_byte *base_valaddr;
 831
 832       if (BASETYPE_VIA_VIRTUAL (type, i))
 833         {
 834           struct type **first_dont_print
 835           = (struct type **) obstack_base (&dont_print_vb_obstack);
 836
 837           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
 838           - first_dont_print;
 839
 840           while (--j >= 0)
 841             if (baseclass == first_dont_print[j])
 842               goto flush_it;
 843
 844           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
 845         }
 846
 847       boffset = baseclass_offset (type, i, valaddr, address);
 848
 849       if (pretty)
 850         {
 851           fprintf_filtered (stream, "\n");
 852           print_spaces_filtered (2 * recurse, stream);
 853         }
 854       fputs_filtered ("<", stream);
 855       /* Not sure what the best notation is in the case where there is no
 856          baseclass name.  */
 857
 858       fputs_filtered (basename ? basename : "", stream);
 859       fputs_filtered ("> = ", stream);
 860
 861       /* The virtual base class pointer might have been clobbered by the
 862          user program. Make sure that it still points to a valid memory
 863          location.  */
 864
 865       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
 866         {
 867           /* FIXME (alloc): not safe is baseclass is really really big. */
 868           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
 869           base_valaddr = buf;
 870           if (target_read_memory (address + boffset, buf,
 871                                   TYPE_LENGTH (baseclass)) != 0)
 872             boffset = -1;
 873         }
 874       else
 875         base_valaddr = valaddr + boffset;
 876
 877       if (boffset == -1)
 878         fprintf_filtered (stream, "<invalid address>");
 879       else
 880         pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
 881                                           stream, format, recurse, pretty,
 882                      (struct type **) obstack_base (&dont_print_vb_obstack),
 883                                           0);
 884       fputs_filtered (", ", stream);
 885
 886     flush_it:
 887       ;
 888     }
 889
 890   if (dont_print_vb == 0)
 891     {
 892       /* Free the space used to deal with the printing
 893          of this type from top level.  */
 894       obstack_free (&dont_print_vb_obstack, last_dont_print);
 895       /* Reset watermark so that we can continue protecting
 896          ourselves from whatever we were protecting ourselves.  */
 897       dont_print_vb_obstack = tmp_obstack;
 898     }
 899 }
 900
 901 /* Print value of a static member.
 902    To avoid infinite recursion when printing a class that contains
 903    a static instance of the class, we keep the addresses of all printed
 904    static member classes in an obstack and refuse to print them more
 905    than once.
 906
 907    VAL contains the value to print, STREAM, RECURSE, and PRETTY
 908    have the same meanings as in c_val_print.  */
 909
 910 static void
 911 pascal_object_print_static_field (struct value *val,
 912                                   struct ui_file *stream, int format,
 913                                   int recurse, enum val_prettyprint pretty)
 914 {
 915   struct type *type = value_type (val);
 916
 917   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 918     {
 919       CORE_ADDR *first_dont_print;
 920       int i;
 921
 922       first_dont_print
 923         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
 924       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
 925         - first_dont_print;
 926
 927       while (--i >= 0)
 928         {
 929           if (VALUE_ADDRESS (val) == first_dont_print[i])
 930             {
 931               fputs_filtered ("<same as static member of an already seen type>",
 932                               stream);
 933               return;
 934             }
 935         }
 936
 937       obstack_grow (&dont_print_statmem_obstack, (char *) &VALUE_ADDRESS (val),
 938                     sizeof (CORE_ADDR));
 939
 940       CHECK_TYPEDEF (type);
 941       pascal_object_print_value_fields (type, value_contents (val), VALUE_ADDRESS (val),
 942                                   stream, format, recurse, pretty, NULL, 1);
 943       return;
 944     }
 945   common_val_print (val, stream, format, 0, recurse, pretty);
 946 }
 947
 948 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
 949
 950 void
 951 _initialize_pascal_valprint (void)
 952 {
 953   add_setshow_boolean_cmd ("pascal_static-members", class_support,
 954                            &pascal_static_field_print, _("\
 955 Set printing of pascal static members."), _("\
 956 Show printing of pascal static members."), NULL,
 957                            NULL,
 958                            show_pascal_static_field_print,
 959                            &setprintlist, &showprintlist);
 960   /* Turn on printing of static fields.  */
 961   pascal_static_field_print = 1;
 962
 963 }