1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright (C) 2000-2002, 2006-2012 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 3 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, see <http://www.gnu.org/licenses/>. */
19 /* This file is derived from p-typeprint.c */
22 #include "gdb_obstack.h"
23 #include "bfd.h" /* Binary File Description */
26 #include "expression.h"
32 #include "typeprint.h"
33 #include "gdb-demangle.h"
34 #include "gdb_string.h"
38 static void pascal_type_print_varspec_suffix (struct type
*, struct ui_file
*,
41 static void pascal_type_print_derivation_info (struct ui_file
*,
44 void pascal_type_print_varspec_prefix (struct type
*, struct ui_file
*,
48 /* LEVEL is the depth to indent lines by. */
51 pascal_print_type (struct type
*type
, const char *varstring
,
52 struct ui_file
*stream
, int show
, int level
)
57 code
= TYPE_CODE (type
);
62 if ((code
== TYPE_CODE_FUNC
63 || code
== TYPE_CODE_METHOD
))
65 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
68 fputs_filtered (varstring
, stream
);
70 if ((varstring
!= NULL
&& *varstring
!= '\0')
71 && !(code
== TYPE_CODE_FUNC
72 || code
== TYPE_CODE_METHOD
))
74 fputs_filtered (" : ", stream
);
77 if (!(code
== TYPE_CODE_FUNC
78 || code
== TYPE_CODE_METHOD
))
80 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
83 pascal_type_print_base (type
, stream
, show
, level
);
84 /* For demangled function names, we have the arglist as part of the name,
85 so don't print an additional pair of ()'s. */
87 demangled_args
= varstring
? strchr (varstring
, '(') != NULL
: 0;
88 pascal_type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
);
92 /* Print a typedef using Pascal syntax. TYPE is the underlying type.
93 NEW_SYMBOL is the symbol naming the type. STREAM is the stream on
97 pascal_print_typedef (struct type
*type
, struct symbol
*new_symbol
,
98 struct ui_file
*stream
)
100 CHECK_TYPEDEF (type
);
101 fprintf_filtered (stream
, "type ");
102 fprintf_filtered (stream
, "%s = ", SYMBOL_PRINT_NAME (new_symbol
));
103 type_print (type
, "", stream
, 0);
104 fprintf_filtered (stream
, ";\n");
107 /* If TYPE is a derived type, then print out derivation information.
108 Print only the actual base classes of this type, not the base classes
109 of the base classes. I.e. for the derivation hierarchy:
112 class B : public A {int b; };
113 class C : public B {int c; };
115 Print the type of class C as:
121 Not as the following (like gdb used to), which is not legal C++ syntax for
122 derived types and may be confused with the multiple inheritance form:
124 class C : public B : public A {
128 In general, gdb should try to print the types as closely as possible to
129 the form that they appear in the source code. */
132 pascal_type_print_derivation_info (struct ui_file
*stream
, struct type
*type
)
137 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
139 fputs_filtered (i
== 0 ? ": " : ", ", stream
);
140 fprintf_filtered (stream
, "%s%s ",
141 BASETYPE_VIA_PUBLIC (type
, i
) ? "public" : "private",
142 BASETYPE_VIA_VIRTUAL (type
, i
) ? " virtual" : "");
143 name
= type_name_no_tag (TYPE_BASECLASS (type
, i
));
144 fprintf_filtered (stream
, "%s", name
? name
: "(null)");
148 fputs_filtered (" ", stream
);
152 /* Print the Pascal method arguments ARGS to the file STREAM. */
155 pascal_type_print_method_args (const char *physname
, const char *methodname
,
156 struct ui_file
*stream
)
158 int is_constructor
= (strncmp (physname
, "__ct__", 6) == 0);
159 int is_destructor
= (strncmp (physname
, "__dt__", 6) == 0);
161 if (is_constructor
|| is_destructor
)
166 fputs_filtered (methodname
, stream
);
168 if (physname
&& (*physname
!= 0))
170 fputs_filtered (" (", stream
);
171 /* We must demangle this. */
172 while (isdigit (physname
[0]))
178 while (isdigit (physname
[len
]))
182 i
= strtol (physname
, &argname
, 0);
185 for (j
= 0; j
< i
; ++j
)
186 fputc_filtered (physname
[j
], stream
);
189 if (physname
[0] != 0)
191 fputs_filtered (", ", stream
);
194 fputs_filtered (")", stream
);
198 /* Print any asterisks or open-parentheses needed before the
199 variable name (to describe its type).
201 On outermost call, pass 0 for PASSED_A_PTR.
202 On outermost call, SHOW > 0 means should ignore
203 any typename for TYPE and show its details.
204 SHOW is always zero on recursive calls. */
207 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
208 int show
, int passed_a_ptr
)
213 if (TYPE_NAME (type
) && show
<= 0)
218 switch (TYPE_CODE (type
))
221 fprintf_filtered (stream
, "^");
222 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
223 break; /* Pointer should be handled normally
226 case TYPE_CODE_METHOD
:
228 fprintf_filtered (stream
, "(");
229 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
231 fprintf_filtered (stream
, "function ");
235 fprintf_filtered (stream
, "procedure ");
240 fprintf_filtered (stream
, " ");
241 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
),
242 stream
, 0, passed_a_ptr
);
243 fprintf_filtered (stream
, "::");
248 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
249 fprintf_filtered (stream
, "&");
254 fprintf_filtered (stream
, "(");
256 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
258 fprintf_filtered (stream
, "function ");
262 fprintf_filtered (stream
, "procedure ");
267 case TYPE_CODE_ARRAY
:
269 fprintf_filtered (stream
, "(");
270 fprintf_filtered (stream
, "array ");
271 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
272 && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type
))
273 fprintf_filtered (stream
, "[%s..%s] ",
274 plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type
)),
275 plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type
)));
276 fprintf_filtered (stream
, "of ");
279 case TYPE_CODE_UNDEF
:
280 case TYPE_CODE_STRUCT
:
281 case TYPE_CODE_UNION
:
286 case TYPE_CODE_ERROR
:
290 case TYPE_CODE_RANGE
:
291 case TYPE_CODE_STRING
:
292 case TYPE_CODE_COMPLEX
:
293 case TYPE_CODE_TYPEDEF
:
294 /* These types need no prefix. They are listed here so that
295 gcc -Wall will reveal any types that haven't been handled. */
298 error (_("type not handled in pascal_type_print_varspec_prefix()"));
304 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
306 int i
, len
= TYPE_NFIELDS (type
);
310 fprintf_filtered (stream
, "(");
312 for (i
= 0; i
< len
; i
++)
316 fputs_filtered (", ", stream
);
319 /* Can we find if it is a var parameter ??
320 if ( TYPE_FIELD(type, i) == )
322 fprintf_filtered (stream, "var ");
324 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME
330 fprintf_filtered (stream
, ")");
334 /* Print any array sizes, function arguments or close parentheses
335 needed after the variable name (to describe its type).
336 Args work like pascal_type_print_varspec_prefix. */
339 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
340 int show
, int passed_a_ptr
,
346 if (TYPE_NAME (type
) && show
<= 0)
351 switch (TYPE_CODE (type
))
353 case TYPE_CODE_ARRAY
:
355 fprintf_filtered (stream
, ")");
358 case TYPE_CODE_METHOD
:
360 fprintf_filtered (stream
, ")");
361 pascal_type_print_method_args ("",
364 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
366 fprintf_filtered (stream
, " : ");
367 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
),
369 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
370 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
377 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
),
383 fprintf_filtered (stream
, ")");
385 pascal_print_func_args (type
, stream
);
386 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
388 fprintf_filtered (stream
, " : ");
389 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
),
391 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
392 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
397 case TYPE_CODE_UNDEF
:
398 case TYPE_CODE_STRUCT
:
399 case TYPE_CODE_UNION
:
404 case TYPE_CODE_ERROR
:
408 case TYPE_CODE_RANGE
:
409 case TYPE_CODE_STRING
:
410 case TYPE_CODE_COMPLEX
:
411 case TYPE_CODE_TYPEDEF
:
412 /* These types do not need a suffix. They are listed so that
413 gcc -Wall will report types that may not have been considered. */
416 error (_("type not handled in pascal_type_print_varspec_suffix()"));
421 /* Print the name of the type (or the ultimate pointer target,
422 function value or array element), or the description of a
425 SHOW positive means print details about the type (e.g. enum values),
426 and print structure elements passing SHOW - 1 for show.
427 SHOW negative means just print the type name or struct tag if there is one.
428 If there is no name, print something sensible but concise like
430 SHOW zero means just print the type name or struct tag if there is one.
431 If there is no name, print something sensible but not as concise like
432 "struct {int x; int y;}".
434 LEVEL is the number of spaces to indent by.
435 We increase it for some recursive calls. */
438 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
446 s_none
, s_public
, s_private
, s_protected
454 fputs_filtered ("<type unknown>", stream
);
459 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
)
460 && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
462 fputs_filtered (TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer",
466 /* When SHOW is zero or less, and there is a valid type name, then always
467 just print the type name directly from the type. */
470 && TYPE_NAME (type
) != NULL
)
472 fputs_filtered (TYPE_NAME (type
), stream
);
476 CHECK_TYPEDEF (type
);
478 switch (TYPE_CODE (type
))
480 case TYPE_CODE_TYPEDEF
:
483 /* case TYPE_CODE_FUNC:
484 case TYPE_CODE_METHOD: */
485 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
488 case TYPE_CODE_ARRAY
:
489 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
491 pascal_type_print_base (TYPE_TARGET_TYPE (type),
492 stream, show, level);
493 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
495 pascal_print_type (TYPE_TARGET_TYPE (type
), NULL
, stream
, 0, 0);
499 case TYPE_CODE_METHOD
:
501 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
502 only after args !! */
504 case TYPE_CODE_STRUCT
:
505 if (TYPE_TAG_NAME (type
) != NULL
)
507 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
508 fputs_filtered (" = ", stream
);
510 if (HAVE_CPLUS_STRUCT (type
))
512 fprintf_filtered (stream
, "class ");
516 fprintf_filtered (stream
, "record ");
520 case TYPE_CODE_UNION
:
521 if (TYPE_TAG_NAME (type
) != NULL
)
523 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
524 fputs_filtered (" = ", stream
);
526 fprintf_filtered (stream
, "case <?> of ");
532 /* If we just printed a tag name, no need to print anything else. */
533 if (TYPE_TAG_NAME (type
) == NULL
)
534 fprintf_filtered (stream
, "{...}");
536 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
538 pascal_type_print_derivation_info (stream
, type
);
540 fprintf_filtered (stream
, "\n");
541 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
543 if (TYPE_STUB (type
))
544 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
546 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
549 /* Start off with no specific section type, so we can print
550 one for the first field we find, and use that section type
551 thereafter until we find another type. */
553 section_type
= s_none
;
555 /* If there is a base class for this type,
556 do not print the field that it occupies. */
558 len
= TYPE_NFIELDS (type
);
559 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
562 /* Don't print out virtual function table. */
563 if ((strncmp (TYPE_FIELD_NAME (type
, i
), "_vptr", 5) == 0)
564 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
567 /* If this is a pascal object or class we can print the
568 various section labels. */
570 if (HAVE_CPLUS_STRUCT (type
))
572 if (TYPE_FIELD_PROTECTED (type
, i
))
574 if (section_type
!= s_protected
)
576 section_type
= s_protected
;
577 fprintfi_filtered (level
+ 2, stream
,
581 else if (TYPE_FIELD_PRIVATE (type
, i
))
583 if (section_type
!= s_private
)
585 section_type
= s_private
;
586 fprintfi_filtered (level
+ 2, stream
, "private\n");
591 if (section_type
!= s_public
)
593 section_type
= s_public
;
594 fprintfi_filtered (level
+ 2, stream
, "public\n");
599 print_spaces_filtered (level
+ 4, stream
);
600 if (field_is_static (&TYPE_FIELD (type
, i
)))
601 fprintf_filtered (stream
, "static ");
602 pascal_print_type (TYPE_FIELD_TYPE (type
, i
),
603 TYPE_FIELD_NAME (type
, i
),
604 stream
, show
- 1, level
+ 4);
605 if (!field_is_static (&TYPE_FIELD (type
, i
))
606 && TYPE_FIELD_PACKED (type
, i
))
608 /* It is a bitfield. This code does not attempt
609 to look at the bitpos and reconstruct filler,
610 unnamed fields. This would lead to misleading
611 results if the compiler does not put out fields
612 for such things (I don't know what it does). */
613 fprintf_filtered (stream
, " : %d",
614 TYPE_FIELD_BITSIZE (type
, i
));
616 fprintf_filtered (stream
, ";\n");
619 /* If there are both fields and methods, put a space between. */
620 len
= TYPE_NFN_FIELDS (type
);
621 if (len
&& section_type
!= s_none
)
622 fprintf_filtered (stream
, "\n");
624 /* Object pascal: print out the methods. */
626 for (i
= 0; i
< len
; i
++)
628 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (type
, i
);
629 int j
, len2
= TYPE_FN_FIELDLIST_LENGTH (type
, i
);
630 const char *method_name
= TYPE_FN_FIELDLIST_NAME (type
, i
);
632 /* this is GNU C++ specific
633 how can we know constructor/destructor?
634 It might work for GNU pascal. */
635 for (j
= 0; j
< len2
; j
++)
637 const char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
639 int is_constructor
= (strncmp (physname
, "__ct__", 6) == 0);
640 int is_destructor
= (strncmp (physname
, "__dt__", 6) == 0);
643 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
645 if (section_type
!= s_protected
)
647 section_type
= s_protected
;
648 fprintfi_filtered (level
+ 2, stream
,
652 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
654 if (section_type
!= s_private
)
656 section_type
= s_private
;
657 fprintfi_filtered (level
+ 2, stream
, "private\n");
662 if (section_type
!= s_public
)
664 section_type
= s_public
;
665 fprintfi_filtered (level
+ 2, stream
, "public\n");
669 print_spaces_filtered (level
+ 4, stream
);
670 if (TYPE_FN_FIELD_STATIC_P (f
, j
))
671 fprintf_filtered (stream
, "static ");
672 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) == 0)
674 /* Keep GDB from crashing here. */
675 fprintf_filtered (stream
, "<undefined type> %s;\n",
676 TYPE_FN_FIELD_PHYSNAME (f
, j
));
682 fprintf_filtered (stream
, "constructor ");
684 else if (is_destructor
)
686 fprintf_filtered (stream
, "destructor ");
688 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
689 && TYPE_CODE (TYPE_TARGET_TYPE (
690 TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
692 fprintf_filtered (stream
, "function ");
696 fprintf_filtered (stream
, "procedure ");
698 /* This does not work, no idea why !! */
700 pascal_type_print_method_args (physname
,
704 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
705 && TYPE_CODE (TYPE_TARGET_TYPE (
706 TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
708 fputs_filtered (" : ", stream
);
709 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
712 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
713 fprintf_filtered (stream
, "; virtual");
715 fprintf_filtered (stream
, ";\n");
718 fprintfi_filtered (level
, stream
, "end");
723 if (TYPE_TAG_NAME (type
) != NULL
)
725 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
727 fputs_filtered (" ", stream
);
729 /* enum is just defined by
730 type enume_name = (enum_member1,enum_member2,...) */
731 fprintf_filtered (stream
, " = ");
735 /* If we just printed a tag name, no need to print anything else. */
736 if (TYPE_TAG_NAME (type
) == NULL
)
737 fprintf_filtered (stream
, "(...)");
739 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
741 fprintf_filtered (stream
, "(");
742 len
= TYPE_NFIELDS (type
);
744 for (i
= 0; i
< len
; i
++)
748 fprintf_filtered (stream
, ", ");
750 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
751 if (lastval
!= TYPE_FIELD_ENUMVAL (type
, i
))
753 fprintf_filtered (stream
,
755 plongest (TYPE_FIELD_ENUMVAL (type
, i
)));
756 lastval
= TYPE_FIELD_ENUMVAL (type
, i
);
760 fprintf_filtered (stream
, ")");
765 fprintf_filtered (stream
, "void");
768 case TYPE_CODE_UNDEF
:
769 fprintf_filtered (stream
, "record <unknown>");
772 case TYPE_CODE_ERROR
:
773 fprintf_filtered (stream
, "%s", TYPE_ERROR_NAME (type
));
776 /* this probably does not work for enums. */
777 case TYPE_CODE_RANGE
:
779 struct type
*target
= TYPE_TARGET_TYPE (type
);
781 print_type_scalar (target
, TYPE_LOW_BOUND (type
), stream
);
782 fputs_filtered ("..", stream
);
783 print_type_scalar (target
, TYPE_HIGH_BOUND (type
), stream
);
788 fputs_filtered ("set of ", stream
);
789 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
793 case TYPE_CODE_STRING
:
794 fputs_filtered ("String", stream
);
798 /* Handle types not explicitly handled by the other cases,
799 such as fundamental types. For these, just print whatever
800 the type name is, as recorded in the type itself. If there
801 is no type name, then complain. */
802 if (TYPE_NAME (type
) != NULL
)
804 fputs_filtered (TYPE_NAME (type
), stream
);
808 /* At least for dump_symtab, it is important that this not be
810 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",
This page took 0.047001 seconds and 5 git commands to generate.