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