1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright (C) 2000, 2001, 2002, 2006, 2007, 2008, 2009, 2010, 2011
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 3 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, see <http://www.gnu.org/licenses/>. */
20 /* This file is derived from p-typeprint.c */
23 #include "gdb_obstack.h"
24 #include "bfd.h" /* Binary File Description */
27 #include "expression.h"
33 #include "typeprint.h"
35 #include "gdb_string.h"
39 static void pascal_type_print_varspec_suffix (struct type
*, struct ui_file
*,
42 static void pascal_type_print_derivation_info (struct ui_file
*,
45 void pascal_type_print_varspec_prefix (struct type
*, struct ui_file
*,
49 /* LEVEL is the depth to indent lines by. */
52 pascal_print_type (struct type
*type
, const char *varstring
,
53 struct ui_file
*stream
, int show
, int level
)
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 /* Print a typedef using Pascal syntax. TYPE is the underlying type.
94 NEW_SYMBOL is the symbol naming the type. STREAM is the stream on
98 pascal_print_typedef (struct type
*type
, struct symbol
*new_symbol
,
99 struct ui_file
*stream
)
101 CHECK_TYPEDEF (type
);
102 fprintf_filtered (stream
, "type ");
103 fprintf_filtered (stream
, "%s = ", SYMBOL_PRINT_NAME (new_symbol
));
104 type_print (type
, "", stream
, 0);
105 fprintf_filtered (stream
, ";\n");
108 /* If TYPE is a derived type, then print out derivation information.
109 Print only the actual base classes of this type, not the base classes
110 of the base classes. I.E. for the derivation hierarchy:
113 class B : public A {int b; };
114 class C : public B {int c; };
116 Print the type of class C as:
122 Not as the following (like gdb used to), which is not legal C++ syntax for
123 derived types and may be confused with the multiple inheritance form:
125 class C : public B : public A {
129 In general, gdb should try to print the types as closely as possible to
130 the form that they appear in the source code. */
133 pascal_type_print_derivation_info (struct ui_file
*stream
, struct type
*type
)
138 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
140 fputs_filtered (i
== 0 ? ": " : ", ", stream
);
141 fprintf_filtered (stream
, "%s%s ",
142 BASETYPE_VIA_PUBLIC (type
, i
) ? "public" : "private",
143 BASETYPE_VIA_VIRTUAL (type
, i
) ? " virtual" : "");
144 name
= type_name_no_tag (TYPE_BASECLASS (type
, i
));
145 fprintf_filtered (stream
, "%s", name
? name
: "(null)");
149 fputs_filtered (" ", stream
);
153 /* Print the Pascal method arguments ARGS to the file STREAM. */
156 pascal_type_print_method_args (char *physname
, char *methodname
,
157 struct ui_file
*stream
)
159 int is_constructor
= (strncmp (physname
, "__ct__", 6) == 0);
160 int is_destructor
= (strncmp (physname
, "__dt__", 6) == 0);
162 if (is_constructor
|| is_destructor
)
167 fputs_filtered (methodname
, stream
);
169 if (physname
&& (*physname
!= 0))
171 fputs_filtered (" (", stream
);
172 /* we must demangle this */
173 while (isdigit (physname
[0]))
180 while (isdigit (physname
[len
]))
184 i
= strtol (physname
, &argname
, 0);
186 storec
= physname
[i
];
188 fputs_filtered (physname
, stream
);
189 physname
[i
] = storec
;
191 if (physname
[0] != 0)
193 fputs_filtered (", ", stream
);
196 fputs_filtered (")", stream
);
200 /* Print any asterisks or open-parentheses needed before the
201 variable name (to describe its type).
203 On outermost call, pass 0 for PASSED_A_PTR.
204 On outermost call, SHOW > 0 means should ignore
205 any typename for TYPE and show its details.
206 SHOW is always zero on recursive calls. */
209 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
210 int show
, int passed_a_ptr
)
215 if (TYPE_NAME (type
) && show
<= 0)
220 switch (TYPE_CODE (type
))
223 fprintf_filtered (stream
, "^");
224 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
225 break; /* pointer should be handled normally
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
),
244 stream
, 0, passed_a_ptr
);
245 fprintf_filtered (stream
, "::");
250 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
251 fprintf_filtered (stream
, "&");
256 fprintf_filtered (stream
, "(");
258 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
260 fprintf_filtered (stream
, "function ");
264 fprintf_filtered (stream
, "procedure ");
269 case TYPE_CODE_ARRAY
:
271 fprintf_filtered (stream
, "(");
272 fprintf_filtered (stream
, "array ");
273 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
274 && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type
))
275 fprintf_filtered (stream
, "[%s..%s] ",
276 plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type
)),
277 plongest (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 /* These types need no prefix. They are listed here so that
298 gcc -Wall will reveal any types that haven't been handled. */
301 error (_("type not handled in pascal_type_print_varspec_prefix()"));
307 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
309 int i
, len
= TYPE_NFIELDS (type
);
313 fprintf_filtered (stream
, "(");
315 for (i
= 0; i
< len
; i
++)
319 fputs_filtered (", ", stream
);
322 /* can we find if it is a var parameter ??
323 if ( TYPE_FIELD(type, i) == )
325 fprintf_filtered (stream, "var ");
327 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME
333 fprintf_filtered (stream
, ")");
337 /* Print any array sizes, function arguments or close parentheses
338 needed after the variable name (to describe its type).
339 Args work like pascal_type_print_varspec_prefix. */
342 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
343 int show
, int passed_a_ptr
,
349 if (TYPE_NAME (type
) && show
<= 0)
354 switch (TYPE_CODE (type
))
356 case TYPE_CODE_ARRAY
:
358 fprintf_filtered (stream
, ")");
361 case TYPE_CODE_METHOD
:
363 fprintf_filtered (stream
, ")");
364 pascal_type_print_method_args ("",
367 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
369 fprintf_filtered (stream
, " : ");
370 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
),
372 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
373 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
380 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
),
386 fprintf_filtered (stream
, ")");
388 pascal_print_func_args (type
, stream
);
389 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
391 fprintf_filtered (stream
, " : ");
392 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
),
394 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
395 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
400 case TYPE_CODE_UNDEF
:
401 case TYPE_CODE_STRUCT
:
402 case TYPE_CODE_UNION
:
407 case TYPE_CODE_ERROR
:
411 case TYPE_CODE_RANGE
:
412 case TYPE_CODE_STRING
:
413 case TYPE_CODE_BITSTRING
:
414 case TYPE_CODE_COMPLEX
:
415 case TYPE_CODE_TYPEDEF
:
416 /* These types do not need a suffix. They are listed so that
417 gcc -Wall will report types that may not have been considered. */
420 error (_("type not handled in pascal_type_print_varspec_suffix()"));
425 /* Print the name of the type (or the ultimate pointer target,
426 function value or array element), or the description of a
429 SHOW positive means print details about the type (e.g. enum values),
430 and print structure elements passing SHOW - 1 for show.
431 SHOW negative means just print the type name or struct tag if there is one.
432 If there is no name, print something sensible but concise like
434 SHOW zero means just print the type name or struct tag if there is one.
435 If there is no name, print something sensible but not as concise like
436 "struct {int x; int y;}".
438 LEVEL is the number of spaces to indent by.
439 We increase it for some recursive calls. */
442 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
450 s_none
, s_public
, s_private
, s_protected
458 fputs_filtered ("<type unknown>", stream
);
463 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
)
464 && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
466 fputs_filtered (TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer",
470 /* When SHOW is zero or less, and there is a valid type name, then always
471 just print the type name directly from the type. */
474 && TYPE_NAME (type
) != NULL
)
476 fputs_filtered (TYPE_NAME (type
), stream
);
480 CHECK_TYPEDEF (type
);
482 switch (TYPE_CODE (type
))
484 case TYPE_CODE_TYPEDEF
:
487 /* case TYPE_CODE_FUNC:
488 case TYPE_CODE_METHOD: */
489 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
492 case TYPE_CODE_ARRAY
:
493 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
495 pascal_type_print_base (TYPE_TARGET_TYPE (type),
496 stream, show, level);
497 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
499 pascal_print_type (TYPE_TARGET_TYPE (type
), NULL
, stream
, 0, 0);
503 case TYPE_CODE_METHOD
:
505 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
506 only after args !! */
508 case TYPE_CODE_STRUCT
:
509 if (TYPE_TAG_NAME (type
) != NULL
)
511 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
512 fputs_filtered (" = ", stream
);
514 if (HAVE_CPLUS_STRUCT (type
))
516 fprintf_filtered (stream
, "class ");
520 fprintf_filtered (stream
, "record ");
524 case TYPE_CODE_UNION
:
525 if (TYPE_TAG_NAME (type
) != NULL
)
527 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
528 fputs_filtered (" = ", stream
);
530 fprintf_filtered (stream
, "case <?> of ");
536 /* If we just printed a tag name, no need to print anything else. */
537 if (TYPE_TAG_NAME (type
) == NULL
)
538 fprintf_filtered (stream
, "{...}");
540 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
542 pascal_type_print_derivation_info (stream
, type
);
544 fprintf_filtered (stream
, "\n");
545 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
547 if (TYPE_STUB (type
))
548 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
550 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
553 /* Start off with no specific section type, so we can print
554 one for the first field we find, and use that section type
555 thereafter until we find another type. */
557 section_type
= s_none
;
559 /* If there is a base class for this type,
560 do not print the field that it occupies. */
562 len
= TYPE_NFIELDS (type
);
563 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
566 /* Don't print out virtual function table. */
567 if ((strncmp (TYPE_FIELD_NAME (type
, i
), "_vptr", 5) == 0)
568 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
571 /* If this is a pascal object or class we can print the
572 various section labels. */
574 if (HAVE_CPLUS_STRUCT (type
))
576 if (TYPE_FIELD_PROTECTED (type
, i
))
578 if (section_type
!= s_protected
)
580 section_type
= s_protected
;
581 fprintfi_filtered (level
+ 2, stream
,
585 else if (TYPE_FIELD_PRIVATE (type
, i
))
587 if (section_type
!= s_private
)
589 section_type
= s_private
;
590 fprintfi_filtered (level
+ 2, stream
, "private\n");
595 if (section_type
!= s_public
)
597 section_type
= s_public
;
598 fprintfi_filtered (level
+ 2, stream
, "public\n");
603 print_spaces_filtered (level
+ 4, stream
);
604 if (field_is_static (&TYPE_FIELD (type
, i
)))
605 fprintf_filtered (stream
, "static ");
606 pascal_print_type (TYPE_FIELD_TYPE (type
, i
),
607 TYPE_FIELD_NAME (type
, i
),
608 stream
, show
- 1, level
+ 4);
609 if (!field_is_static (&TYPE_FIELD (type
, i
))
610 && TYPE_FIELD_PACKED (type
, i
))
612 /* It is a bitfield. This code does not attempt
613 to look at the bitpos and reconstruct filler,
614 unnamed fields. This would lead to misleading
615 results if the compiler does not put out fields
616 for such things (I don't know what it does). */
617 fprintf_filtered (stream
, " : %d",
618 TYPE_FIELD_BITSIZE (type
, i
));
620 fprintf_filtered (stream
, ";\n");
623 /* If there are both fields and methods, put a space between. */
624 len
= TYPE_NFN_FIELDS (type
);
625 if (len
&& section_type
!= s_none
)
626 fprintf_filtered (stream
, "\n");
628 /* Pbject pascal: print out the methods */
630 for (i
= 0; i
< len
; i
++)
632 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (type
, i
);
633 int j
, len2
= TYPE_FN_FIELDLIST_LENGTH (type
, i
);
634 char *method_name
= TYPE_FN_FIELDLIST_NAME (type
, i
);
636 /* this is GNU C++ specific
637 how can we know constructor/destructor?
638 It might work for GNU pascal */
639 for (j
= 0; j
< len2
; j
++)
641 char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
643 int is_constructor
= (strncmp (physname
, "__ct__", 6) == 0);
644 int is_destructor
= (strncmp (physname
, "__dt__", 6) == 0);
647 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
649 if (section_type
!= s_protected
)
651 section_type
= s_protected
;
652 fprintfi_filtered (level
+ 2, stream
,
656 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
658 if (section_type
!= s_private
)
660 section_type
= s_private
;
661 fprintfi_filtered (level
+ 2, stream
, "private\n");
666 if (section_type
!= s_public
)
668 section_type
= s_public
;
669 fprintfi_filtered (level
+ 2, stream
, "public\n");
673 print_spaces_filtered (level
+ 4, stream
);
674 if (TYPE_FN_FIELD_STATIC_P (f
, j
))
675 fprintf_filtered (stream
, "static ");
676 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) == 0)
678 /* Keep GDB from crashing here. */
679 fprintf_filtered (stream
, "<undefined type> %s;\n",
680 TYPE_FN_FIELD_PHYSNAME (f
, j
));
686 fprintf_filtered (stream
, "constructor ");
688 else if (is_destructor
)
690 fprintf_filtered (stream
, "destructor ");
692 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
693 && TYPE_CODE (TYPE_TARGET_TYPE (
694 TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
696 fprintf_filtered (stream
, "function ");
700 fprintf_filtered (stream
, "procedure ");
702 /* this does not work, no idea why !! */
704 pascal_type_print_method_args (physname
,
708 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
709 && TYPE_CODE (TYPE_TARGET_TYPE (
710 TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
712 fputs_filtered (" : ", stream
);
713 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
716 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
717 fprintf_filtered (stream
, "; virtual");
719 fprintf_filtered (stream
, ";\n");
722 fprintfi_filtered (level
, stream
, "end");
727 if (TYPE_TAG_NAME (type
) != NULL
)
729 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
731 fputs_filtered (" ", stream
);
733 /* enum is just defined by
734 type enume_name = (enum_member1,enum_member2,...) */
735 fprintf_filtered (stream
, " = ");
739 /* If we just printed a tag name, no need to print anything else. */
740 if (TYPE_TAG_NAME (type
) == NULL
)
741 fprintf_filtered (stream
, "(...)");
743 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
745 fprintf_filtered (stream
, "(");
746 len
= TYPE_NFIELDS (type
);
748 for (i
= 0; i
< len
; i
++)
752 fprintf_filtered (stream
, ", ");
754 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
755 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
757 fprintf_filtered (stream
,
758 " := %d", TYPE_FIELD_BITPOS (type
, i
));
759 lastval
= TYPE_FIELD_BITPOS (type
, i
);
763 fprintf_filtered (stream
, ")");
768 fprintf_filtered (stream
, "void");
771 case TYPE_CODE_UNDEF
:
772 fprintf_filtered (stream
, "record <unknown>");
775 case TYPE_CODE_ERROR
:
776 fprintf_filtered (stream
, "%s", TYPE_ERROR_NAME (type
));
779 /* this probably does not work for enums */
780 case TYPE_CODE_RANGE
:
782 struct type
*target
= TYPE_TARGET_TYPE (type
);
784 print_type_scalar (target
, TYPE_LOW_BOUND (type
), stream
);
785 fputs_filtered ("..", stream
);
786 print_type_scalar (target
, TYPE_HIGH_BOUND (type
), stream
);
791 fputs_filtered ("set of ", stream
);
792 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
796 case TYPE_CODE_BITSTRING
:
797 fputs_filtered ("BitString", stream
);
800 case TYPE_CODE_STRING
:
801 fputs_filtered ("String", stream
);
805 /* Handle types not explicitly handled by the other cases,
806 such as fundamental types. For these, just print whatever
807 the type name is, as recorded in the type itself. If there
808 is no type name, then complain. */
809 if (TYPE_NAME (type
) != NULL
)
811 fputs_filtered (TYPE_NAME (type
), stream
);
815 /* At least for dump_symtab, it is important that this not be
817 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",
This page took 0.05023 seconds and 5 git commands to generate.