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