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