1 /* Support for printing Pascal types for GDB, the GNU debugger.
3 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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. */
21 /* This file is derived from p-typeprint.c */
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_args (struct type
*, struct ui_file
*);
42 static void pascal_type_print_varspec_suffix (struct type
*, struct ui_file
*, int, int, int);
44 static void pascal_type_print_derivation_info (struct ui_file
*, struct type
*);
46 void pascal_type_print_varspec_prefix (struct type
*, struct ui_file
*, int, int);
49 /* LEVEL is the depth to indent lines by. */
52 pascal_print_type (struct type
*type
, char *varstring
, struct ui_file
*stream
,
55 register enum type_code code
;
58 code
= TYPE_CODE (type
);
63 if ((code
== TYPE_CODE_FUNC
||
64 code
== TYPE_CODE_METHOD
))
66 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
69 fputs_filtered (varstring
, stream
);
71 if ((varstring
!= NULL
&& *varstring
!= '\0') &&
72 !(code
== TYPE_CODE_FUNC
||
73 code
== TYPE_CODE_METHOD
))
75 fputs_filtered (" : ", stream
);
78 if (!(code
== TYPE_CODE_FUNC
||
79 code
== TYPE_CODE_METHOD
))
81 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
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 */
88 demangled_args
= varstring
? strchr (varstring
, '(') != NULL
: 0;
89 pascal_type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
);
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:
98 class B : public A {int b; };
99 class C : public B {int c; };
101 Print the type of class C as:
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:
110 class C : public B : public A {
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. */
118 pascal_type_print_derivation_info (struct ui_file
*stream
, struct type
*type
)
123 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
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)");
134 fputs_filtered (" ", stream
);
138 /* Print the Pascal method arguments ARGS to the file STREAM. */
141 pascal_type_print_method_args (char *physname
, char *methodname
,
142 struct ui_file
*stream
)
144 int is_constructor
= STREQN (physname
, "__ct__", 6);
145 int is_destructor
= STREQN (physname
, "__dt__", 6);
147 if (is_constructor
|| is_destructor
)
152 fputs_filtered (methodname
, stream
);
154 if (physname
&& (*physname
!= 0))
160 fputs_filtered (" (", stream
);
161 /* we must demangle this */
162 while (isdigit (physname
[0]))
164 while (isdigit (physname
[len
]))
168 i
= strtol (physname
, &argname
, 0);
170 storec
= physname
[i
];
172 fputs_filtered (physname
, stream
);
173 physname
[i
] = storec
;
175 if (physname
[0] != 0)
177 fputs_filtered (", ", stream
);
180 fputs_filtered (")", stream
);
184 /* Print any asterisks or open-parentheses needed before the
185 variable name (to describe its type).
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. */
193 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
194 int show
, int passed_a_ptr
)
200 if (TYPE_NAME (type
) && show
<= 0)
205 switch (TYPE_CODE (type
))
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 */
212 case TYPE_CODE_MEMBER
:
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
));
219 fputs_filtered (name
, stream
);
221 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
222 fprintf_filtered (stream
, "::");
225 case TYPE_CODE_METHOD
:
227 fprintf_filtered (stream
, "(");
228 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
230 fprintf_filtered (stream
, "function ");
234 fprintf_filtered (stream
, "procedure ");
239 fprintf_filtered (stream
, " ");
240 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
241 fprintf_filtered (stream
, "::");
246 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
247 fprintf_filtered (stream
, "&");
252 fprintf_filtered (stream
, "(");
254 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
256 fprintf_filtered (stream
, "function ");
260 fprintf_filtered (stream
, "procedure ");
265 case TYPE_CODE_ARRAY
:
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
)
275 fprintf_filtered (stream
, "of ");
278 case TYPE_CODE_UNDEF
:
279 case TYPE_CODE_STRUCT
:
280 case TYPE_CODE_UNION
:
285 case TYPE_CODE_ERROR
:
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. */
299 error ("type not handled in pascal_type_print_varspec_prefix()");
305 pascal_type_print_args (struct type
*type
, struct ui_file
*stream
)
310 /* fprintf_filtered (stream, "(");
311 no () for procedures !! */
312 args
= TYPE_ARG_TYPES (type
);
315 if ((args
[1] != NULL
&& args
[1]->code
!= TYPE_CODE_VOID
) ||
318 fprintf_filtered (stream
, "(");
322 fprintf_filtered (stream
, "...");
327 args
[i
] != NULL
&& args
[i
]->code
!= TYPE_CODE_VOID
;
330 pascal_print_type (args
[i
], "", stream
, -1, 0);
331 if (args
[i
+ 1] == NULL
)
333 fprintf_filtered (stream
, "...");
335 else if (args
[i
+ 1]->code
!= TYPE_CODE_VOID
)
337 fprintf_filtered (stream
, ",");
342 if ((args
[1] != NULL
&& args
[1]->code
!= TYPE_CODE_VOID
) ||
345 fprintf_filtered (stream
, ")");
351 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
353 int i
, len
= TYPE_NFIELDS (type
);
356 fprintf_filtered (stream
, "(");
358 for (i
= 0; i
< len
; i
++)
362 fputs_filtered (", ", stream
);
365 /* can we find if it is a var parameter ??
366 if ( TYPE_FIELD(type, i) == )
368 fprintf_filtered (stream, "var ");
370 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME seems invalid ! */
375 fprintf_filtered (stream
, ")");
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. */
384 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
385 int show
, int passed_a_ptr
,
391 if (TYPE_NAME (type
) && show
<= 0)
396 switch (TYPE_CODE (type
))
398 case TYPE_CODE_ARRAY
:
400 fprintf_filtered (stream
, ")");
403 case TYPE_CODE_MEMBER
:
405 fprintf_filtered (stream
, ")");
406 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 0, 0);
409 case TYPE_CODE_METHOD
:
411 fprintf_filtered (stream
, ")");
412 pascal_type_print_method_args ("",
415 /* pascal_type_print_args (type, stream); */
416 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
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,
428 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 1, 0);
433 fprintf_filtered (stream
, ")");
435 pascal_print_func_args (type
, stream
);
436 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
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,
446 case TYPE_CODE_UNDEF
:
447 case TYPE_CODE_STRUCT
:
448 case TYPE_CODE_UNION
:
453 case TYPE_CODE_ERROR
:
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. */
467 error ("type not handled in pascal_type_print_varspec_suffix()");
472 /* Print the name of the type (or the ultimate pointer target,
473 function value or array element), or the description of a
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
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;}".
485 LEVEL is the number of spaces to indent by.
486 We increase it for some recursive calls. */
489 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
494 register int lastval
;
497 s_none
, s_public
, s_private
, s_protected
505 fputs_filtered ("<type unknown>", stream
);
510 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
) && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
512 fprintf_filtered (stream
,
513 TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer");
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. */
520 && TYPE_NAME (type
) != NULL
)
522 fputs_filtered (TYPE_NAME (type
), stream
);
526 CHECK_TYPEDEF (type
);
528 switch (TYPE_CODE (type
))
530 case TYPE_CODE_TYPEDEF
:
532 case TYPE_CODE_MEMBER
:
534 /* case TYPE_CODE_FUNC:
535 case TYPE_CODE_METHOD: */
536 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
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);
547 case TYPE_CODE_METHOD
:
549 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
550 only after args !! */
552 case TYPE_CODE_STRUCT
:
553 if (TYPE_TAG_NAME (type
) != NULL
)
555 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
556 fputs_filtered (" = ", stream
);
558 if (HAVE_CPLUS_STRUCT (type
))
560 fprintf_filtered (stream
, "class ");
564 fprintf_filtered (stream
, "record ");
568 case TYPE_CODE_UNION
:
569 if (TYPE_TAG_NAME (type
) != NULL
)
571 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
572 fputs_filtered (" = ", stream
);
574 fprintf_filtered (stream
, "case <?> of ");
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
, "{...}");
584 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
586 pascal_type_print_derivation_info (stream
, type
);
588 fprintf_filtered (stream
, "\n");
589 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
591 if (TYPE_STUB (type
))
592 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
594 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
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. */
601 section_type
= s_none
;
603 /* If there is a base class for this type,
604 do not print the field that it occupies. */
606 len
= TYPE_NFIELDS (type
);
607 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
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]))
615 /* If this is a pascal object or class we can print the
616 various section labels. */
618 if (HAVE_CPLUS_STRUCT (type
))
620 if (TYPE_FIELD_PROTECTED (type
, i
))
622 if (section_type
!= s_protected
)
624 section_type
= s_protected
;
625 fprintfi_filtered (level
+ 2, stream
,
629 else if (TYPE_FIELD_PRIVATE (type
, i
))
631 if (section_type
!= s_private
)
633 section_type
= s_private
;
634 fprintfi_filtered (level
+ 2, stream
, "private\n");
639 if (section_type
!= s_public
)
641 section_type
= s_public
;
642 fprintfi_filtered (level
+ 2, stream
, "public\n");
647 print_spaces_filtered (level
+ 4, stream
);
648 if (TYPE_FIELD_STATIC (type
, i
))
650 fprintf_filtered (stream
, "static ");
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
))
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
));
666 fprintf_filtered (stream
, ";\n");
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");
674 /* Pbject pascal: print out the methods */
676 for (i
= 0; i
< len
; i
++)
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
++)
687 char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
689 int is_constructor
= STREQN (physname
, "__ct__", 6);
690 int is_destructor
= STREQN (physname
, "__dt__", 6);
693 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
695 if (section_type
!= s_protected
)
697 section_type
= s_protected
;
698 fprintfi_filtered (level
+ 2, stream
,
702 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
704 if (section_type
!= s_private
)
706 section_type
= s_private
;
707 fprintfi_filtered (level
+ 2, stream
, "private\n");
712 if (section_type
!= s_public
)
714 section_type
= s_public
;
715 fprintfi_filtered (level
+ 2, stream
, "public\n");
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)
724 /* Keep GDB from crashing here. */
725 fprintf_filtered (stream
, "<undefined type> %s;\n",
726 TYPE_FN_FIELD_PHYSNAME (f
, j
));
732 fprintf_filtered (stream
, "constructor ");
734 else if (is_destructor
)
736 fprintf_filtered (stream
, "destructor ");
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
)
741 fprintf_filtered (stream
, "function ");
745 fprintf_filtered (stream
, "procedure ");
747 /* this does not work, no idea why !! */
749 pascal_type_print_method_args (physname
,
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
)
756 fputs_filtered (" : ", stream
);
757 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
760 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
761 fprintf_filtered (stream
, "; virtual");
763 fprintf_filtered (stream
, ";\n");
766 fprintfi_filtered (level
, stream
, "end");
771 if (TYPE_TAG_NAME (type
) != NULL
)
773 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
775 fputs_filtered (" ", stream
);
777 /* enum is just defined by
778 type enume_name = (enum_member1,enum_member2,...) */
779 fprintf_filtered (stream
, " = ");
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
, "(...)");
787 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
789 fprintf_filtered (stream
, "(");
790 len
= TYPE_NFIELDS (type
);
792 for (i
= 0; i
< len
; i
++)
796 fprintf_filtered (stream
, ", ");
798 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
799 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
801 fprintf_filtered (stream
, " := %d", TYPE_FIELD_BITPOS (type
, i
));
802 lastval
= TYPE_FIELD_BITPOS (type
, i
);
806 fprintf_filtered (stream
, ")");
811 fprintf_filtered (stream
, "void");
814 case TYPE_CODE_UNDEF
:
815 fprintf_filtered (stream
, "record <unknown>");
818 case TYPE_CODE_ERROR
:
819 fprintf_filtered (stream
, "<unknown type>");
822 /* this probably does not work for enums */
823 case TYPE_CODE_RANGE
:
825 struct type
*target
= TYPE_TARGET_TYPE (type
);
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
);
835 fputs_filtered ("set of ", stream
);
836 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
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
)
847 fputs_filtered (TYPE_NAME (type
), stream
);
851 /* At least for dump_symtab, it is important that this not be
853 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",