1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright (C) 2000-2018 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"
36 static void pascal_type_print_varspec_suffix (struct type
*, struct ui_file
*,
38 const struct type_print_options
*);
40 static void pascal_type_print_derivation_info (struct ui_file
*,
45 /* LEVEL is the depth to indent lines by. */
48 pascal_print_type (struct type
*type
, const char *varstring
,
49 struct ui_file
*stream
, int show
, int level
,
50 const struct type_print_options
*flags
)
55 code
= TYPE_CODE (type
);
58 type
= check_typedef (type
);
60 if ((code
== TYPE_CODE_FUNC
61 || code
== TYPE_CODE_METHOD
))
63 pascal_type_print_varspec_prefix (type
, stream
, show
, 0, flags
);
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, flags
);
81 pascal_type_print_base (type
, stream
, show
, level
, flags
);
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
,
91 /* Print a typedef using Pascal syntax. TYPE is the underlying type.
92 NEW_SYMBOL is the symbol naming the type. STREAM is the stream on
96 pascal_print_typedef (struct type
*type
, struct symbol
*new_symbol
,
97 struct ui_file
*stream
)
99 type
= check_typedef (type
);
100 fprintf_filtered (stream
, "type ");
101 fprintf_filtered (stream
, "%s = ", SYMBOL_PRINT_NAME (new_symbol
));
102 type_print (type
, "", stream
, 0);
103 fprintf_filtered (stream
, ";\n");
106 /* If TYPE is a derived type, then print out derivation information.
107 Print only the actual base classes of this type, not the base classes
108 of the base classes. I.e. for the derivation hierarchy:
111 class B : public A {int b; };
112 class C : public B {int c; };
114 Print the type of class C as:
120 Not as the following (like gdb used to), which is not legal C++ syntax for
121 derived types and may be confused with the multiple inheritance form:
123 class C : public B : public A {
127 In general, gdb should try to print the types as closely as possible to
128 the form that they appear in the source code. */
131 pascal_type_print_derivation_info (struct ui_file
*stream
, struct type
*type
)
136 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
138 fputs_filtered (i
== 0 ? ": " : ", ", stream
);
139 fprintf_filtered (stream
, "%s%s ",
140 BASETYPE_VIA_PUBLIC (type
, i
) ? "public" : "private",
141 BASETYPE_VIA_VIRTUAL (type
, i
) ? " virtual" : "");
142 name
= TYPE_NAME (TYPE_BASECLASS (type
, i
));
143 fprintf_filtered (stream
, "%s", name
? name
: "(null)");
147 fputs_filtered (" ", stream
);
151 /* Print the Pascal method arguments ARGS to the file STREAM. */
154 pascal_type_print_method_args (const char *physname
, const char *methodname
,
155 struct ui_file
*stream
)
157 int is_constructor
= (startswith (physname
, "__ct__"));
158 int is_destructor
= (startswith (physname
, "__dt__"));
160 if (is_constructor
|| is_destructor
)
165 fputs_filtered (methodname
, stream
);
167 if (physname
&& (*physname
!= 0))
169 fputs_filtered (" (", stream
);
170 /* We must demangle this. */
171 while (isdigit (physname
[0]))
177 while (isdigit (physname
[len
]))
181 i
= strtol (physname
, &argname
, 0);
184 for (j
= 0; j
< i
; ++j
)
185 fputc_filtered (physname
[j
], stream
);
188 if (physname
[0] != 0)
190 fputs_filtered (", ", stream
);
193 fputs_filtered (")", stream
);
197 /* Print any asterisks or open-parentheses needed before the
198 variable name (to describe its type).
200 On outermost call, pass 0 for PASSED_A_PTR.
201 On outermost call, SHOW > 0 means should ignore
202 any typename for TYPE and show its details.
203 SHOW is always zero on recursive calls. */
206 pascal_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
207 int show
, int passed_a_ptr
,
208 const struct type_print_options
*flags
)
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,
224 break; /* Pointer should be handled normally
227 case TYPE_CODE_METHOD
:
229 fprintf_filtered (stream
, "(");
230 if (TYPE_TARGET_TYPE (type
) != NULL
231 && 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_SELF_TYPE (type
),
244 stream
, 0, passed_a_ptr
, flags
);
245 fprintf_filtered (stream
, "::");
250 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1,
252 fprintf_filtered (stream
, "&");
257 fprintf_filtered (stream
, "(");
259 if (TYPE_TARGET_TYPE (type
) != NULL
260 && TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
262 fprintf_filtered (stream
, "function ");
266 fprintf_filtered (stream
, "procedure ");
271 case TYPE_CODE_ARRAY
:
273 fprintf_filtered (stream
, "(");
274 fprintf_filtered (stream
, "array ");
275 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
276 && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type
))
277 fprintf_filtered (stream
, "[%s..%s] ",
278 plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type
)),
279 plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type
)));
280 fprintf_filtered (stream
, "of ");
283 case TYPE_CODE_UNDEF
:
284 case TYPE_CODE_STRUCT
:
285 case TYPE_CODE_UNION
:
290 case TYPE_CODE_ERROR
:
294 case TYPE_CODE_RANGE
:
295 case TYPE_CODE_STRING
:
296 case TYPE_CODE_COMPLEX
:
297 case TYPE_CODE_TYPEDEF
:
298 /* These types need no prefix. They are listed here so that
299 gcc -Wall will reveal any types that haven't been handled. */
302 error (_("type not handled in pascal_type_print_varspec_prefix()"));
308 pascal_print_func_args (struct type
*type
, struct ui_file
*stream
,
309 const struct type_print_options
*flags
)
311 int i
, len
= TYPE_NFIELDS (type
);
315 fprintf_filtered (stream
, "(");
317 for (i
= 0; i
< len
; i
++)
321 fputs_filtered (", ", stream
);
324 /* Can we find if it is a var parameter ??
325 if ( TYPE_FIELD(type, i) == )
327 fprintf_filtered (stream, "var ");
329 pascal_print_type (TYPE_FIELD_TYPE (type
, i
), "" /* TYPE_FIELD_NAME
331 ,stream
, -1, 0, flags
);
335 fprintf_filtered (stream
, ")");
339 /* Helper for pascal_type_print_varspec_suffix to print the suffix of
340 a function or method. */
343 pascal_type_print_func_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
344 int show
, int passed_a_ptr
,
346 const struct type_print_options
*flags
)
348 if (TYPE_TARGET_TYPE (type
) == NULL
349 || TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
351 fprintf_filtered (stream
, " : ");
352 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
),
353 stream
, 0, 0, flags
);
355 if (TYPE_TARGET_TYPE (type
) == NULL
)
356 type_print_unknown_return_type (stream
);
358 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0,
361 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
362 passed_a_ptr
, 0, flags
);
366 /* Print any array sizes, function arguments or close parentheses
367 needed after the variable name (to describe its type).
368 Args work like pascal_type_print_varspec_prefix. */
371 pascal_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
372 int show
, int passed_a_ptr
,
374 const struct type_print_options
*flags
)
379 if (TYPE_NAME (type
) && show
<= 0)
384 switch (TYPE_CODE (type
))
386 case TYPE_CODE_ARRAY
:
388 fprintf_filtered (stream
, ")");
391 case TYPE_CODE_METHOD
:
393 fprintf_filtered (stream
, ")");
394 pascal_type_print_method_args ("",
397 pascal_type_print_func_varspec_suffix (type
, stream
, show
,
398 passed_a_ptr
, 0, flags
);
403 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
),
404 stream
, 0, 1, 0, flags
);
409 fprintf_filtered (stream
, ")");
411 pascal_print_func_args (type
, stream
, flags
);
412 pascal_type_print_func_varspec_suffix (type
, stream
, show
,
413 passed_a_ptr
, 0, flags
);
416 case TYPE_CODE_UNDEF
:
417 case TYPE_CODE_STRUCT
:
418 case TYPE_CODE_UNION
:
423 case TYPE_CODE_ERROR
:
427 case TYPE_CODE_RANGE
:
428 case TYPE_CODE_STRING
:
429 case TYPE_CODE_COMPLEX
:
430 case TYPE_CODE_TYPEDEF
:
431 /* These types do not need a suffix. They are listed so that
432 gcc -Wall will report types that may not have been considered. */
435 error (_("type not handled in pascal_type_print_varspec_suffix()"));
440 /* Print the name of the type (or the ultimate pointer target,
441 function value or array element), or the description of a
444 SHOW positive means print details about the type (e.g. enum values),
445 and print structure elements passing SHOW - 1 for show.
446 SHOW negative means just print the type name or struct tag if there is one.
447 If there is no name, print something sensible but concise like
449 SHOW zero means just print the type name or struct tag if there is one.
450 If there is no name, print something sensible but not as concise like
451 "struct {int x; int y;}".
453 LEVEL is the number of spaces to indent by.
454 We increase it for some recursive calls. */
457 pascal_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
458 int level
, const struct type_print_options
*flags
)
465 s_none
, s_public
, s_private
, s_protected
473 fputs_filtered ("<type unknown>", stream
);
478 if ((TYPE_CODE (type
) == TYPE_CODE_PTR
)
479 && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
))
481 fputs_filtered (TYPE_NAME (type
) ? TYPE_NAME (type
) : "pointer",
485 /* When SHOW is zero or less, and there is a valid type name, then always
486 just print the type name directly from the type. */
489 && TYPE_NAME (type
) != NULL
)
491 fputs_filtered (TYPE_NAME (type
), stream
);
495 type
= check_typedef (type
);
497 switch (TYPE_CODE (type
))
499 case TYPE_CODE_TYPEDEF
:
502 /* case TYPE_CODE_FUNC:
503 case TYPE_CODE_METHOD: */
504 pascal_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
,
508 case TYPE_CODE_ARRAY
:
509 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
511 pascal_type_print_base (TYPE_TARGET_TYPE (type),
512 stream, show, level);
513 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
515 pascal_print_type (TYPE_TARGET_TYPE (type
), NULL
, stream
, 0, 0, flags
);
519 case TYPE_CODE_METHOD
:
521 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
522 only after args !! */
524 case TYPE_CODE_STRUCT
:
525 if (TYPE_NAME (type
) != NULL
)
527 fputs_filtered (TYPE_NAME (type
), stream
);
528 fputs_filtered (" = ", stream
);
530 if (HAVE_CPLUS_STRUCT (type
))
532 fprintf_filtered (stream
, "class ");
536 fprintf_filtered (stream
, "record ");
540 case TYPE_CODE_UNION
:
541 if (TYPE_NAME (type
) != NULL
)
543 fputs_filtered (TYPE_NAME (type
), stream
);
544 fputs_filtered (" = ", stream
);
546 fprintf_filtered (stream
, "case <?> of ");
552 /* If we just printed a tag name, no need to print anything else. */
553 if (TYPE_NAME (type
) == NULL
)
554 fprintf_filtered (stream
, "{...}");
556 else if (show
> 0 || TYPE_NAME (type
) == NULL
)
558 pascal_type_print_derivation_info (stream
, type
);
560 fprintf_filtered (stream
, "\n");
561 if ((TYPE_NFIELDS (type
) == 0) && (TYPE_NFN_FIELDS (type
) == 0))
563 if (TYPE_STUB (type
))
564 fprintfi_filtered (level
+ 4, stream
, "<incomplete type>\n");
566 fprintfi_filtered (level
+ 4, stream
, "<no data fields>\n");
569 /* Start off with no specific section type, so we can print
570 one for the first field we find, and use that section type
571 thereafter until we find another type. */
573 section_type
= s_none
;
575 /* If there is a base class for this type,
576 do not print the field that it occupies. */
578 len
= TYPE_NFIELDS (type
);
579 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
582 /* Don't print out virtual function table. */
583 if ((startswith (TYPE_FIELD_NAME (type
, i
), "_vptr"))
584 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
587 /* If this is a pascal object or class we can print the
588 various section labels. */
590 if (HAVE_CPLUS_STRUCT (type
))
592 if (TYPE_FIELD_PROTECTED (type
, i
))
594 if (section_type
!= s_protected
)
596 section_type
= s_protected
;
597 fprintfi_filtered (level
+ 2, stream
,
601 else if (TYPE_FIELD_PRIVATE (type
, i
))
603 if (section_type
!= s_private
)
605 section_type
= s_private
;
606 fprintfi_filtered (level
+ 2, stream
, "private\n");
611 if (section_type
!= s_public
)
613 section_type
= s_public
;
614 fprintfi_filtered (level
+ 2, stream
, "public\n");
619 print_spaces_filtered (level
+ 4, stream
);
620 if (field_is_static (&TYPE_FIELD (type
, i
)))
621 fprintf_filtered (stream
, "static ");
622 pascal_print_type (TYPE_FIELD_TYPE (type
, i
),
623 TYPE_FIELD_NAME (type
, i
),
624 stream
, show
- 1, level
+ 4, flags
);
625 if (!field_is_static (&TYPE_FIELD (type
, i
))
626 && TYPE_FIELD_PACKED (type
, i
))
628 /* It is a bitfield. This code does not attempt
629 to look at the bitpos and reconstruct filler,
630 unnamed fields. This would lead to misleading
631 results if the compiler does not put out fields
632 for such things (I don't know what it does). */
633 fprintf_filtered (stream
, " : %d",
634 TYPE_FIELD_BITSIZE (type
, i
));
636 fprintf_filtered (stream
, ";\n");
639 /* If there are both fields and methods, put a space between. */
640 len
= TYPE_NFN_FIELDS (type
);
641 if (len
&& section_type
!= s_none
)
642 fprintf_filtered (stream
, "\n");
644 /* Object pascal: print out the methods. */
646 for (i
= 0; i
< len
; i
++)
648 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (type
, i
);
649 int j
, len2
= TYPE_FN_FIELDLIST_LENGTH (type
, i
);
650 const char *method_name
= TYPE_FN_FIELDLIST_NAME (type
, i
);
652 /* this is GNU C++ specific
653 how can we know constructor/destructor?
654 It might work for GNU pascal. */
655 for (j
= 0; j
< len2
; j
++)
657 const char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
659 int is_constructor
= (startswith (physname
, "__ct__"));
660 int is_destructor
= (startswith (physname
, "__dt__"));
663 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
665 if (section_type
!= s_protected
)
667 section_type
= s_protected
;
668 fprintfi_filtered (level
+ 2, stream
,
672 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
674 if (section_type
!= s_private
)
676 section_type
= s_private
;
677 fprintfi_filtered (level
+ 2, stream
, "private\n");
682 if (section_type
!= s_public
)
684 section_type
= s_public
;
685 fprintfi_filtered (level
+ 2, stream
, "public\n");
689 print_spaces_filtered (level
+ 4, stream
);
690 if (TYPE_FN_FIELD_STATIC_P (f
, j
))
691 fprintf_filtered (stream
, "static ");
692 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) == 0)
694 /* Keep GDB from crashing here. */
695 fprintf_filtered (stream
, "<undefined type> %s;\n",
696 TYPE_FN_FIELD_PHYSNAME (f
, j
));
702 fprintf_filtered (stream
, "constructor ");
704 else if (is_destructor
)
706 fprintf_filtered (stream
, "destructor ");
708 else 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 fprintf_filtered (stream
, "function ");
716 fprintf_filtered (stream
, "procedure ");
718 /* This does not work, no idea why !! */
720 pascal_type_print_method_args (physname
,
724 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
725 && TYPE_CODE (TYPE_TARGET_TYPE (
726 TYPE_FN_FIELD_TYPE (f
, j
))) != TYPE_CODE_VOID
)
728 fputs_filtered (" : ", stream
);
729 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
732 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
733 fprintf_filtered (stream
, "; virtual");
735 fprintf_filtered (stream
, ";\n");
738 fprintfi_filtered (level
, stream
, "end");
743 if (TYPE_NAME (type
) != NULL
)
745 fputs_filtered (TYPE_NAME (type
), stream
);
747 fputs_filtered (" ", stream
);
749 /* enum is just defined by
750 type enume_name = (enum_member1,enum_member2,...) */
751 fprintf_filtered (stream
, " = ");
755 /* If we just printed a tag name, no need to print anything else. */
756 if (TYPE_NAME (type
) == NULL
)
757 fprintf_filtered (stream
, "(...)");
759 else if (show
> 0 || TYPE_NAME (type
) == NULL
)
761 fprintf_filtered (stream
, "(");
762 len
= TYPE_NFIELDS (type
);
764 for (i
= 0; i
< len
; i
++)
768 fprintf_filtered (stream
, ", ");
770 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
771 if (lastval
!= TYPE_FIELD_ENUMVAL (type
, i
))
773 fprintf_filtered (stream
,
775 plongest (TYPE_FIELD_ENUMVAL (type
, i
)));
776 lastval
= TYPE_FIELD_ENUMVAL (type
, i
);
780 fprintf_filtered (stream
, ")");
785 fprintf_filtered (stream
, "void");
788 case TYPE_CODE_UNDEF
:
789 fprintf_filtered (stream
, "record <unknown>");
792 case TYPE_CODE_ERROR
:
793 fprintf_filtered (stream
, "%s", TYPE_ERROR_NAME (type
));
796 /* this probably does not work for enums. */
797 case TYPE_CODE_RANGE
:
799 struct type
*target
= TYPE_TARGET_TYPE (type
);
801 print_type_scalar (target
, TYPE_LOW_BOUND (type
), stream
);
802 fputs_filtered ("..", stream
);
803 print_type_scalar (target
, TYPE_HIGH_BOUND (type
), stream
);
808 fputs_filtered ("set of ", stream
);
809 pascal_print_type (TYPE_INDEX_TYPE (type
), "", stream
,
810 show
- 1, level
, flags
);
813 case TYPE_CODE_STRING
:
814 fputs_filtered ("String", stream
);
818 /* Handle types not explicitly handled by the other cases,
819 such as fundamental types. For these, just print whatever
820 the type name is, as recorded in the type itself. If there
821 is no type name, then complain. */
822 if (TYPE_NAME (type
) != NULL
)
824 fputs_filtered (TYPE_NAME (type
), stream
);
828 /* At least for dump_symtab, it is important that this not be
830 fprintf_filtered (stream
, "<invalid unnamed pascal type code %d>",
This page took 0.054867 seconds and 4 git commands to generate.