1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright (C) 2000, 2001, 2002, 2006, 2007 Free Software Foundation, Inc.
4 This file is part of GDB.
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.
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.
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
18 Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA. */
21 /* This file is derived from p-typeprint.c */
24 #include "gdb_obstack.h"
25 #include "bfd.h" /* Binary File Description */
28 #include "expression.h"
34 #include "typeprint.h"
36 #include "gdb_string.h"
40 static void pascal_type_print_varspec_suffix (struct type
*, struct ui_file
*, int, int, int);
42 static void pascal_type_print_derivation_info (struct ui_file
*, struct type
*);
44 void pascal_type_print_varspec_prefix (struct type
*, struct ui_file
*, int, int);
47 /* LEVEL is the depth to indent lines by. */
50 pascal_print_type (struct type
*type
, char *varstring
, struct ui_file
*stream
,
56 code
= TYPE_CODE (type
);
61 if ((code
== TYPE_CODE_FUNC
||
62 code
== TYPE_CODE_METHOD
))
64 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
67 fputs_filtered (varstring
, stream
);
69 if ((varstring
!= NULL
&& *varstring
!= '\0') &&
70 !(code
== TYPE_CODE_FUNC
||
71 code
== TYPE_CODE_METHOD
))
73 fputs_filtered (" : ", stream
);
76 if (!(code
== TYPE_CODE_FUNC
||
77 code
== TYPE_CODE_METHOD
))
79 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
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 */
86 demangled_args
= varstring
? strchr (varstring
, '(') != NULL
: 0;
87 pascal_type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
);
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:
96 class B : public A {int b; };
97 class C : public B {int c; };
99 Print the type of class C as:
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:
108 class C : public B : public A {
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. */
116 pascal_type_print_derivation_info (struct ui_file
*stream
, struct type
*type
)
121 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
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)");
132 fputs_filtered (" ", stream
);
136 /* Print the Pascal method arguments ARGS to the file STREAM. */
139 pascal_type_print_method_args (char *physname
, char *methodname
,
140 struct ui_file
*stream
)
142 int is_constructor
= DEPRECATED_STREQN (physname
, "__ct__", 6);
143 int is_destructor
= DEPRECATED_STREQN (physname
, "__dt__", 6);
145 if (is_constructor
|| is_destructor
)
150 fputs_filtered (methodname
, stream
);
152 if (physname
&& (*physname
!= 0))
158 fputs_filtered (" (", stream
);
159 /* we must demangle this */
160 while (isdigit (physname
[0]))
162 while (isdigit (physname
[len
]))
166 i
= strtol (physname
, &argname
, 0);
168 storec
= physname
[i
];
170 fputs_filtered (physname
, stream
);
171 physname
[i
] = storec
;
173 if (physname
[0] != 0)
175 fputs_filtered (", ", stream
);
178 fputs_filtered (")", stream
);
182 /* Print any asterisks or open-parentheses needed before the
183 variable name (to describe its type).
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. */
191 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
192 int show
, int passed_a_ptr
)
198 if (TYPE_NAME (type
) && show
<= 0)
203 switch (TYPE_CODE (type
))
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 */
210 case TYPE_CODE_METHOD
:
212 fprintf_filtered (stream
, "(");
213 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
215 fprintf_filtered (stream
, "function ");
219 fprintf_filtered (stream
, "procedure ");
224 fprintf_filtered (stream
, " ");
225 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
226 fprintf_filtered (stream
, "::");
231 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
232 fprintf_filtered (stream
, "&");
237 fprintf_filtered (stream
, "(");
239 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
241 fprintf_filtered (stream
, "function ");
245 fprintf_filtered (stream
, "procedure ");
250 case TYPE_CODE_ARRAY
:
252 fprintf_filtered (stream
, "(");
253 fprintf_filtered (stream
, "array ");
254 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
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
)
260 fprintf_filtered (stream
, "of ");
263 case TYPE_CODE_UNDEF
:
264 case TYPE_CODE_STRUCT
:
265 case TYPE_CODE_UNION
:
270 case TYPE_CODE_ERROR
:
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. */
284 error (_("type not handled in pascal_type_print_varspec_prefix()"));
290 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
292 int i
, len
= TYPE_NFIELDS (type
);
295 fprintf_filtered (stream
, "(");
297 for (i
= 0; i
< len
; i
++)
301 fputs_filtered (", ", stream
);
304 /* can we find if it is a var parameter ??
305 if ( TYPE_FIELD(type, i) == )
307 fprintf_filtered (stream, "var ");
309 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME seems invalid ! */
314 fprintf_filtered (stream
, ")");
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. */
323 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
324 int show
, int passed_a_ptr
,
330 if (TYPE_NAME (type
) && show
<= 0)
335 switch (TYPE_CODE (type
))
337 case TYPE_CODE_ARRAY
:
339 fprintf_filtered (stream
, ")");
342 case TYPE_CODE_METHOD
:
344 fprintf_filtered (stream
, ")");
345 pascal_type_print_method_args ("",
348 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
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,
360 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 1, 0);
365 fprintf_filtered (stream
, ")");
367 pascal_print_func_args (type
, stream
);
368 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
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,
378 case TYPE_CODE_UNDEF
:
379 case TYPE_CODE_STRUCT
:
380 case TYPE_CODE_UNION
:
385 case TYPE_CODE_ERROR
:
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. */
399 error (_("type not handled in pascal_type_print_varspec_suffix()"));
404 /* Print the name of the type (or the ultimate pointer target,
405 function value or array element), or the description of a
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
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;}".
417 LEVEL is the number of spaces to indent by.
418 We increase it for some recursive calls. */
421 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
429 s_none
, s_public
, s_private
, s_protected
437 fputs_filtered ("<type unknown>", stream
);
442 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
) && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
444 fputs_filtered (TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer",
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. */
452 && TYPE_NAME (type
) != NULL
)
454 fputs_filtered (TYPE_NAME (type
), stream
);
458 CHECK_TYPEDEF (type
);
460 switch (TYPE_CODE (type
))
462 case TYPE_CODE_TYPEDEF
:
465 /* case TYPE_CODE_FUNC:
466 case TYPE_CODE_METHOD: */
467 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
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);
478 case TYPE_CODE_METHOD
:
480 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
481 only after args !! */
483 case TYPE_CODE_STRUCT
:
484 if (TYPE_TAG_NAME (type
) != NULL
)
486 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
487 fputs_filtered (" = ", stream
);
489 if (HAVE_CPLUS_STRUCT (type
))
491 fprintf_filtered (stream
, "class ");
495 fprintf_filtered (stream
, "record ");
499 case TYPE_CODE_UNION
:
500 if (TYPE_TAG_NAME (type
) != NULL
)
502 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
503 fputs_filtered (" = ", stream
);
505 fprintf_filtered (stream
, "case <?> of ");
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
, "{...}");
515 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
517 pascal_type_print_derivation_info (stream
, type
);
519 fprintf_filtered (stream
, "\n");
520 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
522 if (TYPE_STUB (type
))
523 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
525 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
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. */
532 section_type
= s_none
;
534 /* If there is a base class for this type,
535 do not print the field that it occupies. */
537 len
= TYPE_NFIELDS (type
);
538 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
541 /* Don't print out virtual function table. */
542 if (DEPRECATED_STREQN (TYPE_FIELD_NAME (type
, i
), "_vptr", 5)
543 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
546 /* If this is a pascal object or class we can print the
547 various section labels. */
549 if (HAVE_CPLUS_STRUCT (type
))
551 if (TYPE_FIELD_PROTECTED (type
, i
))
553 if (section_type
!= s_protected
)
555 section_type
= s_protected
;
556 fprintfi_filtered (level
+ 2, stream
,
560 else if (TYPE_FIELD_PRIVATE (type
, i
))
562 if (section_type
!= s_private
)
564 section_type
= s_private
;
565 fprintfi_filtered (level
+ 2, stream
, "private\n");
570 if (section_type
!= s_public
)
572 section_type
= s_public
;
573 fprintfi_filtered (level
+ 2, stream
, "public\n");
578 print_spaces_filtered (level
+ 4, stream
);
579 if (TYPE_FIELD_STATIC (type
, i
))
581 fprintf_filtered (stream
, "static ");
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
))
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
));
597 fprintf_filtered (stream
, ";\n");
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");
605 /* Pbject pascal: print out the methods */
607 for (i
= 0; i
< len
; i
++)
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
++)
618 char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
620 int is_constructor
= DEPRECATED_STREQN (physname
, "__ct__", 6);
621 int is_destructor
= DEPRECATED_STREQN (physname
, "__dt__", 6);
624 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
626 if (section_type
!= s_protected
)
628 section_type
= s_protected
;
629 fprintfi_filtered (level
+ 2, stream
,
633 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
635 if (section_type
!= s_private
)
637 section_type
= s_private
;
638 fprintfi_filtered (level
+ 2, stream
, "private\n");
643 if (section_type
!= s_public
)
645 section_type
= s_public
;
646 fprintfi_filtered (level
+ 2, stream
, "public\n");
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)
655 /* Keep GDB from crashing here. */
656 fprintf_filtered (stream
, "<undefined type> %s;\n",
657 TYPE_FN_FIELD_PHYSNAME (f
, j
));
663 fprintf_filtered (stream
, "constructor ");
665 else if (is_destructor
)
667 fprintf_filtered (stream
, "destructor ");
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
)
672 fprintf_filtered (stream
, "function ");
676 fprintf_filtered (stream
, "procedure ");
678 /* this does not work, no idea why !! */
680 pascal_type_print_method_args (physname
,
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
)
687 fputs_filtered (" : ", stream
);
688 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
691 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
692 fprintf_filtered (stream
, "; virtual");
694 fprintf_filtered (stream
, ";\n");
697 fprintfi_filtered (level
, stream
, "end");
702 if (TYPE_TAG_NAME (type
) != NULL
)
704 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
706 fputs_filtered (" ", stream
);
708 /* enum is just defined by
709 type enume_name = (enum_member1,enum_member2,...) */
710 fprintf_filtered (stream
, " = ");
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
, "(...)");
718 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
720 fprintf_filtered (stream
, "(");
721 len
= TYPE_NFIELDS (type
);
723 for (i
= 0; i
< len
; i
++)
727 fprintf_filtered (stream
, ", ");
729 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
730 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
732 fprintf_filtered (stream
, " := %d", TYPE_FIELD_BITPOS (type
, i
));
733 lastval
= TYPE_FIELD_BITPOS (type
, i
);
737 fprintf_filtered (stream
, ")");
742 fprintf_filtered (stream
, "void");
745 case TYPE_CODE_UNDEF
:
746 fprintf_filtered (stream
, "record <unknown>");
749 case TYPE_CODE_ERROR
:
750 fprintf_filtered (stream
, "<unknown type>");
753 /* this probably does not work for enums */
754 case TYPE_CODE_RANGE
:
756 struct type
*target
= TYPE_TARGET_TYPE (type
);
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
);
766 fputs_filtered ("set of ", stream
);
767 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
771 case TYPE_CODE_BITSTRING
:
772 fputs_filtered ("BitString", stream
);
775 case TYPE_CODE_STRING
:
776 fputs_filtered ("String", stream
);
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
)
786 fputs_filtered (TYPE_NAME (type
), stream
);
790 /* At least for dump_symtab, it is important that this not be
792 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",