1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright (C) 2000, 2001, 2002, 2006
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., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* This file is derived from p-typeprint.c */
25 #include "gdb_obstack.h"
26 #include "bfd.h" /* Binary File Description */
29 #include "expression.h"
35 #include "typeprint.h"
37 #include "gdb_string.h"
41 static void pascal_type_print_varspec_suffix (struct type
*, struct ui_file
*, int, int, int);
43 static void pascal_type_print_derivation_info (struct ui_file
*, struct type
*);
45 void pascal_type_print_varspec_prefix (struct type
*, struct ui_file
*, int, int);
48 /* LEVEL is the depth to indent lines by. */
51 pascal_print_type (struct type
*type
, char *varstring
, struct ui_file
*stream
,
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 /* If TYPE is a derived type, then print out derivation information.
93 Print only the actual base classes of this type, not the base classes
94 of the base classes. I.E. for the derivation hierarchy:
97 class B : public A {int b; };
98 class C : public B {int c; };
100 Print the type of class C as:
106 Not as the following (like gdb used to), which is not legal C++ syntax for
107 derived types and may be confused with the multiple inheritance form:
109 class C : public B : public A {
113 In general, gdb should try to print the types as closely as possible to
114 the form that they appear in the source code. */
117 pascal_type_print_derivation_info (struct ui_file
*stream
, struct type
*type
)
122 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
124 fputs_filtered (i
== 0 ? ": " : ", ", stream
);
125 fprintf_filtered (stream
, "%s%s ",
126 BASETYPE_VIA_PUBLIC (type
, i
) ? "public" : "private",
127 BASETYPE_VIA_VIRTUAL (type
, i
) ? " virtual" : "");
128 name
= type_name_no_tag (TYPE_BASECLASS (type
, i
));
129 fprintf_filtered (stream
, "%s", name
? name
: "(null)");
133 fputs_filtered (" ", stream
);
137 /* Print the Pascal method arguments ARGS to the file STREAM. */
140 pascal_type_print_method_args (char *physname
, char *methodname
,
141 struct ui_file
*stream
)
143 int is_constructor
= DEPRECATED_STREQN (physname
, "__ct__", 6);
144 int is_destructor
= DEPRECATED_STREQN (physname
, "__dt__", 6);
146 if (is_constructor
|| is_destructor
)
151 fputs_filtered (methodname
, stream
);
153 if (physname
&& (*physname
!= 0))
159 fputs_filtered (" (", stream
);
160 /* we must demangle this */
161 while (isdigit (physname
[0]))
163 while (isdigit (physname
[len
]))
167 i
= strtol (physname
, &argname
, 0);
169 storec
= physname
[i
];
171 fputs_filtered (physname
, stream
);
172 physname
[i
] = storec
;
174 if (physname
[0] != 0)
176 fputs_filtered (", ", stream
);
179 fputs_filtered (")", stream
);
183 /* Print any asterisks or open-parentheses needed before the
184 variable name (to describe its type).
186 On outermost call, pass 0 for PASSED_A_PTR.
187 On outermost call, SHOW > 0 means should ignore
188 any typename for TYPE and show its details.
189 SHOW is always zero on recursive calls. */
192 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
193 int show
, int passed_a_ptr
)
199 if (TYPE_NAME (type
) && show
<= 0)
204 switch (TYPE_CODE (type
))
207 fprintf_filtered (stream
, "^");
208 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
209 break; /* pointer should be handled normally in pascal */
211 case TYPE_CODE_METHOD
:
213 fprintf_filtered (stream
, "(");
214 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
216 fprintf_filtered (stream
, "function ");
220 fprintf_filtered (stream
, "procedure ");
225 fprintf_filtered (stream
, " ");
226 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
227 fprintf_filtered (stream
, "::");
232 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
233 fprintf_filtered (stream
, "&");
238 fprintf_filtered (stream
, "(");
240 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
242 fprintf_filtered (stream
, "function ");
246 fprintf_filtered (stream
, "procedure ");
251 case TYPE_CODE_ARRAY
:
253 fprintf_filtered (stream
, "(");
254 fprintf_filtered (stream
, "array ");
255 if (TYPE_LENGTH (type
) >= 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
256 && TYPE_ARRAY_UPPER_BOUND_TYPE (type
) != BOUND_CANNOT_BE_DETERMINED
)
257 fprintf_filtered (stream
, "[%d..%d] ",
258 TYPE_ARRAY_LOWER_BOUND_VALUE (type
),
259 TYPE_ARRAY_UPPER_BOUND_VALUE (type
)
261 fprintf_filtered (stream
, "of ");
264 case TYPE_CODE_UNDEF
:
265 case TYPE_CODE_STRUCT
:
266 case TYPE_CODE_UNION
:
271 case TYPE_CODE_ERROR
:
275 case TYPE_CODE_RANGE
:
276 case TYPE_CODE_STRING
:
277 case TYPE_CODE_BITSTRING
:
278 case TYPE_CODE_COMPLEX
:
279 case TYPE_CODE_TYPEDEF
:
280 case TYPE_CODE_TEMPLATE
:
281 /* These types need no prefix. They are listed here so that
282 gcc -Wall will reveal any types that haven't been handled. */
285 error (_("type not handled in pascal_type_print_varspec_prefix()"));
291 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
293 int i
, len
= TYPE_NFIELDS (type
);
296 fprintf_filtered (stream
, "(");
298 for (i
= 0; i
< len
; i
++)
302 fputs_filtered (", ", stream
);
305 /* can we find if it is a var parameter ??
306 if ( TYPE_FIELD(type, i) == )
308 fprintf_filtered (stream, "var ");
310 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME seems invalid ! */
315 fprintf_filtered (stream
, ")");
319 /* Print any array sizes, function arguments or close parentheses
320 needed after the variable name (to describe its type).
321 Args work like pascal_type_print_varspec_prefix. */
324 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
325 int show
, int passed_a_ptr
,
331 if (TYPE_NAME (type
) && show
<= 0)
336 switch (TYPE_CODE (type
))
338 case TYPE_CODE_ARRAY
:
340 fprintf_filtered (stream
, ")");
343 case TYPE_CODE_METHOD
:
345 fprintf_filtered (stream
, ")");
346 pascal_type_print_method_args ("",
349 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
351 fprintf_filtered (stream
, " : ");
352 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
353 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
354 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
361 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 1, 0);
366 fprintf_filtered (stream
, ")");
368 pascal_print_func_args (type
, stream
);
369 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
371 fprintf_filtered (stream
, " : ");
372 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
373 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
374 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
379 case TYPE_CODE_UNDEF
:
380 case TYPE_CODE_STRUCT
:
381 case TYPE_CODE_UNION
:
386 case TYPE_CODE_ERROR
:
390 case TYPE_CODE_RANGE
:
391 case TYPE_CODE_STRING
:
392 case TYPE_CODE_BITSTRING
:
393 case TYPE_CODE_COMPLEX
:
394 case TYPE_CODE_TYPEDEF
:
395 case TYPE_CODE_TEMPLATE
:
396 /* These types do not need a suffix. They are listed so that
397 gcc -Wall will report types that may not have been considered. */
400 error (_("type not handled in pascal_type_print_varspec_suffix()"));
405 /* Print the name of the type (or the ultimate pointer target,
406 function value or array element), or the description of a
409 SHOW positive means print details about the type (e.g. enum values),
410 and print structure elements passing SHOW - 1 for show.
411 SHOW negative means just print the type name or struct tag if there is one.
412 If there is no name, print something sensible but concise like
414 SHOW zero means just print the type name or struct tag if there is one.
415 If there is no name, print something sensible but not as concise like
416 "struct {int x; int y;}".
418 LEVEL is the number of spaces to indent by.
419 We increase it for some recursive calls. */
422 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
430 s_none
, s_public
, s_private
, s_protected
438 fputs_filtered ("<type unknown>", stream
);
443 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
) && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
445 fputs_filtered (TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer",
449 /* When SHOW is zero or less, and there is a valid type name, then always
450 just print the type name directly from the type. */
453 && TYPE_NAME (type
) != NULL
)
455 fputs_filtered (TYPE_NAME (type
), stream
);
459 CHECK_TYPEDEF (type
);
461 switch (TYPE_CODE (type
))
463 case TYPE_CODE_TYPEDEF
:
466 /* case TYPE_CODE_FUNC:
467 case TYPE_CODE_METHOD: */
468 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
471 case TYPE_CODE_ARRAY
:
472 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
473 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
474 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
475 pascal_print_type (TYPE_TARGET_TYPE (type
), NULL
, stream
, 0, 0);
479 case TYPE_CODE_METHOD
:
481 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
482 only after args !! */
484 case TYPE_CODE_STRUCT
:
485 if (TYPE_TAG_NAME (type
) != NULL
)
487 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
488 fputs_filtered (" = ", stream
);
490 if (HAVE_CPLUS_STRUCT (type
))
492 fprintf_filtered (stream
, "class ");
496 fprintf_filtered (stream
, "record ");
500 case TYPE_CODE_UNION
:
501 if (TYPE_TAG_NAME (type
) != NULL
)
503 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
504 fputs_filtered (" = ", stream
);
506 fprintf_filtered (stream
, "case <?> of ");
512 /* If we just printed a tag name, no need to print anything else. */
513 if (TYPE_TAG_NAME (type
) == NULL
)
514 fprintf_filtered (stream
, "{...}");
516 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
518 pascal_type_print_derivation_info (stream
, type
);
520 fprintf_filtered (stream
, "\n");
521 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
523 if (TYPE_STUB (type
))
524 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
526 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
529 /* Start off with no specific section type, so we can print
530 one for the first field we find, and use that section type
531 thereafter until we find another type. */
533 section_type
= s_none
;
535 /* If there is a base class for this type,
536 do not print the field that it occupies. */
538 len
= TYPE_NFIELDS (type
);
539 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
542 /* Don't print out virtual function table. */
543 if (DEPRECATED_STREQN (TYPE_FIELD_NAME (type
, i
), "_vptr", 5)
544 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
547 /* If this is a pascal object or class we can print the
548 various section labels. */
550 if (HAVE_CPLUS_STRUCT (type
))
552 if (TYPE_FIELD_PROTECTED (type
, i
))
554 if (section_type
!= s_protected
)
556 section_type
= s_protected
;
557 fprintfi_filtered (level
+ 2, stream
,
561 else if (TYPE_FIELD_PRIVATE (type
, i
))
563 if (section_type
!= s_private
)
565 section_type
= s_private
;
566 fprintfi_filtered (level
+ 2, stream
, "private\n");
571 if (section_type
!= s_public
)
573 section_type
= s_public
;
574 fprintfi_filtered (level
+ 2, stream
, "public\n");
579 print_spaces_filtered (level
+ 4, stream
);
580 if (TYPE_FIELD_STATIC (type
, i
))
582 fprintf_filtered (stream
, "static ");
584 pascal_print_type (TYPE_FIELD_TYPE (type
, i
),
585 TYPE_FIELD_NAME (type
, i
),
586 stream
, show
- 1, level
+ 4);
587 if (!TYPE_FIELD_STATIC (type
, i
)
588 && TYPE_FIELD_PACKED (type
, i
))
590 /* It is a bitfield. This code does not attempt
591 to look at the bitpos and reconstruct filler,
592 unnamed fields. This would lead to misleading
593 results if the compiler does not put out fields
594 for such things (I don't know what it does). */
595 fprintf_filtered (stream
, " : %d",
596 TYPE_FIELD_BITSIZE (type
, i
));
598 fprintf_filtered (stream
, ";\n");
601 /* If there are both fields and methods, put a space between. */
602 len
= TYPE_NFN_FIELDS (type
);
603 if (len
&& section_type
!= s_none
)
604 fprintf_filtered (stream
, "\n");
606 /* Pbject pascal: print out the methods */
608 for (i
= 0; i
< len
; i
++)
610 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (type
, i
);
611 int j
, len2
= TYPE_FN_FIELDLIST_LENGTH (type
, i
);
612 char *method_name
= TYPE_FN_FIELDLIST_NAME (type
, i
);
613 char *name
= type_name_no_tag (type
);
614 /* this is GNU C++ specific
615 how can we know constructor/destructor?
616 It might work for GNU pascal */
617 for (j
= 0; j
< len2
; j
++)
619 char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
621 int is_constructor
= DEPRECATED_STREQN (physname
, "__ct__", 6);
622 int is_destructor
= DEPRECATED_STREQN (physname
, "__dt__", 6);
625 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
627 if (section_type
!= s_protected
)
629 section_type
= s_protected
;
630 fprintfi_filtered (level
+ 2, stream
,
634 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
636 if (section_type
!= s_private
)
638 section_type
= s_private
;
639 fprintfi_filtered (level
+ 2, stream
, "private\n");
644 if (section_type
!= s_public
)
646 section_type
= s_public
;
647 fprintfi_filtered (level
+ 2, stream
, "public\n");
651 print_spaces_filtered (level
+ 4, stream
);
652 if (TYPE_FN_FIELD_STATIC_P (f
, j
))
653 fprintf_filtered (stream
, "static ");
654 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) == 0)
656 /* Keep GDB from crashing here. */
657 fprintf_filtered (stream
, "<undefined type> %s;\n",
658 TYPE_FN_FIELD_PHYSNAME (f
, j
));
664 fprintf_filtered (stream
, "constructor ");
666 else if (is_destructor
)
668 fprintf_filtered (stream
, "destructor ");
670 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0 &&
671 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
673 fprintf_filtered (stream
, "function ");
677 fprintf_filtered (stream
, "procedure ");
679 /* this does not work, no idea why !! */
681 pascal_type_print_method_args (physname
,
685 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0 &&
686 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
688 fputs_filtered (" : ", stream
);
689 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
692 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
693 fprintf_filtered (stream
, "; virtual");
695 fprintf_filtered (stream
, ";\n");
698 fprintfi_filtered (level
, stream
, "end");
703 if (TYPE_TAG_NAME (type
) != NULL
)
705 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
707 fputs_filtered (" ", stream
);
709 /* enum is just defined by
710 type enume_name = (enum_member1,enum_member2,...) */
711 fprintf_filtered (stream
, " = ");
715 /* If we just printed a tag name, no need to print anything else. */
716 if (TYPE_TAG_NAME (type
) == NULL
)
717 fprintf_filtered (stream
, "(...)");
719 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
721 fprintf_filtered (stream
, "(");
722 len
= TYPE_NFIELDS (type
);
724 for (i
= 0; i
< len
; i
++)
728 fprintf_filtered (stream
, ", ");
730 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
731 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
733 fprintf_filtered (stream
, " := %d", TYPE_FIELD_BITPOS (type
, i
));
734 lastval
= TYPE_FIELD_BITPOS (type
, i
);
738 fprintf_filtered (stream
, ")");
743 fprintf_filtered (stream
, "void");
746 case TYPE_CODE_UNDEF
:
747 fprintf_filtered (stream
, "record <unknown>");
750 case TYPE_CODE_ERROR
:
751 fprintf_filtered (stream
, "<unknown type>");
754 /* this probably does not work for enums */
755 case TYPE_CODE_RANGE
:
757 struct type
*target
= TYPE_TARGET_TYPE (type
);
759 target
= builtin_type_long
;
760 print_type_scalar (target
, TYPE_LOW_BOUND (type
), stream
);
761 fputs_filtered ("..", stream
);
762 print_type_scalar (target
, TYPE_HIGH_BOUND (type
), stream
);
767 fputs_filtered ("set of ", stream
);
768 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
772 case TYPE_CODE_BITSTRING
:
773 fputs_filtered ("BitString", stream
);
776 case TYPE_CODE_STRING
:
777 fputs_filtered ("String", stream
);
781 /* Handle types not explicitly handled by the other cases,
782 such as fundamental types. For these, just print whatever
783 the type name is, as recorded in the type itself. If there
784 is no type name, then complain. */
785 if (TYPE_NAME (type
) != NULL
)
787 fputs_filtered (TYPE_NAME (type
), stream
);
791 /* At least for dump_symtab, it is important that this not be
793 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",