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