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