gdb/p-valprint.c

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