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