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
40 static void pascal_type_print_varspec_suffix (struct type *, struct ui_file *, int, int, int);
41
42 static void pascal_type_print_derivation_info (struct ui_file *, struct type *);
43
44 void pascal_type_print_varspec_prefix (struct type *, struct ui_file *, int, int);
45
46
47 /* LEVEL is the depth to indent lines by. */
48
49 void
pascal_print_type(struct type * type,char * varstring,struct ui_file * stream,int show,int level)50 pascal_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
115 static void
pascal_type_print_derivation_info(struct ui_file * stream,struct type * type)116 pascal_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
138 void
pascal_type_print_method_args(char * physname,char * methodname,struct ui_file * stream)139 pascal_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
190 void
pascal_type_print_varspec_prefix(struct type * type,struct ui_file * stream,int show,int passed_a_ptr)191 pascal_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
302 static void
pascal_print_func_args(struct type * type,struct ui_file * stream)303 pascal_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
335 static void
pascal_type_print_varspec_suffix(struct type * type,struct ui_file * stream,int show,int passed_a_ptr,int demangled_args)336 pascal_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
439 void
pascal_type_print_base(struct type * type,struct ui_file * stream,int show,int level)440 pascal_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