1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright (C) 2000, 2001, 2002, 2006, 2007, 2008
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
*, int, int, int);
41 static void pascal_type_print_derivation_info (struct ui_file
*, struct type
*);
43 void pascal_type_print_varspec_prefix (struct type
*, struct ui_file
*, int, int);
46 /* LEVEL is the depth to indent lines by. */
49 pascal_print_type (struct type
*type
, char *varstring
, struct ui_file
*stream
,
55 code
= TYPE_CODE (type
);
60 if ((code
== TYPE_CODE_FUNC
61 || code
== TYPE_CODE_METHOD
))
63 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
66 fputs_filtered (varstring
, stream
);
68 if ((varstring
!= NULL
&& *varstring
!= '\0')
69 && !(code
== TYPE_CODE_FUNC
70 || code
== TYPE_CODE_METHOD
))
72 fputs_filtered (" : ", stream
);
75 if (!(code
== TYPE_CODE_FUNC
76 || code
== TYPE_CODE_METHOD
))
78 pascal_type_print_varspec_prefix (type
, stream
, show
, 0);
81 pascal_type_print_base (type
, stream
, show
, level
);
82 /* For demangled function names, we have the arglist as part of the name,
83 so don't print an additional pair of ()'s */
85 demangled_args
= varstring
? strchr (varstring
, '(') != NULL
: 0;
86 pascal_type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
);
90 /* If TYPE is a derived type, then print out derivation information.
91 Print only the actual base classes of this type, not the base classes
92 of the base classes. I.E. for the derivation hierarchy:
95 class B : public A {int b; };
96 class C : public B {int c; };
98 Print the type of class C as:
104 Not as the following (like gdb used to), which is not legal C++ syntax for
105 derived types and may be confused with the multiple inheritance form:
107 class C : public B : public A {
111 In general, gdb should try to print the types as closely as possible to
112 the form that they appear in the source code. */
115 pascal_type_print_derivation_info (struct ui_file
*stream
, struct type
*type
)
120 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
122 fputs_filtered (i
== 0 ? ": " : ", ", stream
);
123 fprintf_filtered (stream
, "%s%s ",
124 BASETYPE_VIA_PUBLIC (type
, i
) ? "public" : "private",
125 BASETYPE_VIA_VIRTUAL (type
, i
) ? " virtual" : "");
126 name
= type_name_no_tag (TYPE_BASECLASS (type
, i
));
127 fprintf_filtered (stream
, "%s", name
? name
: "(null)");
131 fputs_filtered (" ", stream
);
135 /* Print the Pascal method arguments ARGS to the file STREAM. */
138 pascal_type_print_method_args (char *physname
, char *methodname
,
139 struct ui_file
*stream
)
141 int is_constructor
= (strncmp (physname
, "__ct__", 6) == 0);
142 int is_destructor
= (strncmp (physname
, "__dt__", 6) == 0);
144 if (is_constructor
|| is_destructor
)
149 fputs_filtered (methodname
, stream
);
151 if (physname
&& (*physname
!= 0))
157 fputs_filtered (" (", stream
);
158 /* we must demangle this */
159 while (isdigit (physname
[0]))
161 while (isdigit (physname
[len
]))
165 i
= strtol (physname
, &argname
, 0);
167 storec
= physname
[i
];
169 fputs_filtered (physname
, stream
);
170 physname
[i
] = storec
;
172 if (physname
[0] != 0)
174 fputs_filtered (", ", stream
);
177 fputs_filtered (")", stream
);
181 /* Print any asterisks or open-parentheses needed before the
182 variable name (to describe its type).
184 On outermost call, pass 0 for PASSED_A_PTR.
185 On outermost call, SHOW > 0 means should ignore
186 any typename for TYPE and show its details.
187 SHOW is always zero on recursive calls. */
190 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
191 int show
, int passed_a_ptr
)
197 if (TYPE_NAME (type
) && show
<= 0)
202 switch (TYPE_CODE (type
))
205 fprintf_filtered (stream
, "^");
206 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
207 break; /* pointer should be handled normally in pascal */
209 case TYPE_CODE_METHOD
:
211 fprintf_filtered (stream
, "(");
212 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
214 fprintf_filtered (stream
, "function ");
218 fprintf_filtered (stream
, "procedure ");
223 fprintf_filtered (stream
, " ");
224 pascal_type_print_base (TYPE_DOMAIN_TYPE (type
), stream
, 0, passed_a_ptr
);
225 fprintf_filtered (stream
, "::");
230 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
231 fprintf_filtered (stream
, "&");
236 fprintf_filtered (stream
, "(");
238 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
240 fprintf_filtered (stream
, "function ");
244 fprintf_filtered (stream
, "procedure ");
249 case TYPE_CODE_ARRAY
:
251 fprintf_filtered (stream
, "(");
252 fprintf_filtered (stream
, "array ");
253 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
254 && TYPE_ARRAY_UPPER_BOUND_TYPE (type
) != BOUND_CANNOT_BE_DETERMINED
)
255 fprintf_filtered (stream
, "[%d..%d] ",
256 TYPE_ARRAY_LOWER_BOUND_VALUE (type
),
257 TYPE_ARRAY_UPPER_BOUND_VALUE (type
)
259 fprintf_filtered (stream
, "of ");
262 case TYPE_CODE_UNDEF
:
263 case TYPE_CODE_STRUCT
:
264 case TYPE_CODE_UNION
:
269 case TYPE_CODE_ERROR
:
273 case TYPE_CODE_RANGE
:
274 case TYPE_CODE_STRING
:
275 case TYPE_CODE_BITSTRING
:
276 case TYPE_CODE_COMPLEX
:
277 case TYPE_CODE_TYPEDEF
:
278 case TYPE_CODE_TEMPLATE
:
279 /* These types need no prefix. They are listed here so that
280 gcc -Wall will reveal any types that haven't been handled. */
283 error (_("type not handled in pascal_type_print_varspec_prefix()"));
289 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
)
291 int i
, len
= TYPE_NFIELDS (type
);
294 fprintf_filtered (stream
, "(");
296 for (i
= 0; i
< len
; i
++)
300 fputs_filtered (", ", stream
);
303 /* can we find if it is a var parameter ??
304 if ( TYPE_FIELD(type, i) == )
306 fprintf_filtered (stream, "var ");
308 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME seems invalid ! */
313 fprintf_filtered (stream
, ")");
317 /* Print any array sizes, function arguments or close parentheses
318 needed after the variable name (to describe its type).
319 Args work like pascal_type_print_varspec_prefix. */
322 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
323 int show
, int passed_a_ptr
,
329 if (TYPE_NAME (type
) && show
<= 0)
334 switch (TYPE_CODE (type
))
336 case TYPE_CODE_ARRAY
:
338 fprintf_filtered (stream
, ")");
341 case TYPE_CODE_METHOD
:
343 fprintf_filtered (stream
, ")");
344 pascal_type_print_method_args ("",
347 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
349 fprintf_filtered (stream
, " : ");
350 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
351 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
352 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
359 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 1, 0);
364 fprintf_filtered (stream
, ")");
366 pascal_print_func_args (type
, stream
);
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
), stream
, 0, 0);
371 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
372 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
377 case TYPE_CODE_UNDEF
:
378 case TYPE_CODE_STRUCT
:
379 case TYPE_CODE_UNION
:
384 case TYPE_CODE_ERROR
:
388 case TYPE_CODE_RANGE
:
389 case TYPE_CODE_STRING
:
390 case TYPE_CODE_BITSTRING
:
391 case TYPE_CODE_COMPLEX
:
392 case TYPE_CODE_TYPEDEF
:
393 case TYPE_CODE_TEMPLATE
:
394 /* These types do not need a suffix. They are listed so that
395 gcc -Wall will report types that may not have been considered. */
398 error (_("type not handled in pascal_type_print_varspec_suffix()"));
403 /* Print the name of the type (or the ultimate pointer target,
404 function value or array element), or the description of a
407 SHOW positive means print details about the type (e.g. enum values),
408 and print structure elements passing SHOW - 1 for show.
409 SHOW negative means just print the type name or struct tag if there is one.
410 If there is no name, print something sensible but concise like
412 SHOW zero means just print the type name or struct tag if there is one.
413 If there is no name, print something sensible but not as concise like
414 "struct {int x; int y;}".
416 LEVEL is the number of spaces to indent by.
417 We increase it for some recursive calls. */
420 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
428 s_none
, s_public
, s_private
, s_protected
436 fputs_filtered ("<type unknown>", stream
);
441 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
) && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
443 fputs_filtered (TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer",
447 /* When SHOW is zero or less, and there is a valid type name, then always
448 just print the type name directly from the type. */
451 && TYPE_NAME (type
) != NULL
)
453 fputs_filtered (TYPE_NAME (type
), stream
);
457 CHECK_TYPEDEF (type
);
459 switch (TYPE_CODE (type
))
461 case TYPE_CODE_TYPEDEF
:
464 /* case TYPE_CODE_FUNC:
465 case TYPE_CODE_METHOD: */
466 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
469 case TYPE_CODE_ARRAY
:
470 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
471 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
472 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
473 pascal_print_type (TYPE_TARGET_TYPE (type
), NULL
, stream
, 0, 0);
477 case TYPE_CODE_METHOD
:
479 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
480 only after args !! */
482 case TYPE_CODE_STRUCT
:
483 if (TYPE_TAG_NAME (type
) != NULL
)
485 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
486 fputs_filtered (" = ", stream
);
488 if (HAVE_CPLUS_STRUCT (type
))
490 fprintf_filtered (stream
, "class ");
494 fprintf_filtered (stream
, "record ");
498 case TYPE_CODE_UNION
:
499 if (TYPE_TAG_NAME (type
) != NULL
)
501 fputs_filtered (TYPE_TAG_NAME (type
), stream
);
502 fputs_filtered (" = ", stream
);
504 fprintf_filtered (stream
, "case <?> of ");
510 /* If we just printed a tag name, no need to print anything else. */
511 if (TYPE_TAG_NAME (type
) == NULL
)
512 fprintf_filtered (stream
, "{...}");
514 else if (show
> 0 || TYPE_TAG_NAME (type
) == NULL
)
516 pascal_type_print_derivation_info (stream
, type
);
518 fprintf_filtered (stream
, "\n");
519 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
521 if (TYPE_STUB (type
))
522 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
524 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
527 /* Start off with no specific section type, so we can print
528 one for the first field we find, and use that section type
529 thereafter until we find another type. */
531 section_type
= s_none
;
533 /* If there is a base class for this type,
534 do not print the field that it occupies. */
536 len
= TYPE_NFIELDS (type
);
537 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
540 /* Don't print out virtual function table. */
541 if ((strncmp (TYPE_FIELD_NAME (type
, i
), "_vptr", 5) == 0)
542 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
545 /* If this is a pascal object or class we can print the
546 various section labels. */
548 if (HAVE_CPLUS_STRUCT (type
))
550 if (TYPE_FIELD_PROTECTED (type
, i
))
552 if (section_type
!= s_protected
)
554 section_type
= s_protected
;
555 fprintfi_filtered (level
+ 2, stream
,
559 else if (TYPE_FIELD_PRIVATE (type
, i
))
561 if (section_type
!= s_private
)
563 section_type
= s_private
;
564 fprintfi_filtered (level
+ 2, stream
, "private\n");
569 if (section_type
!= s_public
)
571 section_type
= s_public
;
572 fprintfi_filtered (level
+ 2, stream
, "public\n");
577 print_spaces_filtered (level
+ 4, stream
);
578 if (TYPE_FIELD_STATIC (type
, i
))
580 fprintf_filtered (stream
, "static ");
582 pascal_print_type (TYPE_FIELD_TYPE (type
, i
),
583 TYPE_FIELD_NAME (type
, i
),
584 stream
, show
- 1, level
+ 4);
585 if (!TYPE_FIELD_STATIC (type
, i
)
586 && TYPE_FIELD_PACKED (type
, i
))
588 /* It is a bitfield. This code does not attempt
589 to look at the bitpos and reconstruct filler,
590 unnamed fields. This would lead to misleading
591 results if the compiler does not put out fields
592 for such things (I don't know what it does). */
593 fprintf_filtered (stream
, " : %d",
594 TYPE_FIELD_BITSIZE (type
, i
));
596 fprintf_filtered (stream
, ";\n");
599 /* If there are both fields and methods, put a space between. */
600 len
= TYPE_NFN_FIELDS (type
);
601 if (len
&& section_type
!= s_none
)
602 fprintf_filtered (stream
, "\n");
604 /* Pbject pascal: print out the methods */
606 for (i
= 0; i
< len
; i
++)
608 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (type
, i
);
609 int j
, len2
= TYPE_FN_FIELDLIST_LENGTH (type
, i
);
610 char *method_name
= TYPE_FN_FIELDLIST_NAME (type
, i
);
611 char *name
= type_name_no_tag (type
);
612 /* this is GNU C++ specific
613 how can we know constructor/destructor?
614 It might work for GNU pascal */
615 for (j
= 0; j
< len2
; j
++)
617 char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
619 int is_constructor
= (strncmp (physname
, "__ct__", 6) == 0);
620 int is_destructor
= (strncmp (physname
, "__dt__", 6) == 0);
623 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
625 if (section_type
!= s_protected
)
627 section_type
= s_protected
;
628 fprintfi_filtered (level
+ 2, stream
,
632 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
634 if (section_type
!= s_private
)
636 section_type
= s_private
;
637 fprintfi_filtered (level
+ 2, stream
, "private\n");
642 if (section_type
!= s_public
)
644 section_type
= s_public
;
645 fprintfi_filtered (level
+ 2, stream
, "public\n");
649 print_spaces_filtered (level
+ 4, stream
);
650 if (TYPE_FN_FIELD_STATIC_P (f
, j
))
651 fprintf_filtered (stream
, "static ");
652 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) == 0)
654 /* Keep GDB from crashing here. */
655 fprintf_filtered (stream
, "<undefined type> %s;\n",
656 TYPE_FN_FIELD_PHYSNAME (f
, j
));
662 fprintf_filtered (stream
, "constructor ");
664 else if (is_destructor
)
666 fprintf_filtered (stream
, "destructor ");
668 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
669 && TYPE_CODE (TYPE_TARGET_TYPE (
670 TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
672 fprintf_filtered (stream
, "function ");
676 fprintf_filtered (stream
, "procedure ");
678 /* this does not work, no idea why !! */
680 pascal_type_print_method_args (physname
,
684 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
685 && TYPE_CODE (TYPE_TARGET_TYPE (
686 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_int32
;
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>",