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