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