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