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"
37 #include "typeprint.h"
39 #include "gdb_string.h"
43 static void pascal_type_print_args (struct type
*, struct ui_file
*);
45 static void pascal_type_print_varspec_suffix (struct type
*, struct ui_file
*, int, int, int);
47 static void pascal_type_print_derivation_info (struct ui_file
*, struct type
*);
49 void pascal_type_print_varspec_prefix (struct type
*, struct ui_file
*, int, int);
52 /* LEVEL is the depth to indent lines by. */
55 pascal_print_type (struct type
*type
, char *varstring
, struct ui_file
*stream
,
58 register enum type_code code
;
61 code
= TYPE_CODE (type
);
66 if ((code
== TYPE_CODE_FUNC
||
67 code
== TYPE_CODE_METHOD
))
69 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
72 fputs_filtered (varstring
, stream
);
74 if ((varstring
!= NULL
&& *varstring
!= '\0') &&
75 !(code
== TYPE_CODE_FUNC
||
76 code
== TYPE_CODE_METHOD
))
78 fputs_filtered (" : ", stream
);
81 if (!(code
== TYPE_CODE_FUNC
||
82 code
== TYPE_CODE_METHOD
))
84 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
87 pascal_type_print_base (type
, stream
, show
, level
);
88 /* For demangled function names, we have the arglist as part of the name,
89 so don't print an additional pair of ()'s */
91 demangled_args
= varstring
? strchr (varstring
, '(') != NULL
: 0;
92 pascal_type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
);
96 /* If TYPE is a derived type, then print out derivation information.
97 Print only the actual base classes of this type, not the base classes
98 of the base classes. I.E. for the derivation hierarchy:
101 class B : public A {int b; };
102 class C : public B {int c; };
104 Print the type of class C as:
110 Not as the following (like gdb used to), which is not legal C++ syntax for
111 derived types and may be confused with the multiple inheritance form:
113 class C : public B : public A {
117 In general, gdb should try to print the types as closely as possible to
118 the form that they appear in the source code. */
121 pascal_type_print_derivation_info (struct ui_file
*stream
, struct type
*type
)
126 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
128 fputs_filtered (i
== 0 ? ": " : ", ", stream
);
129 fprintf_filtered (stream
, "%s%s ",
130 BASETYPE_VIA_PUBLIC (type
, i
) ? "public" : "private",
131 BASETYPE_VIA_VIRTUAL (type
, i
) ? " virtual" : "");
132 name
= type_name_no_tag (TYPE_BASECLASS (type
, i
));
133 fprintf_filtered (stream
, "%s", name
? name
: "(null)");
137 fputs_filtered (" ", stream
);
141 /* Print the Pascal method arguments ARGS to the file STREAM. */
144 pascal_type_print_method_args (char *physname
, char *methodname
,
145 struct ui_file
*stream
)
147 int is_constructor
= STREQN (physname
, "__ct__", 6);
148 int is_destructor
= STREQN (physname
, "__dt__", 6);
150 if (is_constructor
|| is_destructor
)
155 fputs_filtered (methodname
, stream
);
157 if (physname
&& (*physname
!= 0))
163 fputs_filtered (" (", stream
);
164 /* we must demangle this */
165 while (isdigit (physname
[0]))
167 while (isdigit (physname
[len
]))
171 i
= strtol (physname
, &argname
, 0);
173 storec
= physname
[i
];
175 fputs_filtered (physname
, stream
);
176 physname
[i
] = storec
;
178 if (physname
[0] != 0)
180 fputs_filtered (", ", stream
);
183 fputs_filtered (")", stream
);
187 /* Print any asterisks or open-parentheses needed before the
188 variable name (to describe its type).
190 On outermost call, pass 0 for PASSED_A_PTR.
191 On outermost call, SHOW > 0 means should ignore
192 any typename for TYPE and show its details.
193 SHOW is always zero on recursive calls. */
196 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
197 int show
, int passed_a_ptr
)
203 if (TYPE_NAME (type
) && show
<= 0)
208 switch (TYPE_CODE (type
))
211 fprintf_filtered (stream
, "^");
212 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
213 break; /* pointer should be handled normally in pascal */
215 case TYPE_CODE_MEMBER
:
217 fprintf_filtered (stream
, "(");
218 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
219 fprintf_filtered (stream
, " ");
220 name
= type_name_no_tag (TYPE_DOMAIN_TYPE (type
));
222 fputs_filtered (name
, stream
);
224 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
225 fprintf_filtered (stream
, "::");
228 case TYPE_CODE_METHOD
:
230 fprintf_filtered (stream
, "(");
231 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
233 fprintf_filtered (stream
, "function ");
237 fprintf_filtered (stream
, "procedure ");
242 fprintf_filtered (stream
, " ");
243 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
244 fprintf_filtered (stream
, "::");
249 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
250 fprintf_filtered (stream
, "&");
255 fprintf_filtered (stream
, "(");
257 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
259 fprintf_filtered (stream
, "function ");
263 fprintf_filtered (stream
, "procedure ");
268 case TYPE_CODE_ARRAY
:
270 fprintf_filtered (stream
, "(");
271 fprintf_filtered (stream
, "array ");
272 if (TYPE_LENGTH (type
) >= 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
273 && TYPE_ARRAY_UPPER_BOUND_TYPE (type
) != BOUND_CANNOT_BE_DETERMINED
)
274 fprintf_filtered (stream
, "[%d..%d] ",
275 TYPE_ARRAY_LOWER_BOUND_VALUE (type
),
276 TYPE_ARRAY_UPPER_BOUND_VALUE (type
)
278 fprintf_filtered (stream
, "of ");
281 case TYPE_CODE_UNDEF
:
282 case TYPE_CODE_STRUCT
:
283 case TYPE_CODE_UNION
:
288 case TYPE_CODE_ERROR
:
292 case TYPE_CODE_RANGE
:
293 case TYPE_CODE_STRING
:
294 case TYPE_CODE_BITSTRING
:
295 case TYPE_CODE_COMPLEX
:
296 case TYPE_CODE_TYPEDEF
:
297 case TYPE_CODE_TEMPLATE
:
298 /* These types need no prefix. They are listed here so that
299 gcc -Wall will reveal any types that haven't been handled. */
302 error ("type not handled in pascal_type_print_varspec_prefix()");
308 pascal_type_print_args (struct type
*type
, struct ui_file
*stream
)
313 /* fprintf_filtered (stream, "(");
314 no () for procedures !! */
315 args
= TYPE_ARG_TYPES (type
);
318 if ((args
[1] != NULL
&& args
[1]->code
!= TYPE_CODE_VOID
) ||
321 fprintf_filtered (stream
, "(");
325 fprintf_filtered (stream
, "...");
330 args
[i
] != NULL
&& args
[i
]->code
!= TYPE_CODE_VOID
;
333 pascal_print_type (args
[i
], "", stream
, -1, 0);
334 if (args
[i
+ 1] == NULL
)
336 fprintf_filtered (stream
, "...");
338 else if (args
[i
+ 1]->code
!= TYPE_CODE_VOID
)
340 fprintf_filtered (stream
, ",");
345 if ((args
[1] != NULL
&& args
[1]->code
!= TYPE_CODE_VOID
) ||
348 fprintf_filtered (stream
, ")");
354 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
356 int i
, len
= TYPE_NFIELDS (type
);
359 fprintf_filtered (stream
, "(");
361 for (i
= 0; i
< len
; i
++)
365 fputs_filtered (", ", stream
);
368 /* can we find if it is a var parameter ??
369 if ( TYPE_FIELD(type, i) == )
371 fprintf_filtered (stream, "var ");
373 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME seems invalid ! */
378 fprintf_filtered (stream
, ")");
382 /* Print any array sizes, function arguments or close parentheses
383 needed after the variable name (to describe its type).
384 Args work like pascal_type_print_varspec_prefix. */
387 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
388 int show
, int passed_a_ptr
,
394 if (TYPE_NAME (type
) && show
<= 0)
399 switch (TYPE_CODE (type
))
401 case TYPE_CODE_ARRAY
:
403 fprintf_filtered (stream
, ")");
406 case TYPE_CODE_MEMBER
:
408 fprintf_filtered (stream
, ")");
409 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 0, 0);
412 case TYPE_CODE_METHOD
:
414 fprintf_filtered (stream
, ")");
415 pascal_type_print_method_args ("",
418 /* pascal_type_print_args (type, stream); */
419 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
421 fprintf_filtered (stream
, " : ");
422 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
423 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
424 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
431 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 1, 0);
436 fprintf_filtered (stream
, ")");
438 pascal_print_func_args (type
, stream
);
439 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
441 fprintf_filtered (stream
, " : ");
442 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
443 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
444 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
449 case TYPE_CODE_UNDEF
:
450 case TYPE_CODE_STRUCT
:
451 case TYPE_CODE_UNION
:
456 case TYPE_CODE_ERROR
:
460 case TYPE_CODE_RANGE
:
461 case TYPE_CODE_STRING
:
462 case TYPE_CODE_BITSTRING
:
463 case TYPE_CODE_COMPLEX
:
464 case TYPE_CODE_TYPEDEF
:
465 case TYPE_CODE_TEMPLATE
:
466 /* These types do not need a suffix. They are listed so that
467 gcc -Wall will report types that may not have been considered. */
470 error ("type not handled in pascal_type_print_varspec_suffix()");
475 /* Print the name of the type (or the ultimate pointer target,
476 function value or array element), or the description of a
479 SHOW positive means print details about the type (e.g. enum values),
480 and print structure elements passing SHOW - 1 for show.
481 SHOW negative means just print the type name or struct tag if there is one.
482 If there is no name, print something sensible but concise like
484 SHOW zero means just print the type name or struct tag if there is one.
485 If there is no name, print something sensible but not as concise like
486 "struct {int x; int y;}".
488 LEVEL is the number of spaces to indent by.
489 We increase it for some recursive calls. */
492 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
497 register int lastval
;
500 s_none
, s_public
, s_private
, s_protected
508 fputs_filtered ("<type unknown>", stream
);
513 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
) && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
515 fprintf_filtered (stream
,
516 TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer");
519 /* When SHOW is zero or less, and there is a valid type name, then always
520 just print the type name directly from the type. */
523 && TYPE_NAME (type
) != NULL
)
525 fputs_filtered (TYPE_NAME (type
), stream
);
529 CHECK_TYPEDEF (type
);
531 switch (TYPE_CODE (type
))
533 case TYPE_CODE_TYPEDEF
:
535 case TYPE_CODE_MEMBER
:
537 /* case TYPE_CODE_FUNC:
538 case TYPE_CODE_METHOD: */
539 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
542 case TYPE_CODE_ARRAY
:
543 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
544 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
545 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
546 pascal_print_type (TYPE_TARGET_TYPE (type
), NULL
, stream
, 0, 0);
550 case TYPE_CODE_METHOD
:
552 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
553 only after args !! */
555 case TYPE_CODE_STRUCT
:
556 if (TYPE_TAG_NAME (type
) != NULL
)
558 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
559 fputs_filtered (" = ", stream
);
561 if (HAVE_CPLUS_STRUCT (type
))
563 fprintf_filtered (stream
, "class ");
567 fprintf_filtered (stream
, "record ");
571 case TYPE_CODE_UNION
:
572 if (TYPE_TAG_NAME (type
) != NULL
)
574 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
575 fputs_filtered (" = ", stream
);
577 fprintf_filtered (stream
, "case <?> of ");
583 /* If we just printed a tag name, no need to print anything else. */
584 if (TYPE_TAG_NAME (type
) == NULL
)
585 fprintf_filtered (stream
, "{...}");
587 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
589 pascal_type_print_derivation_info (stream
, type
);
591 fprintf_filtered (stream
, "\n");
592 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
594 if (TYPE_FLAGS (type
) & TYPE_FLAG_STUB
)
595 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
597 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
600 /* Start off with no specific section type, so we can print
601 one for the first field we find, and use that section type
602 thereafter until we find another type. */
604 section_type
= s_none
;
606 /* If there is a base class for this type,
607 do not print the field that it occupies. */
609 len
= TYPE_NFIELDS (type
);
610 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
613 /* Don't print out virtual function table. */
614 if (STREQN (TYPE_FIELD_NAME (type
, i
), "_vptr", 5)
615 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
618 /* If this is a pascal object or class we can print the
619 various section labels. */
621 if (HAVE_CPLUS_STRUCT (type
))
623 if (TYPE_FIELD_PROTECTED (type
, i
))
625 if (section_type
!= s_protected
)
627 section_type
= s_protected
;
628 fprintfi_filtered (level
+ 2, stream
,
632 else if (TYPE_FIELD_PRIVATE (type
, i
))
634 if (section_type
!= s_private
)
636 section_type
= s_private
;
637 fprintfi_filtered (level
+ 2, stream
, "private\n");
642 if (section_type
!= s_public
)
644 section_type
= s_public
;
645 fprintfi_filtered (level
+ 2, stream
, "public\n");
650 print_spaces_filtered (level
+ 4, stream
);
651 if (TYPE_FIELD_STATIC (type
, i
))
653 fprintf_filtered (stream
, "static ");
655 pascal_print_type (TYPE_FIELD_TYPE (type
, i
),
656 TYPE_FIELD_NAME (type
, i
),
657 stream
, show
- 1, level
+ 4);
658 if (!TYPE_FIELD_STATIC (type
, i
)
659 && TYPE_FIELD_PACKED (type
, i
))
661 /* It is a bitfield. This code does not attempt
662 to look at the bitpos and reconstruct filler,
663 unnamed fields. This would lead to misleading
664 results if the compiler does not put out fields
665 for such things (I don't know what it does). */
666 fprintf_filtered (stream
, " : %d",
667 TYPE_FIELD_BITSIZE (type
, i
));
669 fprintf_filtered (stream
, ";\n");
672 /* If there are both fields and methods, put a space between. */
673 len
= TYPE_NFN_FIELDS (type
);
674 if (len
&& section_type
!= s_none
)
675 fprintf_filtered (stream
, "\n");
677 /* Pbject pascal: print out the methods */
679 for (i
= 0; i
< len
; i
++)
681 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (type
, i
);
682 int j
, len2
= TYPE_FN_FIELDLIST_LENGTH (type
, i
);
683 char *method_name
= TYPE_FN_FIELDLIST_NAME (type
, i
);
684 char *name
= type_name_no_tag (type
);
685 /* this is GNU C++ specific
686 how can we know constructor/destructor?
687 It might work for GNU pascal */
688 for (j
= 0; j
< len2
; j
++)
690 char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
692 int is_constructor
= STREQN (physname
, "__ct__", 6);
693 int is_destructor
= STREQN (physname
, "__dt__", 6);
696 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
698 if (section_type
!= s_protected
)
700 section_type
= s_protected
;
701 fprintfi_filtered (level
+ 2, stream
,
705 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
707 if (section_type
!= s_private
)
709 section_type
= s_private
;
710 fprintfi_filtered (level
+ 2, stream
, "private\n");
715 if (section_type
!= s_public
)
717 section_type
= s_public
;
718 fprintfi_filtered (level
+ 2, stream
, "public\n");
722 print_spaces_filtered (level
+ 4, stream
);
723 if (TYPE_FN_FIELD_STATIC_P (f
, j
))
724 fprintf_filtered (stream
, "static ");
725 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) == 0)
727 /* Keep GDB from crashing here. */
728 fprintf_filtered (stream
, "<undefined type> %s;\n",
729 TYPE_FN_FIELD_PHYSNAME (f
, j
));
735 fprintf_filtered (stream
, "constructor ");
737 else if (is_destructor
)
739 fprintf_filtered (stream
, "destructor ");
741 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0 &&
742 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
744 fprintf_filtered (stream
, "function ");
748 fprintf_filtered (stream
, "procedure ");
750 /* this does not work, no idea why !! */
752 pascal_type_print_method_args (physname
,
756 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0 &&
757 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
759 fputs_filtered (" : ", stream
);
760 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
763 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
764 fprintf_filtered (stream
, "; virtual");
766 fprintf_filtered (stream
, ";\n");
769 fprintfi_filtered (level
, stream
, "end");
774 if (TYPE_TAG_NAME (type
) != NULL
)
776 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
778 fputs_filtered (" ", stream
);
780 /* enum is just defined by
781 type enume_name = (enum_member1,enum_member2,...) */
782 fprintf_filtered (stream
, " = ");
786 /* If we just printed a tag name, no need to print anything else. */
787 if (TYPE_TAG_NAME (type
) == NULL
)
788 fprintf_filtered (stream
, "(...)");
790 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
792 fprintf_filtered (stream
, "(");
793 len
= TYPE_NFIELDS (type
);
795 for (i
= 0; i
< len
; i
++)
799 fprintf_filtered (stream
, ", ");
801 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
802 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
804 fprintf_filtered (stream
, " := %d", TYPE_FIELD_BITPOS (type
, i
));
805 lastval
= TYPE_FIELD_BITPOS (type
, i
);
809 fprintf_filtered (stream
, ")");
814 fprintf_filtered (stream
, "void");
817 case TYPE_CODE_UNDEF
:
818 fprintf_filtered (stream
, "record <unknown>");
821 case TYPE_CODE_ERROR
:
822 fprintf_filtered (stream
, "<unknown type>");
825 /* this probably does not work for enums */
826 case TYPE_CODE_RANGE
:
828 struct type
*target
= TYPE_TARGET_TYPE (type
);
830 target
= builtin_type_long
;
831 print_type_scalar (target
, TYPE_LOW_BOUND (type
), stream
);
832 fputs_filtered ("..", stream
);
833 print_type_scalar (target
, TYPE_HIGH_BOUND (type
), stream
);
838 fputs_filtered ("set of ", stream
);
839 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
844 /* Handle types not explicitly handled by the other cases,
845 such as fundamental types. For these, just print whatever
846 the type name is, as recorded in the type itself. If there
847 is no type name, then complain. */
848 if (TYPE_NAME (type
) != NULL
)
850 fputs_filtered (TYPE_NAME (type
), stream
);
854 /* At least for dump_symtab, it is important that this not be
856 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",