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
[i
], stream
);
187 fputs_filtered (physname
, stream
);
190 if (physname
[0] != 0)
192 fputs_filtered (", ", stream
);
195 fputs_filtered (")", stream
);
199 /* Print any asterisks or open-parentheses needed before the
200 variable name (to describe its type).
202 On outermost call, pass 0 for PASSED_A_PTR.
203 On outermost call, SHOW > 0 means should ignore
204 any typename for TYPE and show its details.
205 SHOW is always zero on recursive calls. */
208 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
209 int show
, int passed_a_ptr
)
214 if (TYPE_NAME (type
) && show
<= 0)
219 switch (TYPE_CODE (type
))
222 fprintf_filtered (stream
, "^");
223 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
224 break; /* Pointer should be handled normally
227 case TYPE_CODE_METHOD
:
229 fprintf_filtered (stream
, "(");
230 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
232 fprintf_filtered (stream
, "function ");
236 fprintf_filtered (stream
, "procedure ");
241 fprintf_filtered (stream
, " ");
242 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
),
243 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_TARGET_TYPE (type
)) > 0
273 && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type
))
274 fprintf_filtered (stream
, "[%s..%s] ",
275 plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type
)),
276 plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type
)));
277 fprintf_filtered (stream
, "of ");
280 case TYPE_CODE_UNDEF
:
281 case TYPE_CODE_STRUCT
:
282 case TYPE_CODE_UNION
:
287 case TYPE_CODE_ERROR
:
291 case TYPE_CODE_RANGE
:
292 case TYPE_CODE_STRING
:
293 case TYPE_CODE_BITSTRING
:
294 case TYPE_CODE_COMPLEX
:
295 case TYPE_CODE_TYPEDEF
:
296 /* These types need no prefix. They are listed here so that
297 gcc -Wall will reveal any types that haven't been handled. */
300 error (_("type not handled in pascal_type_print_varspec_prefix()"));
306 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
308 int i
, len
= TYPE_NFIELDS (type
);
312 fprintf_filtered (stream
, "(");
314 for (i
= 0; i
< len
; i
++)
318 fputs_filtered (", ", stream
);
321 /* Can we find if it is a var parameter ??
322 if ( TYPE_FIELD(type, i) == )
324 fprintf_filtered (stream, "var ");
326 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME
332 fprintf_filtered (stream
, ")");
336 /* Print any array sizes, function arguments or close parentheses
337 needed after the variable name (to describe its type).
338 Args work like pascal_type_print_varspec_prefix. */
341 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
342 int show
, int passed_a_ptr
,
348 if (TYPE_NAME (type
) && show
<= 0)
353 switch (TYPE_CODE (type
))
355 case TYPE_CODE_ARRAY
:
357 fprintf_filtered (stream
, ")");
360 case TYPE_CODE_METHOD
:
362 fprintf_filtered (stream
, ")");
363 pascal_type_print_method_args ("",
366 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
368 fprintf_filtered (stream
, " : ");
369 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
),
371 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
372 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
379 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
),
385 fprintf_filtered (stream
, ")");
387 pascal_print_func_args (type
, stream
);
388 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
390 fprintf_filtered (stream
, " : ");
391 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
),
393 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
394 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
399 case TYPE_CODE_UNDEF
:
400 case TYPE_CODE_STRUCT
:
401 case TYPE_CODE_UNION
:
406 case TYPE_CODE_ERROR
:
410 case TYPE_CODE_RANGE
:
411 case TYPE_CODE_STRING
:
412 case TYPE_CODE_BITSTRING
:
413 case TYPE_CODE_COMPLEX
:
414 case TYPE_CODE_TYPEDEF
:
415 /* These types do not need a suffix. They are listed so that
416 gcc -Wall will report types that may not have been considered. */
419 error (_("type not handled in pascal_type_print_varspec_suffix()"));
424 /* Print the name of the type (or the ultimate pointer target,
425 function value or array element), or the description of a
428 SHOW positive means print details about the type (e.g. enum values),
429 and print structure elements passing SHOW - 1 for show.
430 SHOW negative means just print the type name or struct tag if there is one.
431 If there is no name, print something sensible but concise like
433 SHOW zero means just print the type name or struct tag if there is one.
434 If there is no name, print something sensible but not as concise like
435 "struct {int x; int y;}".
437 LEVEL is the number of spaces to indent by.
438 We increase it for some recursive calls. */
441 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
449 s_none
, s_public
, s_private
, s_protected
457 fputs_filtered ("<type unknown>", stream
);
462 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
)
463 && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
465 fputs_filtered (TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer",
469 /* When SHOW is zero or less, and there is a valid type name, then always
470 just print the type name directly from the type. */
473 && TYPE_NAME (type
) != NULL
)
475 fputs_filtered (TYPE_NAME (type
), stream
);
479 CHECK_TYPEDEF (type
);
481 switch (TYPE_CODE (type
))
483 case TYPE_CODE_TYPEDEF
:
486 /* case TYPE_CODE_FUNC:
487 case TYPE_CODE_METHOD: */
488 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
491 case TYPE_CODE_ARRAY
:
492 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
494 pascal_type_print_base (TYPE_TARGET_TYPE (type),
495 stream, show, level);
496 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
498 pascal_print_type (TYPE_TARGET_TYPE (type
), NULL
, stream
, 0, 0);
502 case TYPE_CODE_METHOD
:
504 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
505 only after args !! */
507 case TYPE_CODE_STRUCT
:
508 if (TYPE_TAG_NAME (type
) != NULL
)
510 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
511 fputs_filtered (" = ", stream
);
513 if (HAVE_CPLUS_STRUCT (type
))
515 fprintf_filtered (stream
, "class ");
519 fprintf_filtered (stream
, "record ");
523 case TYPE_CODE_UNION
:
524 if (TYPE_TAG_NAME (type
) != NULL
)
526 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
527 fputs_filtered (" = ", stream
);
529 fprintf_filtered (stream
, "case <?> of ");
535 /* If we just printed a tag name, no need to print anything else. */
536 if (TYPE_TAG_NAME (type
) == NULL
)
537 fprintf_filtered (stream
, "{...}");
539 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
541 pascal_type_print_derivation_info (stream
, type
);
543 fprintf_filtered (stream
, "\n");
544 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
546 if (TYPE_STUB (type
))
547 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
549 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
552 /* Start off with no specific section type, so we can print
553 one for the first field we find, and use that section type
554 thereafter until we find another type. */
556 section_type
= s_none
;
558 /* If there is a base class for this type,
559 do not print the field that it occupies. */
561 len
= TYPE_NFIELDS (type
);
562 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
565 /* Don't print out virtual function table. */
566 if ((strncmp (TYPE_FIELD_NAME (type
, i
), "_vptr", 5) == 0)
567 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
570 /* If this is a pascal object or class we can print the
571 various section labels. */
573 if (HAVE_CPLUS_STRUCT (type
))
575 if (TYPE_FIELD_PROTECTED (type
, i
))
577 if (section_type
!= s_protected
)
579 section_type
= s_protected
;
580 fprintfi_filtered (level
+ 2, stream
,
584 else if (TYPE_FIELD_PRIVATE (type
, i
))
586 if (section_type
!= s_private
)
588 section_type
= s_private
;
589 fprintfi_filtered (level
+ 2, stream
, "private\n");
594 if (section_type
!= s_public
)
596 section_type
= s_public
;
597 fprintfi_filtered (level
+ 2, stream
, "public\n");
602 print_spaces_filtered (level
+ 4, stream
);
603 if (field_is_static (&TYPE_FIELD (type
, i
)))
604 fprintf_filtered (stream
, "static ");
605 pascal_print_type (TYPE_FIELD_TYPE (type
, i
),
606 TYPE_FIELD_NAME (type
, i
),
607 stream
, show
- 1, level
+ 4);
608 if (!field_is_static (&TYPE_FIELD (type
, i
))
609 && TYPE_FIELD_PACKED (type
, i
))
611 /* It is a bitfield. This code does not attempt
612 to look at the bitpos and reconstruct filler,
613 unnamed fields. This would lead to misleading
614 results if the compiler does not put out fields
615 for such things (I don't know what it does). */
616 fprintf_filtered (stream
, " : %d",
617 TYPE_FIELD_BITSIZE (type
, i
));
619 fprintf_filtered (stream
, ";\n");
622 /* If there are both fields and methods, put a space between. */
623 len
= TYPE_NFN_FIELDS (type
);
624 if (len
&& section_type
!= s_none
)
625 fprintf_filtered (stream
, "\n");
627 /* Object pascal: print out the methods. */
629 for (i
= 0; i
< len
; i
++)
631 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (type
, i
);
632 int j
, len2
= TYPE_FN_FIELDLIST_LENGTH (type
, i
);
633 char *method_name
= TYPE_FN_FIELDLIST_NAME (type
, i
);
635 /* this is GNU C++ specific
636 how can we know constructor/destructor?
637 It might work for GNU pascal. */
638 for (j
= 0; j
< len2
; j
++)
640 const char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
642 int is_constructor
= (strncmp (physname
, "__ct__", 6) == 0);
643 int is_destructor
= (strncmp (physname
, "__dt__", 6) == 0);
646 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
648 if (section_type
!= s_protected
)
650 section_type
= s_protected
;
651 fprintfi_filtered (level
+ 2, stream
,
655 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
657 if (section_type
!= s_private
)
659 section_type
= s_private
;
660 fprintfi_filtered (level
+ 2, stream
, "private\n");
665 if (section_type
!= s_public
)
667 section_type
= s_public
;
668 fprintfi_filtered (level
+ 2, stream
, "public\n");
672 print_spaces_filtered (level
+ 4, stream
);
673 if (TYPE_FN_FIELD_STATIC_P (f
, j
))
674 fprintf_filtered (stream
, "static ");
675 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) == 0)
677 /* Keep GDB from crashing here. */
678 fprintf_filtered (stream
, "<undefined type> %s;\n",
679 TYPE_FN_FIELD_PHYSNAME (f
, j
));
685 fprintf_filtered (stream
, "constructor ");
687 else if (is_destructor
)
689 fprintf_filtered (stream
, "destructor ");
691 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
692 && TYPE_CODE (TYPE_TARGET_TYPE (
693 TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
695 fprintf_filtered (stream
, "function ");
699 fprintf_filtered (stream
, "procedure ");
701 /* This does not work, no idea why !! */
703 pascal_type_print_method_args (physname
,
707 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
708 && TYPE_CODE (TYPE_TARGET_TYPE (
709 TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
711 fputs_filtered (" : ", stream
);
712 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
715 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
716 fprintf_filtered (stream
, "; virtual");
718 fprintf_filtered (stream
, ";\n");
721 fprintfi_filtered (level
, stream
, "end");
726 if (TYPE_TAG_NAME (type
) != NULL
)
728 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
730 fputs_filtered (" ", stream
);
732 /* enum is just defined by
733 type enume_name = (enum_member1,enum_member2,...) */
734 fprintf_filtered (stream
, " = ");
738 /* If we just printed a tag name, no need to print anything else. */
739 if (TYPE_TAG_NAME (type
) == NULL
)
740 fprintf_filtered (stream
, "(...)");
742 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
744 fprintf_filtered (stream
, "(");
745 len
= TYPE_NFIELDS (type
);
747 for (i
= 0; i
< len
; i
++)
751 fprintf_filtered (stream
, ", ");
753 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
754 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
756 fprintf_filtered (stream
,
757 " := %d", TYPE_FIELD_BITPOS (type
, i
));
758 lastval
= TYPE_FIELD_BITPOS (type
, i
);
762 fprintf_filtered (stream
, ")");
767 fprintf_filtered (stream
, "void");
770 case TYPE_CODE_UNDEF
:
771 fprintf_filtered (stream
, "record <unknown>");
774 case TYPE_CODE_ERROR
:
775 fprintf_filtered (stream
, "%s", TYPE_ERROR_NAME (type
));
778 /* this probably does not work for enums. */
779 case TYPE_CODE_RANGE
:
781 struct type
*target
= TYPE_TARGET_TYPE (type
);
783 print_type_scalar (target
, TYPE_LOW_BOUND (type
), stream
);
784 fputs_filtered ("..", stream
);
785 print_type_scalar (target
, TYPE_HIGH_BOUND (type
), stream
);
790 fputs_filtered ("set of ", stream
);
791 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
795 case TYPE_CODE_BITSTRING
:
796 fputs_filtered ("BitString", stream
);
799 case TYPE_CODE_STRING
:
800 fputs_filtered ("String", stream
);
804 /* Handle types not explicitly handled by the other cases,
805 such as fundamental types. For these, just print whatever
806 the type name is, as recorded in the type itself. If there
807 is no type name, then complain. */
808 if (TYPE_NAME (type
) != NULL
)
810 fputs_filtered (TYPE_NAME (type
), stream
);
814 /* At least for dump_symtab, it is important that this not be
816 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",
This page took 0.04652 seconds and 4 git commands to generate.