1 /* Support for printing Pascal values for GDB, the GNU debugger. 2 3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011 4 Free Software Foundation, 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 value_at 277 (TYPE_TARGET_TYPE (type), 278 unpack_pointer (type, valaddr + embedded_offset)); 279 280 common_val_print (deref_val, stream, recurse + 1, options, 281 current_language); 282 } 283 else 284 fputs_filtered ("???", stream); 285 } 286 break; 287 288 case TYPE_CODE_UNION: 289 if (recurse && !options->unionprint) 290 { 291 fprintf_filtered (stream, "{...}"); 292 break; 293 } 294 /* Fall through. */ 295 case TYPE_CODE_STRUCT: 296 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type)) 297 { 298 /* Print the unmangled name if desired. */ 299 /* Print vtable entry - we only get here if NOT using 300 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */ 301 /* Extract the address, assume that it is unsigned. */ 302 print_address_demangle 303 (gdbarch, 304 extract_unsigned_integer (valaddr + embedded_offset 305 + TYPE_FIELD_BITPOS (type, 306 VTBL_FNADDR_OFFSET) / 8, 307 TYPE_LENGTH (TYPE_FIELD_TYPE (type, 308 VTBL_FNADDR_OFFSET)), 309 byte_order), 310 stream, demangle); 311 } 312 else 313 { 314 if (is_pascal_string_type (type, &length_pos, &length_size, 315 &string_pos, &char_type, NULL)) 316 { 317 len = extract_unsigned_integer (valaddr + embedded_offset 318 + length_pos, length_size, 319 byte_order); 320 LA_PRINT_STRING (stream, char_type, 321 valaddr + embedded_offset + string_pos, 322 len, NULL, 0, options); 323 } 324 else 325 pascal_object_print_value_fields (type, valaddr, embedded_offset, 326 address, stream, recurse, 327 original_value, options, 328 NULL, 0); 329 } 330 break; 331 332 case TYPE_CODE_ENUM: 333 if (options->format) 334 { 335 val_print_scalar_formatted (type, valaddr, embedded_offset, 336 original_value, options, 0, stream); 337 break; 338 } 339 len = TYPE_NFIELDS (type); 340 val = unpack_long (type, valaddr + embedded_offset); 341 for (i = 0; i < len; i++) 342 { 343 QUIT; 344 if (val == TYPE_FIELD_BITPOS (type, i)) 345 { 346 break; 347 } 348 } 349 if (i < len) 350 { 351 fputs_filtered (TYPE_FIELD_NAME (type, i), stream); 352 } 353 else 354 { 355 print_longest (stream, 'd', 0, val); 356 } 357 break; 358 359 case TYPE_CODE_FLAGS: 360 if (options->format) 361 val_print_scalar_formatted (type, valaddr, embedded_offset, 362 original_value, options, 0, stream); 363 else 364 val_print_type_code_flags (type, valaddr + embedded_offset, stream); 365 break; 366 367 case TYPE_CODE_FUNC: 368 if (options->format) 369 { 370 val_print_scalar_formatted (type, valaddr, embedded_offset, 371 original_value, options, 0, stream); 372 break; 373 } 374 /* FIXME, we should consider, at least for ANSI C language, eliminating 375 the distinction made between FUNCs and POINTERs to FUNCs. */ 376 fprintf_filtered (stream, "{"); 377 type_print (type, "", stream, -1); 378 fprintf_filtered (stream, "} "); 379 /* Try to print what function it points to, and its address. */ 380 print_address_demangle (gdbarch, address, stream, demangle); 381 break; 382 383 case TYPE_CODE_BOOL: 384 if (options->format || options->output_format) 385 { 386 struct value_print_options opts = *options; 387 388 opts.format = (options->format ? options->format 389 : options->output_format); 390 val_print_scalar_formatted (type, valaddr, embedded_offset, 391 original_value, &opts, 0, stream); 392 } 393 else 394 { 395 val = unpack_long (type, valaddr + embedded_offset); 396 if (val == 0) 397 fputs_filtered ("false", stream); 398 else if (val == 1) 399 fputs_filtered ("true", stream); 400 else 401 { 402 fputs_filtered ("true (", stream); 403 fprintf_filtered (stream, "%ld)", (long int) val); 404 } 405 } 406 break; 407 408 case TYPE_CODE_RANGE: 409 /* FIXME: create_range_type does not set the unsigned bit in a 410 range type (I think it probably should copy it from the target 411 type), so we won't print values which are too large to 412 fit in a signed integer correctly. */ 413 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just 414 print with the target type, though, because the size of our type 415 and the target type might differ). */ 416 /* FALLTHROUGH */ 417 418 case TYPE_CODE_INT: 419 if (options->format || options->output_format) 420 { 421 struct value_print_options opts = *options; 422 423 opts.format = (options->format ? options->format 424 : options->output_format); 425 val_print_scalar_formatted (type, valaddr, embedded_offset, 426 original_value, &opts, 0, stream); 427 } 428 else 429 { 430 val_print_type_code_int (type, valaddr + embedded_offset, stream); 431 } 432 break; 433 434 case TYPE_CODE_CHAR: 435 if (options->format || options->output_format) 436 { 437 struct value_print_options opts = *options; 438 439 opts.format = (options->format ? options->format 440 : options->output_format); 441 val_print_scalar_formatted (type, valaddr, embedded_offset, 442 original_value, &opts, 0, stream); 443 } 444 else 445 { 446 val = unpack_long (type, valaddr + embedded_offset); 447 if (TYPE_UNSIGNED (type)) 448 fprintf_filtered (stream, "%u", (unsigned int) val); 449 else 450 fprintf_filtered (stream, "%d", (int) val); 451 fputs_filtered (" ", stream); 452 LA_PRINT_CHAR ((unsigned char) val, type, stream); 453 } 454 break; 455 456 case TYPE_CODE_FLT: 457 if (options->format) 458 { 459 val_print_scalar_formatted (type, valaddr, embedded_offset, 460 original_value, options, 0, stream); 461 } 462 else 463 { 464 print_floating (valaddr + embedded_offset, type, stream); 465 } 466 break; 467 468 case TYPE_CODE_BITSTRING: 469 case TYPE_CODE_SET: 470 elttype = TYPE_INDEX_TYPE (type); 471 CHECK_TYPEDEF (elttype); 472 if (TYPE_STUB (elttype)) 473 { 474 fprintf_filtered (stream, "<incomplete type>"); 475 gdb_flush (stream); 476 break; 477 } 478 else 479 { 480 struct type *range = elttype; 481 LONGEST low_bound, high_bound; 482 int i; 483 int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING; 484 int need_comma = 0; 485 486 if (is_bitstring) 487 fputs_filtered ("B'", stream); 488 else 489 fputs_filtered ("[", stream); 490 491 i = get_discrete_bounds (range, &low_bound, &high_bound); 492 if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0) 493 { 494 /* If we know the size of the set type, we can figure out the 495 maximum value. */ 496 i = 0; 497 high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1; 498 TYPE_HIGH_BOUND (range) = high_bound; 499 } 500 maybe_bad_bstring: 501 if (i < 0) 502 { 503 fputs_filtered ("<error value>", stream); 504 goto done; 505 } 506 507 for (i = low_bound; i <= high_bound; i++) 508 { 509 int element = value_bit_index (type, 510 valaddr + embedded_offset, i); 511 512 if (element < 0) 513 { 514 i = element; 515 goto maybe_bad_bstring; 516 } 517 if (is_bitstring) 518 fprintf_filtered (stream, "%d", element); 519 else if (element) 520 { 521 if (need_comma) 522 fputs_filtered (", ", stream); 523 print_type_scalar (range, i, stream); 524 need_comma = 1; 525 526 if (i + 1 <= high_bound 527 && value_bit_index (type, 528 valaddr + embedded_offset, ++i)) 529 { 530 int j = i; 531 532 fputs_filtered ("..", stream); 533 while (i + 1 <= high_bound 534 && value_bit_index (type, 535 valaddr + embedded_offset, 536 ++i)) 537 j = i; 538 print_type_scalar (range, j, stream); 539 } 540 } 541 } 542 done: 543 if (is_bitstring) 544 fputs_filtered ("'", stream); 545 else 546 fputs_filtered ("]", stream); 547 } 548 break; 549 550 case TYPE_CODE_VOID: 551 fprintf_filtered (stream, "void"); 552 break; 553 554 case TYPE_CODE_ERROR: 555 fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type)); 556 break; 557 558 case TYPE_CODE_UNDEF: 559 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use 560 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar" 561 and no complete type for struct foo in that file. */ 562 fprintf_filtered (stream, "<incomplete type>"); 563 break; 564 565 default: 566 error (_("Invalid pascal type code %d in symbol table."), 567 TYPE_CODE (type)); 568 } 569 gdb_flush (stream); 570 return (0); 571 } 572 573 int 574 pascal_value_print (struct value *val, struct ui_file *stream, 575 const struct value_print_options *options) 576 { 577 struct type *type = value_type (val); 578 struct value_print_options opts = *options; 579 580 opts.deref_ref = 1; 581 582 /* If it is a pointer, indicate what it points to. 583 584 Print type also if it is a reference. 585 586 Object pascal: if it is a member pointer, we will take care 587 of that when we print it. */ 588 if (TYPE_CODE (type) == TYPE_CODE_PTR 589 || TYPE_CODE (type) == TYPE_CODE_REF) 590 { 591 /* Hack: remove (char *) for char strings. Their 592 type is indicated by the quoted string anyway. */ 593 if (TYPE_CODE (type) == TYPE_CODE_PTR 594 && TYPE_NAME (type) == NULL 595 && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL 596 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0) 597 { 598 /* Print nothing. */ 599 } 600 else 601 { 602 fprintf_filtered (stream, "("); 603 type_print (type, "", stream, -1); 604 fprintf_filtered (stream, ") "); 605 } 606 } 607 return common_val_print (val, stream, 0, &opts, current_language); 608 } 609 610 611 static void 612 show_pascal_static_field_print (struct ui_file *file, int from_tty, 613 struct cmd_list_element *c, const char *value) 614 { 615 fprintf_filtered (file, _("Printing of pascal static members is %s.\n"), 616 value); 617 } 618 619 static struct obstack dont_print_vb_obstack; 620 static struct obstack dont_print_statmem_obstack; 621 622 static void pascal_object_print_static_field (struct value *, 623 struct ui_file *, int, 624 const struct value_print_options *); 625 626 static void pascal_object_print_value (struct type *, const gdb_byte *, 627 int, 628 CORE_ADDR, struct ui_file *, int, 629 const struct value *, 630 const struct value_print_options *, 631 struct type **); 632 633 /* It was changed to this after 2.4.5. */ 634 const char pascal_vtbl_ptr_name[] = 635 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0}; 636 637 /* Return truth value for assertion that TYPE is of the type 638 "pointer to virtual function". */ 639 640 int 641 pascal_object_is_vtbl_ptr_type (struct type *type) 642 { 643 char *typename = type_name_no_tag (type); 644 645 return (typename != NULL 646 && strcmp (typename, pascal_vtbl_ptr_name) == 0); 647 } 648 649 /* Return truth value for the assertion that TYPE is of the type 650 "pointer to virtual function table". */ 651 652 int 653 pascal_object_is_vtbl_member (struct type *type) 654 { 655 if (TYPE_CODE (type) == TYPE_CODE_PTR) 656 { 657 type = TYPE_TARGET_TYPE (type); 658 if (TYPE_CODE (type) == TYPE_CODE_ARRAY) 659 { 660 type = TYPE_TARGET_TYPE (type); 661 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* If not using 662 thunks. */ 663 || TYPE_CODE (type) == TYPE_CODE_PTR) /* If using thunks. */ 664 { 665 /* Virtual functions tables are full of pointers 666 to virtual functions. */ 667 return pascal_object_is_vtbl_ptr_type (type); 668 } 669 } 670 } 671 return 0; 672 } 673 674 /* Mutually recursive subroutines of pascal_object_print_value and 675 c_val_print to print out a structure's fields: 676 pascal_object_print_value_fields and pascal_object_print_value. 677 678 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the 679 same meanings as in pascal_object_print_value and c_val_print. 680 681 DONT_PRINT is an array of baseclass types that we 682 should not print, or zero if called from top level. */ 683 684 void 685 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr, 686 int offset, 687 CORE_ADDR address, struct ui_file *stream, 688 int recurse, 689 const struct value *val, 690 const struct value_print_options *options, 691 struct type **dont_print_vb, 692 int dont_print_statmem) 693 { 694 int i, len, n_baseclasses; 695 char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack); 696 697 CHECK_TYPEDEF (type); 698 699 fprintf_filtered (stream, "{"); 700 len = TYPE_NFIELDS (type); 701 n_baseclasses = TYPE_N_BASECLASSES (type); 702 703 /* Print out baseclasses such that we don't print 704 duplicates of virtual baseclasses. */ 705 if (n_baseclasses > 0) 706 pascal_object_print_value (type, valaddr, offset, address, 707 stream, recurse + 1, val, 708 options, dont_print_vb); 709 710 if (!len && n_baseclasses == 1) 711 fprintf_filtered (stream, "<No data fields>"); 712 else 713 { 714 struct obstack tmp_obstack = dont_print_statmem_obstack; 715 int fields_seen = 0; 716 717 if (dont_print_statmem == 0) 718 { 719 /* If we're at top level, carve out a completely fresh 720 chunk of the obstack and use that until this particular 721 invocation returns. */ 722 obstack_finish (&dont_print_statmem_obstack); 723 } 724 725 for (i = n_baseclasses; i < len; i++) 726 { 727 /* If requested, skip printing of static fields. */ 728 if (!options->pascal_static_field_print 729 && field_is_static (&TYPE_FIELD (type, i))) 730 continue; 731 if (fields_seen) 732 fprintf_filtered (stream, ", "); 733 else if (n_baseclasses > 0) 734 { 735 if (options->pretty) 736 { 737 fprintf_filtered (stream, "\n"); 738 print_spaces_filtered (2 + 2 * recurse, stream); 739 fputs_filtered ("members of ", stream); 740 fputs_filtered (type_name_no_tag (type), stream); 741 fputs_filtered (": ", stream); 742 } 743 } 744 fields_seen = 1; 745 746 if (options->pretty) 747 { 748 fprintf_filtered (stream, "\n"); 749 print_spaces_filtered (2 + 2 * recurse, stream); 750 } 751 else 752 { 753 wrap_here (n_spaces (2 + 2 * recurse)); 754 } 755 if (options->inspect_it) 756 { 757 if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR) 758 fputs_filtered ("\"( ptr \"", stream); 759 else 760 fputs_filtered ("\"( nodef \"", stream); 761 if (field_is_static (&TYPE_FIELD (type, i))) 762 fputs_filtered ("static ", stream); 763 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), 764 language_cplus, 765 DMGL_PARAMS | DMGL_ANSI); 766 fputs_filtered ("\" \"", stream); 767 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), 768 language_cplus, 769 DMGL_PARAMS | DMGL_ANSI); 770 fputs_filtered ("\") \"", stream); 771 } 772 else 773 { 774 annotate_field_begin (TYPE_FIELD_TYPE (type, i)); 775 776 if (field_is_static (&TYPE_FIELD (type, i))) 777 fputs_filtered ("static ", stream); 778 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), 779 language_cplus, 780 DMGL_PARAMS | DMGL_ANSI); 781 annotate_field_name_end (); 782 fputs_filtered (" = ", stream); 783 annotate_field_value (); 784 } 785 786 if (!field_is_static (&TYPE_FIELD (type, i)) 787 && TYPE_FIELD_PACKED (type, i)) 788 { 789 struct value *v; 790 791 /* Bitfields require special handling, especially due to byte 792 order problems. */ 793 if (TYPE_FIELD_IGNORE (type, i)) 794 { 795 fputs_filtered ("<optimized out or zero length>", stream); 796 } 797 else if (value_bits_synthetic_pointer (val, 798 TYPE_FIELD_BITPOS (type, 799 i), 800 TYPE_FIELD_BITSIZE (type, 801 i))) 802 { 803 fputs_filtered (_("<synthetic pointer>"), stream); 804 } 805 else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i), 806 TYPE_FIELD_BITSIZE (type, i))) 807 { 808 val_print_optimized_out (stream); 809 } 810 else 811 { 812 struct value_print_options opts = *options; 813 814 v = value_field_bitfield (type, i, valaddr, offset, val); 815 816 opts.deref_ref = 0; 817 common_val_print (v, stream, recurse + 1, &opts, 818 current_language); 819 } 820 } 821 else 822 { 823 if (TYPE_FIELD_IGNORE (type, i)) 824 { 825 fputs_filtered ("<optimized out or zero length>", stream); 826 } 827 else if (field_is_static (&TYPE_FIELD (type, i))) 828 { 829 /* struct value *v = value_static_field (type, i); 830 v4.17 specific. */ 831 struct value *v; 832 833 v = value_field_bitfield (type, i, valaddr, offset, val); 834 835 if (v == NULL) 836 val_print_optimized_out (stream); 837 else 838 pascal_object_print_static_field (v, stream, recurse + 1, 839 options); 840 } 841 else 842 { 843 struct value_print_options opts = *options; 844 845 opts.deref_ref = 0; 846 /* val_print (TYPE_FIELD_TYPE (type, i), 847 valaddr + TYPE_FIELD_BITPOS (type, i) / 8, 848 address + TYPE_FIELD_BITPOS (type, i) / 8, 0, 849 stream, format, 0, recurse + 1, pretty); */ 850 val_print (TYPE_FIELD_TYPE (type, i), 851 valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, 852 address, stream, recurse + 1, val, &opts, 853 current_language); 854 } 855 } 856 annotate_field_end (); 857 } 858 859 if (dont_print_statmem == 0) 860 { 861 /* Free the space used to deal with the printing 862 of the members from top level. */ 863 obstack_free (&dont_print_statmem_obstack, last_dont_print); 864 dont_print_statmem_obstack = tmp_obstack; 865 } 866 867 if (options->pretty) 868 { 869 fprintf_filtered (stream, "\n"); 870 print_spaces_filtered (2 * recurse, stream); 871 } 872 } 873 fprintf_filtered (stream, "}"); 874 } 875 876 /* Special val_print routine to avoid printing multiple copies of virtual 877 baseclasses. */ 878 879 static void 880 pascal_object_print_value (struct type *type, const gdb_byte *valaddr, 881 int offset, 882 CORE_ADDR address, struct ui_file *stream, 883 int recurse, 884 const struct value *val, 885 const struct value_print_options *options, 886 struct type **dont_print_vb) 887 { 888 struct type **last_dont_print 889 = (struct type **) obstack_next_free (&dont_print_vb_obstack); 890 struct obstack tmp_obstack = dont_print_vb_obstack; 891 int i, n_baseclasses = TYPE_N_BASECLASSES (type); 892 893 if (dont_print_vb == 0) 894 { 895 /* If we're at top level, carve out a completely fresh 896 chunk of the obstack and use that until this particular 897 invocation returns. */ 898 /* Bump up the high-water mark. Now alpha is omega. */ 899 obstack_finish (&dont_print_vb_obstack); 900 } 901 902 for (i = 0; i < n_baseclasses; i++) 903 { 904 int boffset = 0; 905 struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i)); 906 char *basename = type_name_no_tag (baseclass); 907 const gdb_byte *base_valaddr = NULL; 908 int thisoffset; 909 volatile struct gdb_exception ex; 910 int skip = 0; 911 912 if (BASETYPE_VIA_VIRTUAL (type, i)) 913 { 914 struct type **first_dont_print 915 = (struct type **) obstack_base (&dont_print_vb_obstack); 916 917 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack) 918 - first_dont_print; 919 920 while (--j >= 0) 921 if (baseclass == first_dont_print[j]) 922 goto flush_it; 923 924 obstack_ptr_grow (&dont_print_vb_obstack, baseclass); 925 } 926 927 thisoffset = offset; 928 929 TRY_CATCH (ex, RETURN_MASK_ERROR) 930 { 931 boffset = baseclass_offset (type, i, valaddr, offset, address, val); 932 } 933 if (ex.reason < 0 && ex.error == NOT_AVAILABLE_ERROR) 934 skip = -1; 935 else if (ex.reason < 0) 936 skip = 1; 937 else 938 { 939 skip = 0; 940 941 /* The virtual base class pointer might have been clobbered by the 942 user program. Make sure that it still points to a valid memory 943 location. */ 944 945 if (boffset < 0 || boffset >= TYPE_LENGTH (type)) 946 { 947 /* FIXME (alloc): not safe is baseclass is really really big. */ 948 gdb_byte *buf = alloca (TYPE_LENGTH (baseclass)); 949 950 base_valaddr = buf; 951 if (target_read_memory (address + boffset, buf, 952 TYPE_LENGTH (baseclass)) != 0) 953 skip = 1; 954 address = address + boffset; 955 thisoffset = 0; 956 boffset = 0; 957 } 958 else 959 base_valaddr = valaddr; 960 } 961 962 if (options->pretty) 963 { 964 fprintf_filtered (stream, "\n"); 965 print_spaces_filtered (2 * recurse, stream); 966 } 967 fputs_filtered ("<", stream); 968 /* Not sure what the best notation is in the case where there is no 969 baseclass name. */ 970 971 fputs_filtered (basename ? basename : "", stream); 972 fputs_filtered ("> = ", stream); 973 974 if (skip < 0) 975 val_print_unavailable (stream); 976 else if (skip > 0) 977 val_print_invalid_address (stream); 978 else 979 pascal_object_print_value_fields (baseclass, base_valaddr, 980 thisoffset + boffset, address, 981 stream, recurse, val, options, 982 (struct type **) obstack_base (&dont_print_vb_obstack), 983 0); 984 fputs_filtered (", ", stream); 985 986 flush_it: 987 ; 988 } 989 990 if (dont_print_vb == 0) 991 { 992 /* Free the space used to deal with the printing 993 of this type from top level. */ 994 obstack_free (&dont_print_vb_obstack, last_dont_print); 995 /* Reset watermark so that we can continue protecting 996 ourselves from whatever we were protecting ourselves. */ 997 dont_print_vb_obstack = tmp_obstack; 998 } 999 } 1000 1001 /* Print value of a static member. 1002 To avoid infinite recursion when printing a class that contains 1003 a static instance of the class, we keep the addresses of all printed 1004 static member classes in an obstack and refuse to print them more 1005 than once. 1006 1007 VAL contains the value to print, STREAM, RECURSE, and OPTIONS 1008 have the same meanings as in c_val_print. */ 1009 1010 static void 1011 pascal_object_print_static_field (struct value *val, 1012 struct ui_file *stream, 1013 int recurse, 1014 const struct value_print_options *options) 1015 { 1016 struct type *type = value_type (val); 1017 struct value_print_options opts; 1018 1019 if (TYPE_CODE (type) == TYPE_CODE_STRUCT) 1020 { 1021 CORE_ADDR *first_dont_print, addr; 1022 int i; 1023 1024 first_dont_print 1025 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack); 1026 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack) 1027 - first_dont_print; 1028 1029 while (--i >= 0) 1030 { 1031 if (value_address (val) == first_dont_print[i]) 1032 { 1033 fputs_filtered ("\ 1034 <same as static member of an already seen type>", 1035 stream); 1036 return; 1037 } 1038 } 1039 1040 addr = value_address (val); 1041 obstack_grow (&dont_print_statmem_obstack, (char *) &addr, 1042 sizeof (CORE_ADDR)); 1043 1044 CHECK_TYPEDEF (type); 1045 pascal_object_print_value_fields (type, 1046 value_contents_for_printing (val), 1047 value_embedded_offset (val), 1048 addr, 1049 stream, recurse, 1050 val, options, NULL, 1); 1051 return; 1052 } 1053 1054 opts = *options; 1055 opts.deref_ref = 0; 1056 common_val_print (val, stream, recurse, &opts, current_language); 1057 } 1058 1059 /* -Wmissing-prototypes */ 1060 extern initialize_file_ftype _initialize_pascal_valprint; 1061 1062 void 1063 _initialize_pascal_valprint (void) 1064 { 1065 add_setshow_boolean_cmd ("pascal_static-members", class_support, 1066 &user_print_options.pascal_static_field_print, _("\ 1067 Set printing of pascal static members."), _("\ 1068 Show printing of pascal static members."), NULL, 1069 NULL, 1070 show_pascal_static_field_print, 1071 &setprintlist, &showprintlist); 1072 } 1073