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