1 /* Support for printing Pascal values for GDB, the GNU debugger. 2 3 Copyright (C) 2000-2013 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 "exceptions.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->prettyprint_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 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 != NULL) 230 && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol))) 231 { 232 if (want_space) 233 fputs_filtered (" ", stream); 234 fputs_filtered ("<", stream); 235 fputs_filtered (SYMBOL_PRINT_NAME (msymbol), 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 != NULL) 251 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block, 252 VAR_DOMAIN, &is_this_fld); 253 254 if (wsym) 255 { 256 wtype = SYMBOL_TYPE (wsym); 257 } 258 else 259 { 260 wtype = TYPE_TARGET_TYPE (type); 261 } 262 vt_val = value_at (wtype, vt_address); 263 common_val_print (vt_val, stream, recurse + 1, options, 264 current_language); 265 if (options->pretty) 266 { 267 fprintf_filtered (stream, "\n"); 268 print_spaces_filtered (2 + 2 * recurse, stream); 269 } 270 } 271 } 272 273 return; 274 275 case TYPE_CODE_REF: 276 case TYPE_CODE_ENUM: 277 case TYPE_CODE_FLAGS: 278 case TYPE_CODE_FUNC: 279 case TYPE_CODE_RANGE: 280 case TYPE_CODE_INT: 281 case TYPE_CODE_FLT: 282 case TYPE_CODE_VOID: 283 case TYPE_CODE_ERROR: 284 case TYPE_CODE_UNDEF: 285 case TYPE_CODE_BOOL: 286 case TYPE_CODE_CHAR: 287 generic_val_print (type, valaddr, embedded_offset, address, 288 stream, recurse, original_value, options, 289 &p_decorations); 290 break; 291 292 case TYPE_CODE_UNION: 293 if (recurse && !options->unionprint) 294 { 295 fprintf_filtered (stream, "{...}"); 296 break; 297 } 298 /* Fall through. */ 299 case TYPE_CODE_STRUCT: 300 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type)) 301 { 302 /* Print the unmangled name if desired. */ 303 /* Print vtable entry - we only get here if NOT using 304 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */ 305 /* Extract the address, assume that it is unsigned. */ 306 print_address_demangle 307 (options, gdbarch, 308 extract_unsigned_integer (valaddr + embedded_offset 309 + TYPE_FIELD_BITPOS (type, 310 VTBL_FNADDR_OFFSET) / 8, 311 TYPE_LENGTH (TYPE_FIELD_TYPE (type, 312 VTBL_FNADDR_OFFSET)), 313 byte_order), 314 stream, demangle); 315 } 316 else 317 { 318 if (is_pascal_string_type (type, &length_pos, &length_size, 319 &string_pos, &char_type, NULL)) 320 { 321 len = extract_unsigned_integer (valaddr + embedded_offset 322 + length_pos, length_size, 323 byte_order); 324 LA_PRINT_STRING (stream, char_type, 325 valaddr + embedded_offset + string_pos, 326 len, NULL, 0, options); 327 } 328 else 329 pascal_object_print_value_fields (type, valaddr, embedded_offset, 330 address, stream, recurse, 331 original_value, options, 332 NULL, 0); 333 } 334 break; 335 336 case TYPE_CODE_SET: 337 elttype = TYPE_INDEX_TYPE (type); 338 CHECK_TYPEDEF (elttype); 339 if (TYPE_STUB (elttype)) 340 { 341 fprintf_filtered (stream, "<incomplete type>"); 342 gdb_flush (stream); 343 break; 344 } 345 else 346 { 347 struct type *range = elttype; 348 LONGEST low_bound, high_bound; 349 int i; 350 int need_comma = 0; 351 352 fputs_filtered ("[", stream); 353 354 i = get_discrete_bounds (range, &low_bound, &high_bound); 355 if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0) 356 { 357 /* If we know the size of the set type, we can figure out the 358 maximum value. */ 359 i = 0; 360 high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1; 361 TYPE_HIGH_BOUND (range) = high_bound; 362 } 363 maybe_bad_bstring: 364 if (i < 0) 365 { 366 fputs_filtered ("<error value>", stream); 367 goto done; 368 } 369 370 for (i = low_bound; i <= high_bound; i++) 371 { 372 int element = value_bit_index (type, 373 valaddr + embedded_offset, i); 374 375 if (element < 0) 376 { 377 i = element; 378 goto maybe_bad_bstring; 379 } 380 if (element) 381 { 382 if (need_comma) 383 fputs_filtered (", ", stream); 384 print_type_scalar (range, i, stream); 385 need_comma = 1; 386 387 if (i + 1 <= high_bound 388 && value_bit_index (type, 389 valaddr + embedded_offset, ++i)) 390 { 391 int j = i; 392 393 fputs_filtered ("..", stream); 394 while (i + 1 <= high_bound 395 && value_bit_index (type, 396 valaddr + embedded_offset, 397 ++i)) 398 j = i; 399 print_type_scalar (range, j, stream); 400 } 401 } 402 } 403 done: 404 fputs_filtered ("]", stream); 405 } 406 break; 407 408 default: 409 error (_("Invalid pascal type code %d in symbol table."), 410 TYPE_CODE (type)); 411 } 412 gdb_flush (stream); 413 } 414 415 void 416 pascal_value_print (struct value *val, struct ui_file *stream, 417 const struct value_print_options *options) 418 { 419 struct type *type = value_type (val); 420 struct value_print_options opts = *options; 421 422 opts.deref_ref = 1; 423 424 /* If it is a pointer, indicate what it points to. 425 426 Print type also if it is a reference. 427 428 Object pascal: if it is a member pointer, we will take care 429 of that when we print it. */ 430 if (TYPE_CODE (type) == TYPE_CODE_PTR 431 || TYPE_CODE (type) == TYPE_CODE_REF) 432 { 433 /* Hack: remove (char *) for char strings. Their 434 type is indicated by the quoted string anyway. */ 435 if (TYPE_CODE (type) == TYPE_CODE_PTR 436 && TYPE_NAME (type) == NULL 437 && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL 438 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0) 439 { 440 /* Print nothing. */ 441 } 442 else 443 { 444 fprintf_filtered (stream, "("); 445 type_print (type, "", stream, -1); 446 fprintf_filtered (stream, ") "); 447 } 448 } 449 common_val_print (val, stream, 0, &opts, current_language); 450 } 451 452 453 static void 454 show_pascal_static_field_print (struct ui_file *file, int from_tty, 455 struct cmd_list_element *c, const char *value) 456 { 457 fprintf_filtered (file, _("Printing of pascal static members is %s.\n"), 458 value); 459 } 460 461 static struct obstack dont_print_vb_obstack; 462 static struct obstack dont_print_statmem_obstack; 463 464 static void pascal_object_print_static_field (struct value *, 465 struct ui_file *, int, 466 const struct value_print_options *); 467 468 static void pascal_object_print_value (struct type *, const gdb_byte *, 469 int, 470 CORE_ADDR, struct ui_file *, int, 471 const struct value *, 472 const struct value_print_options *, 473 struct type **); 474 475 /* It was changed to this after 2.4.5. */ 476 const char pascal_vtbl_ptr_name[] = 477 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0}; 478 479 /* Return truth value for assertion that TYPE is of the type 480 "pointer to virtual function". */ 481 482 int 483 pascal_object_is_vtbl_ptr_type (struct type *type) 484 { 485 const char *typename = type_name_no_tag (type); 486 487 return (typename != NULL 488 && strcmp (typename, pascal_vtbl_ptr_name) == 0); 489 } 490 491 /* Return truth value for the assertion that TYPE is of the type 492 "pointer to virtual function table". */ 493 494 int 495 pascal_object_is_vtbl_member (struct type *type) 496 { 497 if (TYPE_CODE (type) == TYPE_CODE_PTR) 498 { 499 type = TYPE_TARGET_TYPE (type); 500 if (TYPE_CODE (type) == TYPE_CODE_ARRAY) 501 { 502 type = TYPE_TARGET_TYPE (type); 503 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* If not using 504 thunks. */ 505 || TYPE_CODE (type) == TYPE_CODE_PTR) /* If using thunks. */ 506 { 507 /* Virtual functions tables are full of pointers 508 to virtual functions. */ 509 return pascal_object_is_vtbl_ptr_type (type); 510 } 511 } 512 } 513 return 0; 514 } 515 516 /* Mutually recursive subroutines of pascal_object_print_value and 517 c_val_print to print out a structure's fields: 518 pascal_object_print_value_fields and pascal_object_print_value. 519 520 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the 521 same meanings as in pascal_object_print_value and c_val_print. 522 523 DONT_PRINT is an array of baseclass types that we 524 should not print, or zero if called from top level. */ 525 526 void 527 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr, 528 int offset, 529 CORE_ADDR address, struct ui_file *stream, 530 int recurse, 531 const struct value *val, 532 const struct value_print_options *options, 533 struct type **dont_print_vb, 534 int dont_print_statmem) 535 { 536 int i, len, n_baseclasses; 537 char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack); 538 539 CHECK_TYPEDEF (type); 540 541 fprintf_filtered (stream, "{"); 542 len = TYPE_NFIELDS (type); 543 n_baseclasses = TYPE_N_BASECLASSES (type); 544 545 /* Print out baseclasses such that we don't print 546 duplicates of virtual baseclasses. */ 547 if (n_baseclasses > 0) 548 pascal_object_print_value (type, valaddr, offset, address, 549 stream, recurse + 1, val, 550 options, dont_print_vb); 551 552 if (!len && n_baseclasses == 1) 553 fprintf_filtered (stream, "<No data fields>"); 554 else 555 { 556 struct obstack tmp_obstack = dont_print_statmem_obstack; 557 int fields_seen = 0; 558 559 if (dont_print_statmem == 0) 560 { 561 /* If we're at top level, carve out a completely fresh 562 chunk of the obstack and use that until this particular 563 invocation returns. */ 564 obstack_finish (&dont_print_statmem_obstack); 565 } 566 567 for (i = n_baseclasses; i < len; i++) 568 { 569 /* If requested, skip printing of static fields. */ 570 if (!options->pascal_static_field_print 571 && field_is_static (&TYPE_FIELD (type, i))) 572 continue; 573 if (fields_seen) 574 fprintf_filtered (stream, ", "); 575 else if (n_baseclasses > 0) 576 { 577 if (options->pretty) 578 { 579 fprintf_filtered (stream, "\n"); 580 print_spaces_filtered (2 + 2 * recurse, stream); 581 fputs_filtered ("members of ", stream); 582 fputs_filtered (type_name_no_tag (type), stream); 583 fputs_filtered (": ", stream); 584 } 585 } 586 fields_seen = 1; 587 588 if (options->pretty) 589 { 590 fprintf_filtered (stream, "\n"); 591 print_spaces_filtered (2 + 2 * recurse, stream); 592 } 593 else 594 { 595 wrap_here (n_spaces (2 + 2 * recurse)); 596 } 597 598 annotate_field_begin (TYPE_FIELD_TYPE (type, i)); 599 600 if (field_is_static (&TYPE_FIELD (type, i))) 601 fputs_filtered ("static ", stream); 602 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), 603 language_cplus, 604 DMGL_PARAMS | DMGL_ANSI); 605 annotate_field_name_end (); 606 fputs_filtered (" = ", stream); 607 annotate_field_value (); 608 609 if (!field_is_static (&TYPE_FIELD (type, i)) 610 && TYPE_FIELD_PACKED (type, i)) 611 { 612 struct value *v; 613 614 /* Bitfields require special handling, especially due to byte 615 order problems. */ 616 if (TYPE_FIELD_IGNORE (type, i)) 617 { 618 fputs_filtered ("<optimized out or zero length>", stream); 619 } 620 else if (value_bits_synthetic_pointer (val, 621 TYPE_FIELD_BITPOS (type, 622 i), 623 TYPE_FIELD_BITSIZE (type, 624 i))) 625 { 626 fputs_filtered (_("<synthetic pointer>"), stream); 627 } 628 else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i), 629 TYPE_FIELD_BITSIZE (type, i))) 630 { 631 val_print_optimized_out (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 (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 valaddr, 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->pretty) 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 int offset, 705 CORE_ADDR address, struct ui_file *stream, 706 int recurse, 707 const 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 int 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 int thisoffset; 732 volatile struct gdb_exception ex; 733 int skip = 0; 734 735 if (BASETYPE_VIA_VIRTUAL (type, i)) 736 { 737 struct type **first_dont_print 738 = (struct type **) obstack_base (&dont_print_vb_obstack); 739 740 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack) 741 - first_dont_print; 742 743 while (--j >= 0) 744 if (baseclass == first_dont_print[j]) 745 goto flush_it; 746 747 obstack_ptr_grow (&dont_print_vb_obstack, baseclass); 748 } 749 750 thisoffset = offset; 751 752 TRY_CATCH (ex, RETURN_MASK_ERROR) 753 { 754 boffset = baseclass_offset (type, i, valaddr, offset, address, val); 755 } 756 if (ex.reason < 0 && ex.error == NOT_AVAILABLE_ERROR) 757 skip = -1; 758 else if (ex.reason < 0) 759 skip = 1; 760 else 761 { 762 skip = 0; 763 764 /* The virtual base class pointer might have been clobbered by the 765 user program. Make sure that it still points to a valid memory 766 location. */ 767 768 if (boffset < 0 || boffset >= TYPE_LENGTH (type)) 769 { 770 gdb_byte *buf; 771 struct cleanup *back_to; 772 773 buf = xmalloc (TYPE_LENGTH (baseclass)); 774 back_to = make_cleanup (xfree, buf); 775 776 base_valaddr = buf; 777 if (target_read_memory (address + boffset, buf, 778 TYPE_LENGTH (baseclass)) != 0) 779 skip = 1; 780 address = address + boffset; 781 thisoffset = 0; 782 boffset = 0; 783 do_cleanups (back_to); 784 } 785 else 786 base_valaddr = valaddr; 787 } 788 789 if (options->pretty) 790 { 791 fprintf_filtered (stream, "\n"); 792 print_spaces_filtered (2 * recurse, stream); 793 } 794 fputs_filtered ("<", stream); 795 /* Not sure what the best notation is in the case where there is no 796 baseclass name. */ 797 798 fputs_filtered (basename ? basename : "", stream); 799 fputs_filtered ("> = ", stream); 800 801 if (skip < 0) 802 val_print_unavailable (stream); 803 else if (skip > 0) 804 val_print_invalid_address (stream); 805 else 806 pascal_object_print_value_fields (baseclass, base_valaddr, 807 thisoffset + boffset, address, 808 stream, recurse, val, options, 809 (struct type **) obstack_base (&dont_print_vb_obstack), 810 0); 811 fputs_filtered (", ", stream); 812 813 flush_it: 814 ; 815 } 816 817 if (dont_print_vb == 0) 818 { 819 /* Free the space used to deal with the printing 820 of this type from top level. */ 821 obstack_free (&dont_print_vb_obstack, last_dont_print); 822 /* Reset watermark so that we can continue protecting 823 ourselves from whatever we were protecting ourselves. */ 824 dont_print_vb_obstack = tmp_obstack; 825 } 826 } 827 828 /* Print value of a static member. 829 To avoid infinite recursion when printing a class that contains 830 a static instance of the class, we keep the addresses of all printed 831 static member classes in an obstack and refuse to print them more 832 than once. 833 834 VAL contains the value to print, STREAM, RECURSE, and OPTIONS 835 have the same meanings as in c_val_print. */ 836 837 static void 838 pascal_object_print_static_field (struct value *val, 839 struct ui_file *stream, 840 int recurse, 841 const struct value_print_options *options) 842 { 843 struct type *type = value_type (val); 844 struct value_print_options opts; 845 846 if (TYPE_CODE (type) == TYPE_CODE_STRUCT) 847 { 848 CORE_ADDR *first_dont_print, addr; 849 int i; 850 851 first_dont_print 852 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack); 853 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack) 854 - first_dont_print; 855 856 while (--i >= 0) 857 { 858 if (value_address (val) == first_dont_print[i]) 859 { 860 fputs_filtered ("\ 861 <same as static member of an already seen type>", 862 stream); 863 return; 864 } 865 } 866 867 addr = value_address (val); 868 obstack_grow (&dont_print_statmem_obstack, (char *) &addr, 869 sizeof (CORE_ADDR)); 870 871 CHECK_TYPEDEF (type); 872 pascal_object_print_value_fields (type, 873 value_contents_for_printing (val), 874 value_embedded_offset (val), 875 addr, 876 stream, recurse, 877 val, options, NULL, 1); 878 return; 879 } 880 881 opts = *options; 882 opts.deref_ref = 0; 883 common_val_print (val, stream, recurse, &opts, current_language); 884 } 885 886 /* -Wmissing-prototypes */ 887 extern initialize_file_ftype _initialize_pascal_valprint; 888 889 void 890 _initialize_pascal_valprint (void) 891 { 892 add_setshow_boolean_cmd ("pascal_static-members", class_support, 893 &user_print_options.pascal_static_field_print, _("\ 894 Set printing of pascal static members."), _("\ 895 Show printing of pascal static members."), NULL, 896 NULL, 897 show_pascal_static_field_print, 898 &setprintlist, &showprintlist); 899 } 900