]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/p-typeprint.c
Copyright updates for 2007.
[thirdparty/binutils-gdb.git] / gdb / p-typeprint.c
CommitLineData
373a8247 1/* Support for printing Pascal types for GDB, the GNU debugger.
6aba47ca 2 Copyright (C) 2000, 2001, 2002, 2006, 2007 Free Software Foundation, Inc.
373a8247
PM
3
4 This file is part of GDB.
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
197e01b6
EZ
18 Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA. */
373a8247
PM
20
21/* This file is derived from p-typeprint.c */
22
23#include "defs.h"
04ea0df1 24#include "gdb_obstack.h"
373a8247
PM
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"
373a8247 32#include "language.h"
373a8247
PM
33#include "p-lang.h"
34#include "typeprint.h"
35
36#include "gdb_string.h"
37#include <errno.h>
38#include <ctype.h>
39
373a8247
PM
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\f
46
47/* LEVEL is the depth to indent lines by. */
48
49void
fba45db2
KB
50pascal_print_type (struct type *type, char *varstring, struct ui_file *stream,
51 int show, int level)
373a8247 52{
52f0bd74 53 enum type_code code;
373a8247
PM
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
fba45db2 116pascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
373a8247
PM
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
fba45db2
KB
139pascal_type_print_method_args (char *physname, char *methodname,
140 struct ui_file *stream)
373a8247 141{
cb137aa5
AC
142 int is_constructor = DEPRECATED_STREQN (physname, "__ct__", 6);
143 int is_destructor = DEPRECATED_STREQN (physname, "__dt__", 6);
373a8247
PM
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 */
8ce17b9a 160 while (isdigit (physname[0]))
373a8247 161 {
8ce17b9a 162 while (isdigit (physname[len]))
373a8247
PM
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
fba45db2
KB
191pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
192 int show, int passed_a_ptr)
373a8247
PM
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
373a8247
PM
210 case TYPE_CODE_METHOD:
211 if (passed_a_ptr)
212 fprintf_filtered (stream, "(");
213 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
214 {
215 fprintf_filtered (stream, "function ");
216 }
217 else
218 {
219 fprintf_filtered (stream, "procedure ");
220 }
221
222 if (passed_a_ptr)
223 {
224 fprintf_filtered (stream, " ");
225 pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
226 fprintf_filtered (stream, "::");
227 }
228 break;
229
230 case TYPE_CODE_REF:
231 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
232 fprintf_filtered (stream, "&");
233 break;
234
235 case TYPE_CODE_FUNC:
236 if (passed_a_ptr)
237 fprintf_filtered (stream, "(");
238
239 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
240 {
241 fprintf_filtered (stream, "function ");
242 }
243 else
244 {
245 fprintf_filtered (stream, "procedure ");
246 }
247
248 break;
249
250 case TYPE_CODE_ARRAY:
251 if (passed_a_ptr)
252 fprintf_filtered (stream, "(");
253 fprintf_filtered (stream, "array ");
d5d6fca5 254 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
373a8247
PM
255 && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED)
256 fprintf_filtered (stream, "[%d..%d] ",
257 TYPE_ARRAY_LOWER_BOUND_VALUE (type),
258 TYPE_ARRAY_UPPER_BOUND_VALUE (type)
259 );
260 fprintf_filtered (stream, "of ");
261 break;
262
263 case TYPE_CODE_UNDEF:
264 case TYPE_CODE_STRUCT:
265 case TYPE_CODE_UNION:
266 case TYPE_CODE_ENUM:
267 case TYPE_CODE_INT:
268 case TYPE_CODE_FLT:
269 case TYPE_CODE_VOID:
270 case TYPE_CODE_ERROR:
271 case TYPE_CODE_CHAR:
272 case TYPE_CODE_BOOL:
273 case TYPE_CODE_SET:
274 case TYPE_CODE_RANGE:
275 case TYPE_CODE_STRING:
276 case TYPE_CODE_BITSTRING:
277 case TYPE_CODE_COMPLEX:
278 case TYPE_CODE_TYPEDEF:
279 case TYPE_CODE_TEMPLATE:
280 /* These types need no prefix. They are listed here so that
281 gcc -Wall will reveal any types that haven't been handled. */
282 break;
283 default:
8a3fe4f8 284 error (_("type not handled in pascal_type_print_varspec_prefix()"));
373a8247
PM
285 break;
286 }
287}
288
373a8247
PM
289static void
290pascal_print_func_args (struct type *type, struct ui_file *stream)
291{
292 int i, len = TYPE_NFIELDS (type);
293 if (len)
294 {
295 fprintf_filtered (stream, "(");
296 }
297 for (i = 0; i < len; i++)
298 {
299 if (i > 0)
300 {
301 fputs_filtered (", ", stream);
302 wrap_here (" ");
303 }
304 /* can we find if it is a var parameter ??
305 if ( TYPE_FIELD(type, i) == )
306 {
307 fprintf_filtered (stream, "var ");
308 } */
309 pascal_print_type (TYPE_FIELD_TYPE (type, i), "" /* TYPE_FIELD_NAME seems invalid ! */
310 ,stream, -1, 0);
311 }
312 if (len)
313 {
314 fprintf_filtered (stream, ")");
315 }
316}
317
318/* Print any array sizes, function arguments or close parentheses
319 needed after the variable name (to describe its type).
320 Args work like pascal_type_print_varspec_prefix. */
321
322static void
fba45db2
KB
323pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
324 int show, int passed_a_ptr,
325 int demangled_args)
373a8247
PM
326{
327 if (type == 0)
328 return;
329
330 if (TYPE_NAME (type) && show <= 0)
331 return;
332
333 QUIT;
334
335 switch (TYPE_CODE (type))
336 {
337 case TYPE_CODE_ARRAY:
338 if (passed_a_ptr)
339 fprintf_filtered (stream, ")");
340 break;
341
373a8247
PM
342 case TYPE_CODE_METHOD:
343 if (passed_a_ptr)
344 fprintf_filtered (stream, ")");
345 pascal_type_print_method_args ("",
346 "",
347 stream);
373a8247
PM
348 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
349 {
350 fprintf_filtered (stream, " : ");
351 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
352 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
353 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
354 passed_a_ptr, 0);
355 }
356 break;
357
358 case TYPE_CODE_PTR:
359 case TYPE_CODE_REF:
360 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
361 break;
362
363 case TYPE_CODE_FUNC:
364 if (passed_a_ptr)
365 fprintf_filtered (stream, ")");
366 if (!demangled_args)
367 pascal_print_func_args (type, stream);
368 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
369 {
370 fprintf_filtered (stream, " : ");
371 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
372 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
373 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
374 passed_a_ptr, 0);
375 }
376 break;
377
378 case TYPE_CODE_UNDEF:
379 case TYPE_CODE_STRUCT:
380 case TYPE_CODE_UNION:
381 case TYPE_CODE_ENUM:
382 case TYPE_CODE_INT:
383 case TYPE_CODE_FLT:
384 case TYPE_CODE_VOID:
385 case TYPE_CODE_ERROR:
386 case TYPE_CODE_CHAR:
387 case TYPE_CODE_BOOL:
388 case TYPE_CODE_SET:
389 case TYPE_CODE_RANGE:
390 case TYPE_CODE_STRING:
391 case TYPE_CODE_BITSTRING:
392 case TYPE_CODE_COMPLEX:
393 case TYPE_CODE_TYPEDEF:
394 case TYPE_CODE_TEMPLATE:
395 /* These types do not need a suffix. They are listed so that
396 gcc -Wall will report types that may not have been considered. */
397 break;
398 default:
8a3fe4f8 399 error (_("type not handled in pascal_type_print_varspec_suffix()"));
373a8247
PM
400 break;
401 }
402}
403
404/* Print the name of the type (or the ultimate pointer target,
405 function value or array element), or the description of a
406 structure or union.
407
408 SHOW positive means print details about the type (e.g. enum values),
409 and print structure elements passing SHOW - 1 for show.
410 SHOW negative means just print the type name or struct tag if there is one.
411 If there is no name, print something sensible but concise like
412 "struct {...}".
413 SHOW zero means just print the type name or struct tag if there is one.
414 If there is no name, print something sensible but not as concise like
415 "struct {int x; int y;}".
416
417 LEVEL is the number of spaces to indent by.
418 We increase it for some recursive calls. */
419
420void
fba45db2
KB
421pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
422 int level)
373a8247 423{
52f0bd74
AC
424 int i;
425 int len;
426 int lastval;
373a8247
PM
427 enum
428 {
429 s_none, s_public, s_private, s_protected
430 }
431 section_type;
432 QUIT;
433
434 wrap_here (" ");
435 if (type == NULL)
436 {
437 fputs_filtered ("<type unknown>", stream);
438 return;
439 }
440
441 /* void pointer */
442 if ((TYPE_CODE (type) == TYPE_CODE_PTR) && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
443 {
306d9ac5
DC
444 fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
445 stream);
373a8247
PM
446 return;
447 }
448 /* When SHOW is zero or less, and there is a valid type name, then always
449 just print the type name directly from the type. */
450
451 if (show <= 0
452 && TYPE_NAME (type) != NULL)
453 {
454 fputs_filtered (TYPE_NAME (type), stream);
455 return;
456 }
457
458 CHECK_TYPEDEF (type);
459
460 switch (TYPE_CODE (type))
461 {
462 case TYPE_CODE_TYPEDEF:
463 case TYPE_CODE_PTR:
373a8247
PM
464 case TYPE_CODE_REF:
465 /* case TYPE_CODE_FUNC:
466 case TYPE_CODE_METHOD: */
467 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
468 break;
469
470 case TYPE_CODE_ARRAY:
471 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
472 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
473 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
474 pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0);
475 break;
476
477 case TYPE_CODE_FUNC:
478 case TYPE_CODE_METHOD:
479 /*
480 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
481 only after args !! */
482 break;
483 case TYPE_CODE_STRUCT:
484 if (TYPE_TAG_NAME (type) != NULL)
485 {
486 fputs_filtered (TYPE_TAG_NAME (type), stream);
487 fputs_filtered (" = ", stream);
488 }
489 if (HAVE_CPLUS_STRUCT (type))
490 {
491 fprintf_filtered (stream, "class ");
492 }
493 else
494 {
495 fprintf_filtered (stream, "record ");
496 }
497 goto struct_union;
498
499 case TYPE_CODE_UNION:
500 if (TYPE_TAG_NAME (type) != NULL)
501 {
502 fputs_filtered (TYPE_TAG_NAME (type), stream);
503 fputs_filtered (" = ", stream);
504 }
505 fprintf_filtered (stream, "case <?> of ");
506
507 struct_union:
508 wrap_here (" ");
509 if (show < 0)
510 {
511 /* If we just printed a tag name, no need to print anything else. */
512 if (TYPE_TAG_NAME (type) == NULL)
513 fprintf_filtered (stream, "{...}");
514 }
515 else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
516 {
517 pascal_type_print_derivation_info (stream, type);
518
519 fprintf_filtered (stream, "\n");
520 if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
521 {
74a9bb82 522 if (TYPE_STUB (type))
373a8247
PM
523 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
524 else
525 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
526 }
527
528 /* Start off with no specific section type, so we can print
529 one for the first field we find, and use that section type
530 thereafter until we find another type. */
531
532 section_type = s_none;
533
534 /* If there is a base class for this type,
535 do not print the field that it occupies. */
536
537 len = TYPE_NFIELDS (type);
538 for (i = TYPE_N_BASECLASSES (type); i < len; i++)
539 {
540 QUIT;
541 /* Don't print out virtual function table. */
cb137aa5 542 if (DEPRECATED_STREQN (TYPE_FIELD_NAME (type, i), "_vptr", 5)
373a8247
PM
543 && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
544 continue;
545
546 /* If this is a pascal object or class we can print the
547 various section labels. */
548
549 if (HAVE_CPLUS_STRUCT (type))
550 {
551 if (TYPE_FIELD_PROTECTED (type, i))
552 {
553 if (section_type != s_protected)
554 {
555 section_type = s_protected;
556 fprintfi_filtered (level + 2, stream,
557 "protected\n");
558 }
559 }
560 else if (TYPE_FIELD_PRIVATE (type, i))
561 {
562 if (section_type != s_private)
563 {
564 section_type = s_private;
565 fprintfi_filtered (level + 2, stream, "private\n");
566 }
567 }
568 else
569 {
570 if (section_type != s_public)
571 {
572 section_type = s_public;
573 fprintfi_filtered (level + 2, stream, "public\n");
574 }
575 }
576 }
577
578 print_spaces_filtered (level + 4, stream);
579 if (TYPE_FIELD_STATIC (type, i))
580 {
581 fprintf_filtered (stream, "static ");
582 }
583 pascal_print_type (TYPE_FIELD_TYPE (type, i),
584 TYPE_FIELD_NAME (type, i),
585 stream, show - 1, level + 4);
586 if (!TYPE_FIELD_STATIC (type, i)
587 && TYPE_FIELD_PACKED (type, i))
588 {
589 /* It is a bitfield. This code does not attempt
590 to look at the bitpos and reconstruct filler,
591 unnamed fields. This would lead to misleading
592 results if the compiler does not put out fields
593 for such things (I don't know what it does). */
594 fprintf_filtered (stream, " : %d",
595 TYPE_FIELD_BITSIZE (type, i));
596 }
597 fprintf_filtered (stream, ";\n");
598 }
599
600 /* If there are both fields and methods, put a space between. */
601 len = TYPE_NFN_FIELDS (type);
602 if (len && section_type != s_none)
603 fprintf_filtered (stream, "\n");
604
605 /* Pbject pascal: print out the methods */
606
607 for (i = 0; i < len; i++)
608 {
609 struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
610 int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
611 char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
612 char *name = type_name_no_tag (type);
613 /* this is GNU C++ specific
614 how can we know constructor/destructor?
615 It might work for GNU pascal */
616 for (j = 0; j < len2; j++)
617 {
618 char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
619
cb137aa5
AC
620 int is_constructor = DEPRECATED_STREQN (physname, "__ct__", 6);
621 int is_destructor = DEPRECATED_STREQN (physname, "__dt__", 6);
373a8247
PM
622
623 QUIT;
624 if (TYPE_FN_FIELD_PROTECTED (f, j))
625 {
626 if (section_type != s_protected)
627 {
628 section_type = s_protected;
629 fprintfi_filtered (level + 2, stream,
630 "protected\n");
631 }
632 }
633 else if (TYPE_FN_FIELD_PRIVATE (f, j))
634 {
635 if (section_type != s_private)
636 {
637 section_type = s_private;
638 fprintfi_filtered (level + 2, stream, "private\n");
639 }
640 }
641 else
642 {
643 if (section_type != s_public)
644 {
645 section_type = s_public;
646 fprintfi_filtered (level + 2, stream, "public\n");
647 }
648 }
649
650 print_spaces_filtered (level + 4, stream);
651 if (TYPE_FN_FIELD_STATIC_P (f, j))
652 fprintf_filtered (stream, "static ");
653 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
654 {
655 /* Keep GDB from crashing here. */
656 fprintf_filtered (stream, "<undefined type> %s;\n",
657 TYPE_FN_FIELD_PHYSNAME (f, j));
658 break;
659 }
660
661 if (is_constructor)
662 {
663 fprintf_filtered (stream, "constructor ");
664 }
665 else if (is_destructor)
666 {
667 fprintf_filtered (stream, "destructor ");
668 }
669 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 &&
670 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
671 {
672 fprintf_filtered (stream, "function ");
673 }
674 else
675 {
676 fprintf_filtered (stream, "procedure ");
677 }
678 /* this does not work, no idea why !! */
679
680 pascal_type_print_method_args (physname,
681 method_name,
682 stream);
683
684 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 &&
685 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
686 {
687 fputs_filtered (" : ", stream);
688 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
689 "", stream, -1);
690 }
691 if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
692 fprintf_filtered (stream, "; virtual");
693
694 fprintf_filtered (stream, ";\n");
695 }
696 }
697 fprintfi_filtered (level, stream, "end");
698 }
699 break;
700
701 case TYPE_CODE_ENUM:
702 if (TYPE_TAG_NAME (type) != NULL)
703 {
704 fputs_filtered (TYPE_TAG_NAME (type), stream);
705 if (show > 0)
706 fputs_filtered (" ", stream);
707 }
708 /* enum is just defined by
709 type enume_name = (enum_member1,enum_member2,...) */
710 fprintf_filtered (stream, " = ");
711 wrap_here (" ");
712 if (show < 0)
713 {
714 /* If we just printed a tag name, no need to print anything else. */
715 if (TYPE_TAG_NAME (type) == NULL)
716 fprintf_filtered (stream, "(...)");
717 }
718 else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
719 {
720 fprintf_filtered (stream, "(");
721 len = TYPE_NFIELDS (type);
722 lastval = 0;
723 for (i = 0; i < len; i++)
724 {
725 QUIT;
726 if (i)
727 fprintf_filtered (stream, ", ");
728 wrap_here (" ");
729 fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
730 if (lastval != TYPE_FIELD_BITPOS (type, i))
731 {
732 fprintf_filtered (stream, " := %d", TYPE_FIELD_BITPOS (type, i));
733 lastval = TYPE_FIELD_BITPOS (type, i);
734 }
735 lastval++;
736 }
737 fprintf_filtered (stream, ")");
738 }
739 break;
740
741 case TYPE_CODE_VOID:
742 fprintf_filtered (stream, "void");
743 break;
744
745 case TYPE_CODE_UNDEF:
746 fprintf_filtered (stream, "record <unknown>");
747 break;
748
749 case TYPE_CODE_ERROR:
750 fprintf_filtered (stream, "<unknown type>");
751 break;
752
753 /* this probably does not work for enums */
754 case TYPE_CODE_RANGE:
755 {
756 struct type *target = TYPE_TARGET_TYPE (type);
757 if (target == NULL)
758 target = builtin_type_long;
759 print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
760 fputs_filtered ("..", stream);
761 print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
762 }
763 break;
764
765 case TYPE_CODE_SET:
766 fputs_filtered ("set of ", stream);
767 pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
768 show - 1, level);
769 break;
770
6604db2e
PM
771 case TYPE_CODE_BITSTRING:
772 fputs_filtered ("BitString", stream);
773 break;
774
775 case TYPE_CODE_STRING:
776 fputs_filtered ("String", stream);
777 break;
778
373a8247
PM
779 default:
780 /* Handle types not explicitly handled by the other cases,
781 such as fundamental types. For these, just print whatever
782 the type name is, as recorded in the type itself. If there
783 is no type name, then complain. */
784 if (TYPE_NAME (type) != NULL)
785 {
786 fputs_filtered (TYPE_NAME (type), stream);
787 }
788 else
789 {
790 /* At least for dump_symtab, it is important that this not be
791 an error (). */
792 fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
793 TYPE_CODE (type));
794 }
795 break;
796 }
797}