1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright (C) 2000-2021 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"
35 #include "cli/cli-style.h"
40 pascal_language::print_type (struct type
*type
, const char *varstring
,
41 struct ui_file
*stream
, int show
, int level
,
42 const struct type_print_options
*flags
) const
50 type
= check_typedef (type
);
52 if ((code
== TYPE_CODE_FUNC
53 || code
== TYPE_CODE_METHOD
))
55 type_print_varspec_prefix (type
, stream
, show
, 0, flags
);
58 fputs_filtered (varstring
, stream
);
60 if ((varstring
!= NULL
&& *varstring
!= '\0')
61 && !(code
== TYPE_CODE_FUNC
62 || code
== TYPE_CODE_METHOD
))
64 fputs_filtered (" : ", stream
);
67 if (!(code
== TYPE_CODE_FUNC
68 || code
== TYPE_CODE_METHOD
))
70 type_print_varspec_prefix (type
, stream
, show
, 0, flags
);
73 type_print_base (type
, stream
, show
, level
, flags
);
74 /* For demangled function names, we have the arglist as part of the name,
75 so don't print an additional pair of ()'s. */
77 demangled_args
= varstring
? strchr (varstring
, '(') != NULL
: 0;
78 type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
,
86 pascal_language::print_typedef (struct type
*type
, struct symbol
*new_symbol
,
87 struct ui_file
*stream
) const
89 type
= check_typedef (type
);
90 fprintf_filtered (stream
, "type ");
91 fprintf_filtered (stream
, "%s = ", new_symbol
->print_name ());
92 type_print (type
, "", stream
, 0);
93 fprintf_filtered (stream
, ";");
99 pascal_language::type_print_derivation_info (struct ui_file
*stream
,
100 struct type
*type
) const
105 for (i
= 0; i
< TYPE_N_BASECLASSES (type
); i
++)
107 fputs_filtered (i
== 0 ? ": " : ", ", stream
);
108 fprintf_filtered (stream
, "%s%s ",
109 BASETYPE_VIA_PUBLIC (type
, i
) ? "public" : "private",
110 BASETYPE_VIA_VIRTUAL (type
, i
) ? " virtual" : "");
111 name
= TYPE_BASECLASS (type
, i
)->name ();
112 fprintf_filtered (stream
, "%s", name
? name
: "(null)");
116 fputs_filtered (" ", stream
);
123 pascal_language::type_print_method_args (const char *physname
,
124 const char *methodname
,
125 struct ui_file
*stream
) const
127 int is_constructor
= (startswith (physname
, "__ct__"));
128 int is_destructor
= (startswith (physname
, "__dt__"));
130 if (is_constructor
|| is_destructor
)
135 fputs_filtered (methodname
, stream
);
137 if (physname
&& (*physname
!= 0))
139 fputs_filtered (" (", stream
);
140 /* We must demangle this. */
141 while (isdigit (physname
[0]))
147 while (isdigit (physname
[len
]))
151 i
= strtol (physname
, &argname
, 0);
154 for (j
= 0; j
< i
; ++j
)
155 fputc_filtered (physname
[j
], stream
);
158 if (physname
[0] != 0)
160 fputs_filtered (", ", stream
);
163 fputs_filtered (")", stream
);
170 pascal_language::type_print_varspec_prefix (struct type
*type
,
171 struct ui_file
*stream
,
172 int show
, int passed_a_ptr
,
173 const struct type_print_options
*flags
) const
178 if (type
->name () && show
<= 0)
183 switch (type
->code ())
186 fprintf_filtered (stream
, "^");
187 type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1,
189 break; /* Pointer should be handled normally
192 case TYPE_CODE_METHOD
:
194 fprintf_filtered (stream
, "(");
195 if (TYPE_TARGET_TYPE (type
) != NULL
196 && TYPE_TARGET_TYPE (type
)->code () != TYPE_CODE_VOID
)
198 fprintf_filtered (stream
, "function ");
202 fprintf_filtered (stream
, "procedure ");
207 fprintf_filtered (stream
, " ");
208 type_print_base (TYPE_SELF_TYPE (type
),
209 stream
, 0, passed_a_ptr
, flags
);
210 fprintf_filtered (stream
, "::");
215 type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1,
217 fprintf_filtered (stream
, "&");
222 fprintf_filtered (stream
, "(");
224 if (TYPE_TARGET_TYPE (type
) != NULL
225 && TYPE_TARGET_TYPE (type
)->code () != TYPE_CODE_VOID
)
227 fprintf_filtered (stream
, "function ");
231 fprintf_filtered (stream
, "procedure ");
236 case TYPE_CODE_ARRAY
:
238 fprintf_filtered (stream
, "(");
239 fprintf_filtered (stream
, "array ");
240 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
241 && type
->bounds ()->high
.kind () != PROP_UNDEFINED
)
242 fprintf_filtered (stream
, "[%s..%s] ",
243 plongest (type
->bounds ()->low
.const_val ()),
244 plongest (type
->bounds ()->high
.const_val ()));
245 fprintf_filtered (stream
, "of ");
248 case TYPE_CODE_UNDEF
:
249 case TYPE_CODE_STRUCT
:
250 case TYPE_CODE_UNION
:
255 case TYPE_CODE_ERROR
:
259 case TYPE_CODE_RANGE
:
260 case TYPE_CODE_STRING
:
261 case TYPE_CODE_COMPLEX
:
262 case TYPE_CODE_TYPEDEF
:
263 case TYPE_CODE_FIXED_POINT
:
264 /* These types need no prefix. They are listed here so that
265 gcc -Wall will reveal any types that haven't been handled. */
268 gdb_assert_not_reached ("unexpected type");
276 pascal_language::print_func_args (struct type
*type
, struct ui_file
*stream
,
277 const struct type_print_options
*flags
) const
279 int i
, len
= type
->num_fields ();
283 fprintf_filtered (stream
, "(");
285 for (i
= 0; i
< len
; i
++)
289 fputs_filtered (", ", stream
);
292 /* Can we find if it is a var parameter ??
293 if ( TYPE_FIELD(type, i) == )
295 fprintf_filtered (stream, "var ");
297 print_type (type
->field (i
).type (), "" /* TYPE_FIELD_NAME
299 ,stream
, -1, 0, flags
);
303 fprintf_filtered (stream
, ")");
310 pascal_language::type_print_func_varspec_suffix (struct type
*type
,
311 struct ui_file
*stream
,
312 int show
, int passed_a_ptr
,
314 const struct type_print_options
*flags
) const
316 if (TYPE_TARGET_TYPE (type
) == NULL
317 || TYPE_TARGET_TYPE (type
)->code () != TYPE_CODE_VOID
)
319 fprintf_filtered (stream
, " : ");
320 type_print_varspec_prefix (TYPE_TARGET_TYPE (type
),
321 stream
, 0, 0, flags
);
323 if (TYPE_TARGET_TYPE (type
) == NULL
)
324 type_print_unknown_return_type (stream
);
326 type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0,
329 type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
330 passed_a_ptr
, 0, flags
);
337 pascal_language::type_print_varspec_suffix (struct type
*type
,
338 struct ui_file
*stream
,
339 int show
, int passed_a_ptr
,
341 const struct type_print_options
*flags
) const
346 if (type
->name () && show
<= 0)
351 switch (type
->code ())
353 case TYPE_CODE_ARRAY
:
355 fprintf_filtered (stream
, ")");
358 case TYPE_CODE_METHOD
:
360 fprintf_filtered (stream
, ")");
361 type_print_method_args ("", "", stream
);
362 type_print_func_varspec_suffix (type
, stream
, show
,
363 passed_a_ptr
, 0, flags
);
368 type_print_varspec_suffix (TYPE_TARGET_TYPE (type
),
369 stream
, 0, 1, 0, flags
);
374 fprintf_filtered (stream
, ")");
376 print_func_args (type
, stream
, flags
);
377 type_print_func_varspec_suffix (type
, stream
, show
,
378 passed_a_ptr
, 0, flags
);
381 case TYPE_CODE_UNDEF
:
382 case TYPE_CODE_STRUCT
:
383 case TYPE_CODE_UNION
:
388 case TYPE_CODE_ERROR
:
392 case TYPE_CODE_RANGE
:
393 case TYPE_CODE_STRING
:
394 case TYPE_CODE_COMPLEX
:
395 case TYPE_CODE_TYPEDEF
:
396 case TYPE_CODE_FIXED_POINT
:
397 /* These types do not need a suffix. They are listed so that
398 gcc -Wall will report types that may not have been considered. */
401 gdb_assert_not_reached ("unexpected type");
409 pascal_language::type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
410 int level
, const struct type_print_options
*flags
) const
417 s_none
, s_public
, s_private
, s_protected
425 fputs_styled ("<type unknown>", metadata_style
.style (), stream
);
430 if ((type
->code () == TYPE_CODE_PTR
)
431 && (TYPE_TARGET_TYPE (type
)->code () == TYPE_CODE_VOID
))
433 fputs_filtered (type
->name () ? type
->name () : "pointer",
437 /* When SHOW is zero or less, and there is a valid type name, then always
438 just print the type name directly from the type. */
441 && type
->name () != NULL
)
443 fputs_filtered (type
->name (), stream
);
447 type
= check_typedef (type
);
449 switch (type
->code ())
451 case TYPE_CODE_TYPEDEF
:
454 type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
,
458 case TYPE_CODE_ARRAY
:
459 print_type (TYPE_TARGET_TYPE (type
), NULL
, stream
, 0, 0, flags
);
463 case TYPE_CODE_METHOD
:
465 case TYPE_CODE_STRUCT
:
466 if (type
->name () != NULL
)
468 fputs_filtered (type
->name (), stream
);
469 fputs_filtered (" = ", stream
);
471 if (HAVE_CPLUS_STRUCT (type
))
473 fprintf_filtered (stream
, "class ");
477 fprintf_filtered (stream
, "record ");
481 case TYPE_CODE_UNION
:
482 if (type
->name () != NULL
)
484 fputs_filtered (type
->name (), stream
);
485 fputs_filtered (" = ", stream
);
487 fprintf_filtered (stream
, "case <?> of ");
493 /* If we just printed a tag name, no need to print anything else. */
494 if (type
->name () == NULL
)
495 fprintf_filtered (stream
, "{...}");
497 else if (show
> 0 || type
->name () == NULL
)
499 type_print_derivation_info (stream
, type
);
501 fprintf_filtered (stream
, "\n");
502 if ((type
->num_fields () == 0) && (TYPE_NFN_FIELDS (type
) == 0))
504 if (type
->is_stub ())
505 fprintf_filtered (stream
, "%*s<incomplete type>\n",
508 fprintf_filtered (stream
, "%*s<no data fields>\n",
512 /* Start off with no specific section type, so we can print
513 one for the first field we find, and use that section type
514 thereafter until we find another type. */
516 section_type
= s_none
;
518 /* If there is a base class for this type,
519 do not print the field that it occupies. */
521 len
= type
->num_fields ();
522 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
525 /* Don't print out virtual function table. */
526 if ((startswith (TYPE_FIELD_NAME (type
, i
), "_vptr"))
527 && is_cplus_marker ((TYPE_FIELD_NAME (type
, i
))[5]))
530 /* If this is a pascal object or class we can print the
531 various section labels. */
533 if (HAVE_CPLUS_STRUCT (type
))
535 if (TYPE_FIELD_PROTECTED (type
, i
))
537 if (section_type
!= s_protected
)
539 section_type
= s_protected
;
540 fprintf_filtered (stream
, "%*sprotected\n",
544 else if (TYPE_FIELD_PRIVATE (type
, i
))
546 if (section_type
!= s_private
)
548 section_type
= s_private
;
549 fprintf_filtered (stream
, "%*sprivate\n",
555 if (section_type
!= s_public
)
557 section_type
= s_public
;
558 fprintf_filtered (stream
, "%*spublic\n",
564 print_spaces_filtered (level
+ 4, stream
);
565 if (field_is_static (&type
->field (i
)))
566 fprintf_filtered (stream
, "static ");
567 print_type (type
->field (i
).type (),
568 TYPE_FIELD_NAME (type
, i
),
569 stream
, show
- 1, level
+ 4, flags
);
570 if (!field_is_static (&type
->field (i
))
571 && TYPE_FIELD_PACKED (type
, i
))
573 /* It is a bitfield. This code does not attempt
574 to look at the bitpos and reconstruct filler,
575 unnamed fields. This would lead to misleading
576 results if the compiler does not put out fields
577 for such things (I don't know what it does). */
578 fprintf_filtered (stream
, " : %d",
579 TYPE_FIELD_BITSIZE (type
, i
));
581 fprintf_filtered (stream
, ";\n");
584 /* If there are both fields and methods, put a space between. */
585 len
= TYPE_NFN_FIELDS (type
);
586 if (len
&& section_type
!= s_none
)
587 fprintf_filtered (stream
, "\n");
589 /* Object pascal: print out the methods. */
591 for (i
= 0; i
< len
; i
++)
593 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (type
, i
);
594 int j
, len2
= TYPE_FN_FIELDLIST_LENGTH (type
, i
);
595 const char *method_name
= TYPE_FN_FIELDLIST_NAME (type
, i
);
597 /* this is GNU C++ specific
598 how can we know constructor/destructor?
599 It might work for GNU pascal. */
600 for (j
= 0; j
< len2
; j
++)
602 const char *physname
= TYPE_FN_FIELD_PHYSNAME (f
, j
);
604 int is_constructor
= (startswith (physname
, "__ct__"));
605 int is_destructor
= (startswith (physname
, "__dt__"));
608 if (TYPE_FN_FIELD_PROTECTED (f
, j
))
610 if (section_type
!= s_protected
)
612 section_type
= s_protected
;
613 fprintf_filtered (stream
, "%*sprotected\n",
617 else if (TYPE_FN_FIELD_PRIVATE (f
, j
))
619 if (section_type
!= s_private
)
621 section_type
= s_private
;
622 fprintf_filtered (stream
, "%*sprivate\n",
628 if (section_type
!= s_public
)
630 section_type
= s_public
;
631 fprintf_filtered (stream
, "%*spublic\n",
636 print_spaces_filtered (level
+ 4, stream
);
637 if (TYPE_FN_FIELD_STATIC_P (f
, j
))
638 fprintf_filtered (stream
, "static ");
639 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) == 0)
641 /* Keep GDB from crashing here. */
642 fprintf_filtered (stream
, "<undefined type> %s;\n",
643 TYPE_FN_FIELD_PHYSNAME (f
, j
));
649 fprintf_filtered (stream
, "constructor ");
651 else if (is_destructor
)
653 fprintf_filtered (stream
, "destructor ");
655 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
656 && TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE(f
, j
))->code () != TYPE_CODE_VOID
)
658 fprintf_filtered (stream
, "function ");
662 fprintf_filtered (stream
, "procedure ");
664 /* This does not work, no idea why !! */
666 type_print_method_args (physname
, method_name
, stream
);
668 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)) != 0
669 && TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE(f
, j
))->code () != TYPE_CODE_VOID
)
671 fputs_filtered (" : ", stream
);
672 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f
, j
)),
675 if (TYPE_FN_FIELD_VIRTUAL_P (f
, j
))
676 fprintf_filtered (stream
, "; virtual");
678 fprintf_filtered (stream
, ";\n");
681 fprintf_filtered (stream
, "%*send", level
, "");
686 if (type
->name () != NULL
)
688 fputs_filtered (type
->name (), stream
);
690 fputs_filtered (" ", stream
);
692 /* enum is just defined by
693 type enume_name = (enum_member1,enum_member2,...) */
694 fprintf_filtered (stream
, " = ");
698 /* If we just printed a tag name, no need to print anything else. */
699 if (type
->name () == NULL
)
700 fprintf_filtered (stream
, "(...)");
702 else if (show
> 0 || type
->name () == NULL
)
704 fprintf_filtered (stream
, "(");
705 len
= type
->num_fields ();
707 for (i
= 0; i
< len
; i
++)
711 fprintf_filtered (stream
, ", ");
713 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
714 if (lastval
!= TYPE_FIELD_ENUMVAL (type
, i
))
716 fprintf_filtered (stream
,
718 plongest (TYPE_FIELD_ENUMVAL (type
, i
)));
719 lastval
= TYPE_FIELD_ENUMVAL (type
, i
);
723 fprintf_filtered (stream
, ")");
728 fprintf_filtered (stream
, "void");
731 case TYPE_CODE_UNDEF
:
732 fprintf_filtered (stream
, "record <unknown>");
735 case TYPE_CODE_ERROR
:
736 fprintf_filtered (stream
, "%s", TYPE_ERROR_NAME (type
));
739 /* this probably does not work for enums. */
740 case TYPE_CODE_RANGE
:
742 struct type
*target
= TYPE_TARGET_TYPE (type
);
744 print_type_scalar (target
, type
->bounds ()->low
.const_val (), stream
);
745 fputs_filtered ("..", stream
);
746 print_type_scalar (target
, type
->bounds ()->high
.const_val (), stream
);
751 fputs_filtered ("set of ", stream
);
752 print_type (type
->index_type (), "", stream
,
753 show
- 1, level
, flags
);
756 case TYPE_CODE_STRING
:
757 fputs_filtered ("String", stream
);
761 /* Handle types not explicitly handled by the other cases,
762 such as fundamental types. For these, just print whatever
763 the type name is, as recorded in the type itself. If there
764 is no type name, then complain. */
765 if (type
->name () != NULL
)
767 fputs_filtered (type
->name (), stream
);
771 /* At least for dump_symtab, it is important that this not be
773 fprintf_styled (stream
, metadata_style
.style (),
774 "<invalid unnamed pascal type code %d>",