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 (type
, varstring
, stream
, show
, level
)
58 struct ui_file
*stream
;
62 register enum type_code code
;
65 code
= TYPE_CODE (type
);
70 if ((code
== TYPE_CODE_FUNC
||
71 code
== TYPE_CODE_METHOD
))
73 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
76 fputs_filtered (varstring
, stream
);
78 if ((varstring
!= NULL
&& *varstring
!= '\0') &&
79 !(code
== TYPE_CODE_FUNC
||
80 code
== TYPE_CODE_METHOD
))
82 fputs_filtered (" : ", stream
);
85 if (!(code
== TYPE_CODE_FUNC
||
86 code
== TYPE_CODE_METHOD
))
88 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
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 */
95 demangled_args
= varstring
? strchr (varstring
, '(') != NULL
: 0;
96 pascal_type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
);
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:
105 class B : public A {int b; };
106 class C : public B {int c; };
108 Print the type of class C as:
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:
117 class C : public B : public A {
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. */
125 pascal_type_print_derivation_info (stream
, type
)
126 struct ui_file
*stream
;
132 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
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)");
143 fputs_filtered (" ", stream
);
147 /* Print the Pascal method arguments ARGS to the file STREAM. */
150 pascal_type_print_method_args (physname
, methodname
, stream
)
153 struct ui_file
*stream
;
155 int is_constructor
= STREQN (physname
, "__ct__", 6);
156 int is_destructor
= STREQN (physname
, "__dt__", 6);
158 if (is_constructor
|| is_destructor
)
163 fputs_filtered (methodname
, stream
);
165 if (physname
&& (*physname
!= 0))
171 fputs_filtered (" (", stream
);
172 /* we must demangle this */
181 i
= strtol (physname
, &argname
, 0);
183 storec
= physname
[i
];
185 fputs_filtered (physname
, stream
);
186 physname
[i
] = storec
;
188 if (physname
[0] != 0)
190 fputs_filtered (", ", stream
);
193 fputs_filtered (")", stream
);
197 /* Print any asterisks or open-parentheses needed before the
198 variable name (to describe its type).
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. */
206 pascal_type_print_varspec_prefix (type
, stream
, show
, passed_a_ptr
)
208 struct ui_file
*stream
;
216 if (TYPE_NAME (type
) && show
<= 0)
221 switch (TYPE_CODE (type
))
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 */
228 case TYPE_CODE_MEMBER
:
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
));
235 fputs_filtered (name
, stream
);
237 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
238 fprintf_filtered (stream
, "::");
241 case TYPE_CODE_METHOD
:
243 fprintf_filtered (stream
, "(");
244 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
246 fprintf_filtered (stream
, "function ");
250 fprintf_filtered (stream
, "procedure ");
255 fprintf_filtered (stream
, " ");
256 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
257 fprintf_filtered (stream
, "::");
262 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
263 fprintf_filtered (stream
, "&");
268 fprintf_filtered (stream
, "(");
270 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
272 fprintf_filtered (stream
, "function ");
276 fprintf_filtered (stream
, "procedure ");
281 case TYPE_CODE_ARRAY
:
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
)
291 fprintf_filtered (stream
, "of ");
294 case TYPE_CODE_UNDEF
:
295 case TYPE_CODE_STRUCT
:
296 case TYPE_CODE_UNION
:
301 case TYPE_CODE_ERROR
:
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. */
315 error ("type not handled in pascal_type_print_varspec_prefix()");
321 pascal_type_print_args (type
, stream
)
323 struct ui_file
*stream
;
328 /* fprintf_filtered (stream, "(");
329 no () for procedures !! */
330 args
= TYPE_ARG_TYPES (type
);
333 if ((args
[1] != NULL
&& args
[1]->code
!= TYPE_CODE_VOID
) ||
336 fprintf_filtered (stream
, "(");
340 fprintf_filtered (stream
, "...");
345 args
[i
] != NULL
&& args
[i
]->code
!= TYPE_CODE_VOID
;
348 pascal_print_type (args
[i
], "", stream
, -1, 0);
349 if (args
[i
+ 1] == NULL
)
351 fprintf_filtered (stream
, "...");
353 else if (args
[i
+ 1]->code
!= TYPE_CODE_VOID
)
355 fprintf_filtered (stream
, ",");
360 if ((args
[1] != NULL
&& args
[1]->code
!= TYPE_CODE_VOID
) ||
363 fprintf_filtered (stream
, ")");
369 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
371 int i
, len
= TYPE_NFIELDS (type
);
374 fprintf_filtered (stream
, "(");
376 for (i
= 0; i
< len
; i
++)
380 fputs_filtered (", ", stream
);
383 /* can we find if it is a var parameter ??
384 if ( TYPE_FIELD(type, i) == )
386 fprintf_filtered (stream, "var ");
388 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME seems invalid ! */
393 fprintf_filtered (stream
, ")");
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. */
402 pascal_type_print_varspec_suffix (type
, stream
, show
, passed_a_ptr
, demangled_args
)
404 struct ui_file
*stream
;
412 if (TYPE_NAME (type
) && show
<= 0)
417 switch (TYPE_CODE (type
))
419 case TYPE_CODE_ARRAY
:
421 fprintf_filtered (stream
, ")");
424 case TYPE_CODE_MEMBER
:
426 fprintf_filtered (stream
, ")");
427 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 0, 0);
430 case TYPE_CODE_METHOD
:
432 fprintf_filtered (stream
, ")");
433 pascal_type_print_method_args ("",
436 /* pascal_type_print_args (type, stream); */
437 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
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,
449 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 1, 0);
454 fprintf_filtered (stream
, ")");
456 pascal_print_func_args (type
, stream
);
457 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
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,
467 case TYPE_CODE_UNDEF
:
468 case TYPE_CODE_STRUCT
:
469 case TYPE_CODE_UNION
:
474 case TYPE_CODE_ERROR
:
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. */
488 error ("type not handled in pascal_type_print_varspec_suffix()");
493 /* Print the name of the type (or the ultimate pointer target,
494 function value or array element), or the description of a
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
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;}".
506 LEVEL is the number of spaces to indent by.
507 We increase it for some recursive calls. */
510 pascal_type_print_base (type
, stream
, show
, level
)
512 struct ui_file
*stream
;
518 register int lastval
;
521 s_none
, s_public
, s_private
, s_protected
529 fputs_filtered ("<type unknown>", stream
);
534 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
) && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
536 fprintf_filtered (stream
,
537 TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer");
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. */
544 && TYPE_NAME (type
) != NULL
)
546 fputs_filtered (TYPE_NAME (type
), stream
);
550 CHECK_TYPEDEF (type
);
552 switch (TYPE_CODE (type
))
554 case TYPE_CODE_TYPEDEF
:
556 case TYPE_CODE_MEMBER
:
558 /* case TYPE_CODE_FUNC:
559 case TYPE_CODE_METHOD: */
560 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
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);
571 case TYPE_CODE_METHOD
:
573 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
574 only after args !! */
576 case TYPE_CODE_STRUCT
:
577 if (TYPE_TAG_NAME (type
) != NULL
)
579 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
580 fputs_filtered (" = ", stream
);
582 if (HAVE_CPLUS_STRUCT (type
))
584 fprintf_filtered (stream
, "class ");
588 fprintf_filtered (stream
, "record ");
592 case TYPE_CODE_UNION
:
593 if (TYPE_TAG_NAME (type
) != NULL
)
595 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
596 fputs_filtered (" = ", stream
);
598 fprintf_filtered (stream
, "case <?> of ");
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
, "{...}");
608 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
610 pascal_type_print_derivation_info (stream
, type
);
612 fprintf_filtered (stream
, "\n");
613 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
615 if (TYPE_FLAGS (type
) & TYPE_FLAG_STUB
)
616 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
618 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
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. */
625 section_type
= s_none
;
627 /* If there is a base class for this type,
628 do not print the field that it occupies. */
630 len
= TYPE_NFIELDS (type
);
631 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
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]))
639 /* If this is a pascal object or class we can print the
640 various section labels. */
642 if (HAVE_CPLUS_STRUCT (type
))
644 if (TYPE_FIELD_PROTECTED (type
, i
))
646 if (section_type
!= s_protected
)
648 section_type
= s_protected
;
649 fprintfi_filtered (level
+ 2, stream
,
653 else if (TYPE_FIELD_PRIVATE (type
, i
))
655 if (section_type
!= s_private
)
657 section_type
= s_private
;
658 fprintfi_filtered (level
+ 2, stream
, "private\n");
663 if (section_type
!= s_public
)
665 section_type
= s_public
;
666 fprintfi_filtered (level
+ 2, stream
, "public\n");
671 print_spaces_filtered (level
+ 4, stream
);
672 if (TYPE_FIELD_STATIC (type
, i
))
674 fprintf_filtered (stream
, "static ");
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
))
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
));
690 fprintf_filtered (stream
, ";\n");
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");
698 /* Pbject pascal: print out the methods */
700 for (i
= 0; i
< len
; i
++)
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
++)
711 char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
713 int is_constructor
= STREQN (physname
, "__ct__", 6);
714 int is_destructor
= STREQN (physname
, "__dt__", 6);
717 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
719 if (section_type
!= s_protected
)
721 section_type
= s_protected
;
722 fprintfi_filtered (level
+ 2, stream
,
726 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
728 if (section_type
!= s_private
)
730 section_type
= s_private
;
731 fprintfi_filtered (level
+ 2, stream
, "private\n");
736 if (section_type
!= s_public
)
738 section_type
= s_public
;
739 fprintfi_filtered (level
+ 2, stream
, "public\n");
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)
748 /* Keep GDB from crashing here. */
749 fprintf_filtered (stream
, "<undefined type> %s;\n",
750 TYPE_FN_FIELD_PHYSNAME (f
, j
));
756 fprintf_filtered (stream
, "constructor ");
758 else if (is_destructor
)
760 fprintf_filtered (stream
, "destructor ");
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
)
765 fprintf_filtered (stream
, "function ");
769 fprintf_filtered (stream
, "procedure ");
771 /* this does not work, no idea why !! */
773 pascal_type_print_method_args (physname
,
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
)
780 fputs_filtered (" : ", stream
);
781 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
784 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
785 fprintf_filtered (stream
, "; virtual");
787 fprintf_filtered (stream
, ";\n");
790 fprintfi_filtered (level
, stream
, "end");
795 if (TYPE_TAG_NAME (type
) != NULL
)
797 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
799 fputs_filtered (" ", stream
);
801 /* enum is just defined by
802 type enume_name = (enum_member1,enum_member2,...) */
803 fprintf_filtered (stream
, " = ");
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
, "(...)");
811 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
813 fprintf_filtered (stream
, "(");
814 len
= TYPE_NFIELDS (type
);
816 for (i
= 0; i
< len
; i
++)
820 fprintf_filtered (stream
, ", ");
822 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
823 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
825 fprintf_filtered (stream
, " := %d", TYPE_FIELD_BITPOS (type
, i
));
826 lastval
= TYPE_FIELD_BITPOS (type
, i
);
830 fprintf_filtered (stream
, ")");
835 fprintf_filtered (stream
, "void");
838 case TYPE_CODE_UNDEF
:
839 fprintf_filtered (stream
, "record <unknown>");
842 case TYPE_CODE_ERROR
:
843 fprintf_filtered (stream
, "<unknown type>");
846 /* this probably does not work for enums */
847 case TYPE_CODE_RANGE
:
849 struct type
*target
= TYPE_TARGET_TYPE (type
);
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
);
859 fputs_filtered ("set of ", stream
);
860 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
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
)
871 fputs_filtered (TYPE_NAME (type
), stream
);
875 /* At least for dump_symtab, it is important that this not be
877 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",