1/* Support for printing Pascal types for GDB, the GNU debugger. 2 Copyright 2000, 2001, 2002 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 p-typeprint.c */ 22 23#include "defs.h" 24#include "gdb_obstack.h" 25#include "bfd.h" /* Binary File Description */ 26#include "symtab.h" 27#include "gdbtypes.h" 28#include "expression.h" 29#include "value.h" 30#include "gdbcore.h" 31#include "target.h" 32#include "language.h" 33#include "p-lang.h" 34#include "typeprint.h" 35 36#include "gdb_string.h" 37#include <errno.h> 38#include <ctype.h> 39 40static void pascal_type_print_varspec_suffix (struct type *, struct ui_file *, int, int, int); 41 42static void pascal_type_print_derivation_info (struct ui_file *, struct type *); 43 44void pascal_type_print_varspec_prefix (struct type *, struct ui_file *, int, int); 45 46 47/* LEVEL is the depth to indent lines by. */ 48 49void 50pascal_print_type (struct type *type, char *varstring, struct ui_file *stream, 51 int show, int level) 52{ 53 enum type_code code; 54 int demangled_args; 55 56 code = TYPE_CODE (type); 57 58 if (show > 0) 59 CHECK_TYPEDEF (type); 60 61 if ((code == TYPE_CODE_FUNC || 62 code == TYPE_CODE_METHOD)) 63 { 64 pascal_type_print_varspec_prefix (type, stream, show, 0); 65 } 66 /* first the name */ 67 fputs_filtered (varstring, stream); 68 69 if ((varstring != NULL && *varstring != '\0') && 70 !(code == TYPE_CODE_FUNC || 71 code == TYPE_CODE_METHOD)) 72 { 73 fputs_filtered (" : ", stream); 74 } 75 76 if (!(code == TYPE_CODE_FUNC || 77 code == TYPE_CODE_METHOD)) 78 { 79 pascal_type_print_varspec_prefix (type, stream, show, 0); 80 } 81 82 pascal_type_print_base (type, stream, show, level); 83 /* For demangled function names, we have the arglist as part of the name, 84 so don't print an additional pair of ()'s */ 85 86 demangled_args = varstring ? strchr (varstring, '(') != NULL : 0; 87 pascal_type_print_varspec_suffix (type, stream, show, 0, demangled_args); 88 89} 90 91/* If TYPE is a derived type, then print out derivation information. 92 Print only the actual base classes of this type, not the base classes 93 of the base classes. I.E. for the derivation hierarchy: 94 95 class A { int a; }; 96 class B : public A {int b; }; 97 class C : public B {int c; }; 98 99 Print the type of class C as: 100 101 class C : public B { 102 int c; 103 } 104 105 Not as the following (like gdb used to), which is not legal C++ syntax for 106 derived types and may be confused with the multiple inheritance form: 107 108 class C : public B : public A { 109 int c; 110 } 111 112 In general, gdb should try to print the types as closely as possible to 113 the form that they appear in the source code. */ 114 115static void 116pascal_type_print_derivation_info (struct ui_file *stream, struct type *type) 117{ 118 char *name; 119 int i; 120 121 for (i = 0; i < TYPE_N_BASECLASSES (type); i++) 122 { 123 fputs_filtered (i == 0 ? ": " : ", ", stream); 124 fprintf_filtered (stream, "%s%s ", 125 BASETYPE_VIA_PUBLIC (type, i) ? "public" : "private", 126 BASETYPE_VIA_VIRTUAL (type, i) ? " virtual" : ""); 127 name = type_name_no_tag (TYPE_BASECLASS (type, i)); 128 fprintf_filtered (stream, "%s", name ? name : "(null)"); 129 } 130 if (i > 0) 131 { 132 fputs_filtered (" ", stream); 133 } 134} 135 136/* Print the Pascal method arguments ARGS to the file STREAM. */ 137 138void 139pascal_type_print_method_args (char *physname, char *methodname, 140 struct ui_file *stream) 141{ 142 int is_constructor = DEPRECATED_STREQN (physname, "__ct__", 6); 143 int is_destructor = DEPRECATED_STREQN (physname, "__dt__", 6); 144 145 if (is_constructor || is_destructor) 146 { 147 physname += 6; 148 } 149 150 fputs_filtered (methodname, stream); 151 152 if (physname && (*physname != 0)) 153 { 154 int i = 0; 155 int len = 0; 156 char storec; 157 char *argname; 158 fputs_filtered (" (", stream); 159 /* we must demangle this */ 160 while (isdigit (physname[0])) 161 { 162 while (isdigit (physname[len])) 163 { 164 len++; 165 } 166 i = strtol (physname, &argname, 0); 167 physname += len; 168 storec = physname[i]; 169 physname[i] = 0; 170 fputs_filtered (physname, stream); 171 physname[i] = storec; 172 physname += i; 173 if (physname[0] != 0) 174 { 175 fputs_filtered (", ", stream); 176 } 177 } 178 fputs_filtered (")", stream); 179 } 180} 181 182/* Print any asterisks or open-parentheses needed before the 183 variable name (to describe its type). 184 185 On outermost call, pass 0 for PASSED_A_PTR. 186 On outermost call, SHOW > 0 means should ignore 187 any typename for TYPE and show its details. 188 SHOW is always zero on recursive calls. */ 189 190void 191pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream, 192 int show, int passed_a_ptr) 193{ 194 char *name; 195 if (type == 0) 196 return; 197 198 if (TYPE_NAME (type) && show <= 0) 199 return; 200 201 QUIT; 202 203 switch (TYPE_CODE (type)) 204 { 205 case TYPE_CODE_PTR: 206 fprintf_filtered (stream, "^"); 207 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1); 208 break; /* pointer should be handled normally in pascal */ 209 210 case TYPE_CODE_MEMBER: 211 if (passed_a_ptr) 212 fprintf_filtered (stream, "("); 213 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); 214 fprintf_filtered (stream, " "); 215 name = type_name_no_tag (TYPE_DOMAIN_TYPE (type)); 216 if (name) 217 fputs_filtered (name, stream); 218 else 219 pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr); 220 fprintf_filtered (stream, "::"); 221 break; 222 223 case TYPE_CODE_METHOD: 224 if (passed_a_ptr) 225 fprintf_filtered (stream, "("); 226 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID) 227 { 228 fprintf_filtered (stream, "function "); 229 } 230 else 231 { 232 fprintf_filtered (stream, "procedure "); 233 } 234 235 if (passed_a_ptr) 236 { 237 fprintf_filtered (stream, " "); 238 pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr); 239 fprintf_filtered (stream, "::"); 240 } 241 break; 242 243 case TYPE_CODE_REF: 244 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1); 245 fprintf_filtered (stream, "&"); 246 break; 247 248 case TYPE_CODE_FUNC: 249 if (passed_a_ptr) 250 fprintf_filtered (stream, "("); 251 252 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID) 253 { 254 fprintf_filtered (stream, "function "); 255 } 256 else 257 { 258 fprintf_filtered (stream, "procedure "); 259 } 260 261 break; 262 263 case TYPE_CODE_ARRAY: 264 if (passed_a_ptr) 265 fprintf_filtered (stream, "("); 266 fprintf_filtered (stream, "array "); 267 if (TYPE_LENGTH (type) >= 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0 268 && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED) 269 fprintf_filtered (stream, "[%d..%d] ", 270 TYPE_ARRAY_LOWER_BOUND_VALUE (type), 271 TYPE_ARRAY_UPPER_BOUND_VALUE (type) 272 ); 273 fprintf_filtered (stream, "of "); 274 break; 275 276 case TYPE_CODE_UNDEF: 277 case TYPE_CODE_STRUCT: 278 case TYPE_CODE_UNION: 279 case TYPE_CODE_ENUM: 280 case TYPE_CODE_INT: 281 case TYPE_CODE_FLT: 282 case TYPE_CODE_VOID: 283 case TYPE_CODE_ERROR: 284 case TYPE_CODE_CHAR: 285 case TYPE_CODE_BOOL: 286 case TYPE_CODE_SET: 287 case TYPE_CODE_RANGE: 288 case TYPE_CODE_STRING: 289 case TYPE_CODE_BITSTRING: 290 case TYPE_CODE_COMPLEX: 291 case TYPE_CODE_TYPEDEF: 292 case TYPE_CODE_TEMPLATE: 293 /* These types need no prefix. They are listed here so that 294 gcc -Wall will reveal any types that haven't been handled. */ 295 break; 296 default: 297 error ("type not handled in pascal_type_print_varspec_prefix()"); 298 break; 299 } 300} 301 302static void 303pascal_print_func_args (struct type *type, struct ui_file *stream) 304{ 305 int i, len = TYPE_NFIELDS (type); 306 if (len) 307 { 308 fprintf_filtered (stream, "("); 309 } 310 for (i = 0; i < len; i++) 311 { 312 if (i > 0) 313 { 314 fputs_filtered (", ", stream); 315 wrap_here (" "); 316 } 317 /* can we find if it is a var parameter ?? 318 if ( TYPE_FIELD(type, i) == ) 319 { 320 fprintf_filtered (stream, "var "); 321 } */ 322 pascal_print_type (TYPE_FIELD_TYPE (type, i), "" /* TYPE_FIELD_NAME seems invalid ! */ 323 ,stream, -1, 0); 324 } 325 if (len) 326 { 327 fprintf_filtered (stream, ")"); 328 } 329} 330 331/* Print any array sizes, function arguments or close parentheses 332 needed after the variable name (to describe its type). 333 Args work like pascal_type_print_varspec_prefix. */ 334 335static void 336pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream, 337 int show, int passed_a_ptr, 338 int demangled_args) 339{ 340 if (type == 0) 341 return; 342 343 if (TYPE_NAME (type) && show <= 0) 344 return; 345 346 QUIT; 347 348 switch (TYPE_CODE (type)) 349 { 350 case TYPE_CODE_ARRAY: 351 if (passed_a_ptr) 352 fprintf_filtered (stream, ")"); 353 break; 354 355 case TYPE_CODE_MEMBER: 356 if (passed_a_ptr) 357 fprintf_filtered (stream, ")"); 358 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); 359 break; 360 361 case TYPE_CODE_METHOD: 362 if (passed_a_ptr) 363 fprintf_filtered (stream, ")"); 364 pascal_type_print_method_args ("", 365 "", 366 stream); 367 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID) 368 { 369 fprintf_filtered (stream, " : "); 370 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); 371 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0); 372 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 373 passed_a_ptr, 0); 374 } 375 break; 376 377 case TYPE_CODE_PTR: 378 case TYPE_CODE_REF: 379 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0); 380 break; 381 382 case TYPE_CODE_FUNC: 383 if (passed_a_ptr) 384 fprintf_filtered (stream, ")"); 385 if (!demangled_args) 386 pascal_print_func_args (type, stream); 387 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID) 388 { 389 fprintf_filtered (stream, " : "); 390 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); 391 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0); 392 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 393 passed_a_ptr, 0); 394 } 395 break; 396 397 case TYPE_CODE_UNDEF: 398 case TYPE_CODE_STRUCT: 399 case TYPE_CODE_UNION: 400 case TYPE_CODE_ENUM: 401 case TYPE_CODE_INT: 402 case TYPE_CODE_FLT: 403 case TYPE_CODE_VOID: 404 case TYPE_CODE_ERROR: 405 case TYPE_CODE_CHAR: 406 case TYPE_CODE_BOOL: 407 case TYPE_CODE_SET: 408 case TYPE_CODE_RANGE: 409 case TYPE_CODE_STRING: 410 case TYPE_CODE_BITSTRING: 411 case TYPE_CODE_COMPLEX: 412 case TYPE_CODE_TYPEDEF: 413 case TYPE_CODE_TEMPLATE: 414 /* These types do not need a suffix. They are listed so that 415 gcc -Wall will report types that may not have been considered. */ 416 break; 417 default: 418 error ("type not handled in pascal_type_print_varspec_suffix()"); 419 break; 420 } 421} 422 423/* Print the name of the type (or the ultimate pointer target, 424 function value or array element), or the description of a 425 structure or union. 426 427 SHOW positive means print details about the type (e.g. enum values), 428 and print structure elements passing SHOW - 1 for show. 429 SHOW negative means just print the type name or struct tag if there is one. 430 If there is no name, print something sensible but concise like 431 "struct {...}". 432 SHOW zero means just print the type name or struct tag if there is one. 433 If there is no name, print something sensible but not as concise like 434 "struct {int x; int y;}". 435 436 LEVEL is the number of spaces to indent by. 437 We increase it for some recursive calls. */ 438 439void 440pascal_type_print_base (struct type *type, struct ui_file *stream, int show, 441 int level) 442{ 443 int i; 444 int len; 445 int lastval; 446 enum 447 { 448 s_none, s_public, s_private, s_protected 449 } 450 section_type; 451 QUIT; 452 453 wrap_here (" "); 454 if (type == NULL) 455 { 456 fputs_filtered ("<type unknown>", stream); 457 return; 458 } 459 460 /* void pointer */ 461 if ((TYPE_CODE (type) == TYPE_CODE_PTR) && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)) 462 { 463 fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer", 464 stream); 465 return; 466 } 467 /* When SHOW is zero or less, and there is a valid type name, then always 468 just print the type name directly from the type. */ 469 470 if (show <= 0 471 && TYPE_NAME (type) != NULL) 472 { 473 fputs_filtered (TYPE_NAME (type), stream); 474 return; 475 } 476 477 CHECK_TYPEDEF (type); 478 479 switch (TYPE_CODE (type)) 480 { 481 case TYPE_CODE_TYPEDEF: 482 case TYPE_CODE_PTR: 483 case TYPE_CODE_MEMBER: 484 case TYPE_CODE_REF: 485 /* case TYPE_CODE_FUNC: 486 case TYPE_CODE_METHOD: */ 487 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level); 488 break; 489 490 case TYPE_CODE_ARRAY: 491 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); 492 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level); 493 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */ 494 pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0); 495 break; 496 497 case TYPE_CODE_FUNC: 498 case TYPE_CODE_METHOD: 499 /* 500 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level); 501 only after args !! */ 502 break; 503 case TYPE_CODE_STRUCT: 504 if (TYPE_TAG_NAME (type) != NULL) 505 { 506 fputs_filtered (TYPE_TAG_NAME (type), stream); 507 fputs_filtered (" = ", stream); 508 } 509 if (HAVE_CPLUS_STRUCT (type)) 510 { 511 fprintf_filtered (stream, "class "); 512 } 513 else 514 { 515 fprintf_filtered (stream, "record "); 516 } 517 goto struct_union; 518 519 case TYPE_CODE_UNION: 520 if (TYPE_TAG_NAME (type) != NULL) 521 { 522 fputs_filtered (TYPE_TAG_NAME (type), stream); 523 fputs_filtered (" = ", stream); 524 } 525 fprintf_filtered (stream, "case <?> of "); 526 527 struct_union: 528 wrap_here (" "); 529 if (show < 0) 530 { 531 /* If we just printed a tag name, no need to print anything else. */ 532 if (TYPE_TAG_NAME (type) == NULL) 533 fprintf_filtered (stream, "{...}"); 534 } 535 else if (show > 0 || TYPE_TAG_NAME (type) == NULL) 536 { 537 pascal_type_print_derivation_info (stream, type); 538 539 fprintf_filtered (stream, "\n"); 540 if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0)) 541 { 542 if (TYPE_STUB (type)) 543 fprintfi_filtered (level + 4, stream, "<incomplete type>\n"); 544 else 545 fprintfi_filtered (level + 4, stream, "<no data fields>\n"); 546 } 547 548 /* Start off with no specific section type, so we can print 549 one for the first field we find, and use that section type 550 thereafter until we find another type. */ 551 552 section_type = s_none; 553 554 /* If there is a base class for this type, 555 do not print the field that it occupies. */ 556 557 len = TYPE_NFIELDS (type); 558 for (i = TYPE_N_BASECLASSES (type); i < len; i++) 559 { 560 QUIT; 561 /* Don't print out virtual function table. */ 562 if (DEPRECATED_STREQN (TYPE_FIELD_NAME (type, i), "_vptr", 5) 563 && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5])) 564 continue; 565 566 /* If this is a pascal object or class we can print the 567 various section labels. */ 568 569 if (HAVE_CPLUS_STRUCT (type)) 570 { 571 if (TYPE_FIELD_PROTECTED (type, i)) 572 { 573 if (section_type != s_protected) 574 { 575 section_type = s_protected; 576 fprintfi_filtered (level + 2, stream, 577 "protected\n"); 578 } 579 } 580 else if (TYPE_FIELD_PRIVATE (type, i)) 581 { 582 if (section_type != s_private) 583 { 584 section_type = s_private; 585 fprintfi_filtered (level + 2, stream, "private\n"); 586 } 587 } 588 else 589 { 590 if (section_type != s_public) 591 { 592 section_type = s_public; 593 fprintfi_filtered (level + 2, stream, "public\n"); 594 } 595 } 596 } 597 598 print_spaces_filtered (level + 4, stream); 599 if (TYPE_FIELD_STATIC (type, i)) 600 { 601 fprintf_filtered (stream, "static "); 602 } 603 pascal_print_type (TYPE_FIELD_TYPE (type, i), 604 TYPE_FIELD_NAME (type, i), 605 stream, show - 1, level + 4); 606 if (!TYPE_FIELD_STATIC (type, i) 607 && TYPE_FIELD_PACKED (type, i)) 608 { 609 /* It is a bitfield. This code does not attempt 610 to look at the bitpos and reconstruct filler, 611 unnamed fields. This would lead to misleading 612 results if the compiler does not put out fields 613 for such things (I don't know what it does). */ 614 fprintf_filtered (stream, " : %d", 615 TYPE_FIELD_BITSIZE (type, i)); 616 } 617 fprintf_filtered (stream, ";\n"); 618 } 619 620 /* If there are both fields and methods, put a space between. */ 621 len = TYPE_NFN_FIELDS (type); 622 if (len && section_type != s_none) 623 fprintf_filtered (stream, "\n"); 624 625 /* Pbject pascal: print out the methods */ 626 627 for (i = 0; i < len; i++) 628 { 629 struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i); 630 int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i); 631 char *method_name = TYPE_FN_FIELDLIST_NAME (type, i); 632 char *name = type_name_no_tag (type); 633 /* this is GNU C++ specific 634 how can we know constructor/destructor? 635 It might work for GNU pascal */ 636 for (j = 0; j < len2; j++) 637 { 638 char *physname = TYPE_FN_FIELD_PHYSNAME (f, j); 639 640 int is_constructor = DEPRECATED_STREQN (physname, "__ct__", 6); 641 int is_destructor = DEPRECATED_STREQN (physname, "__dt__", 6); 642 643 QUIT; 644 if (TYPE_FN_FIELD_PROTECTED (f, j)) 645 { 646 if (section_type != s_protected) 647 { 648 section_type = s_protected; 649 fprintfi_filtered (level + 2, stream, 650 "protected\n"); 651 } 652 } 653 else if (TYPE_FN_FIELD_PRIVATE (f, j)) 654 { 655 if (section_type != s_private) 656 { 657 section_type = s_private; 658 fprintfi_filtered (level + 2, stream, "private\n"); 659 } 660 } 661 else 662 { 663 if (section_type != s_public) 664 { 665 section_type = s_public; 666 fprintfi_filtered (level + 2, stream, "public\n"); 667 } 668 } 669 670 print_spaces_filtered (level + 4, stream); 671 if (TYPE_FN_FIELD_STATIC_P (f, j)) 672 fprintf_filtered (stream, "static "); 673 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0) 674 { 675 /* Keep GDB from crashing here. */ 676 fprintf_filtered (stream, "<undefined type> %s;\n", 677 TYPE_FN_FIELD_PHYSNAME (f, j)); 678 break; 679 } 680 681 if (is_constructor) 682 { 683 fprintf_filtered (stream, "constructor "); 684 } 685 else if (is_destructor) 686 { 687 fprintf_filtered (stream, "destructor "); 688 } 689 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 && 690 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID) 691 { 692 fprintf_filtered (stream, "function "); 693 } 694 else 695 { 696 fprintf_filtered (stream, "procedure "); 697 } 698 /* this does not work, no idea why !! */ 699 700 pascal_type_print_method_args (physname, 701 method_name, 702 stream); 703 704 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 && 705 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID) 706 { 707 fputs_filtered (" : ", stream); 708 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)), 709 "", stream, -1); 710 } 711 if (TYPE_FN_FIELD_VIRTUAL_P (f, j)) 712 fprintf_filtered (stream, "; virtual"); 713 714 fprintf_filtered (stream, ";\n"); 715 } 716 } 717 fprintfi_filtered (level, stream, "end"); 718 } 719 break; 720 721 case TYPE_CODE_ENUM: 722 if (TYPE_TAG_NAME (type) != NULL) 723 { 724 fputs_filtered (TYPE_TAG_NAME (type), stream); 725 if (show > 0) 726 fputs_filtered (" ", stream); 727 } 728 /* enum is just defined by 729 type enume_name = (enum_member1,enum_member2,...) */ 730 fprintf_filtered (stream, " = "); 731 wrap_here (" "); 732 if (show < 0) 733 { 734 /* If we just printed a tag name, no need to print anything else. */ 735 if (TYPE_TAG_NAME (type) == NULL) 736 fprintf_filtered (stream, "(...)"); 737 } 738 else if (show > 0 || TYPE_TAG_NAME (type) == NULL) 739 { 740 fprintf_filtered (stream, "("); 741 len = TYPE_NFIELDS (type); 742 lastval = 0; 743 for (i = 0; i < len; i++) 744 { 745 QUIT; 746 if (i) 747 fprintf_filtered (stream, ", "); 748 wrap_here (" "); 749 fputs_filtered (TYPE_FIELD_NAME (type, i), stream); 750 if (lastval != TYPE_FIELD_BITPOS (type, i)) 751 { 752 fprintf_filtered (stream, " := %d", TYPE_FIELD_BITPOS (type, i)); 753 lastval = TYPE_FIELD_BITPOS (type, i); 754 } 755 lastval++; 756 } 757 fprintf_filtered (stream, ")"); 758 } 759 break; 760 761 case TYPE_CODE_VOID: 762 fprintf_filtered (stream, "void"); 763 break; 764 765 case TYPE_CODE_UNDEF: 766 fprintf_filtered (stream, "record <unknown>"); 767 break; 768 769 case TYPE_CODE_ERROR: 770 fprintf_filtered (stream, "<unknown type>"); 771 break; 772 773 /* this probably does not work for enums */ 774 case TYPE_CODE_RANGE: 775 { 776 struct type *target = TYPE_TARGET_TYPE (type); 777 if (target == NULL) 778 target = builtin_type_long; 779 print_type_scalar (target, TYPE_LOW_BOUND (type), stream); 780 fputs_filtered ("..", stream); 781 print_type_scalar (target, TYPE_HIGH_BOUND (type), stream); 782 } 783 break; 784 785 case TYPE_CODE_SET: 786 fputs_filtered ("set of ", stream); 787 pascal_print_type (TYPE_INDEX_TYPE (type), "", stream, 788 show - 1, level); 789 break; 790 791 case TYPE_CODE_BITSTRING: 792 fputs_filtered ("BitString", stream); 793 break; 794 795 case TYPE_CODE_STRING: 796 fputs_filtered ("String", stream); 797 break; 798 799 default: 800 /* Handle types not explicitly handled by the other cases, 801 such as fundamental types. For these, just print whatever 802 the type name is, as recorded in the type itself. If there 803 is no type name, then complain. */ 804 if (TYPE_NAME (type) != NULL) 805 { 806 fputs_filtered (TYPE_NAME (type), stream); 807 } 808 else 809 { 810 /* At least for dump_symtab, it is important that this not be 811 an error (). */ 812 fprintf_filtered (stream, "<invalid unnamed pascal type code %d>", 813 TYPE_CODE (type)); 814 } 815 break; 816 } 817} 818