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