IBM zSystems: Add support for z16 as CPU name.
[binutils-gdb.git] / gdb / p-typeprint.c
blobf222f01b4293969a8824218f3f768fa119efb4c6
1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright (C) 2000-2022 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 */
21 #include "defs.h"
22 #include "gdbsupport/gdb_obstack.h"
23 #include "bfd.h" /* Binary File Description */
24 #include "symtab.h"
25 #include "gdbtypes.h"
26 #include "expression.h"
27 #include "value.h"
28 #include "gdbcore.h"
29 #include "target.h"
30 #include "language.h"
31 #include "p-lang.h"
32 #include "typeprint.h"
33 #include "gdb-demangle.h"
34 #include <ctype.h>
35 #include "cli/cli-style.h"
37 /* See language.h. */
39 void
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
44 enum type_code code;
45 int demangled_args;
47 code = type->code ();
49 if (show > 0)
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);
57 /* first the name */
58 gdb_puts (varstring, stream);
60 if ((varstring != NULL && *varstring != '\0')
61 && !(code == TYPE_CODE_FUNC
62 || code == TYPE_CODE_METHOD))
64 gdb_puts (" : ", 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,
79 flags);
83 /* See language.h. */
85 void
86 pascal_language::print_typedef (struct type *type, struct symbol *new_symbol,
87 struct ui_file *stream) const
89 type = check_typedef (type);
90 gdb_printf (stream, "type ");
91 gdb_printf (stream, "%s = ", new_symbol->print_name ());
92 type_print (type, "", stream, 0);
93 gdb_printf (stream, ";");
96 /* See p-lang.h. */
98 void
99 pascal_language::type_print_derivation_info (struct ui_file *stream,
100 struct type *type) const
102 const char *name;
103 int i;
105 for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
107 gdb_puts (i == 0 ? ": " : ", ", stream);
108 gdb_printf (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 gdb_printf (stream, "%s", name ? name : "(null)");
114 if (i > 0)
116 gdb_puts (" ", stream);
120 /* See p-lang.h. */
122 void
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)
132 physname += 6;
135 gdb_puts (methodname, stream);
137 if (physname && (*physname != 0))
139 gdb_puts (" (", stream);
140 /* We must demangle this. */
141 while (isdigit (physname[0]))
143 int len = 0;
144 int i, j;
145 char *argname;
147 while (isdigit (physname[len]))
149 len++;
151 i = strtol (physname, &argname, 0);
152 physname += len;
154 for (j = 0; j < i; ++j)
155 gdb_putc (physname[j], stream);
157 physname += i;
158 if (physname[0] != 0)
160 gdb_puts (", ", stream);
163 gdb_puts (")", stream);
167 /* See p-lang.h. */
169 void
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
175 if (type == 0)
176 return;
178 if (type->name () && show <= 0)
179 return;
181 QUIT;
183 switch (type->code ())
185 case TYPE_CODE_PTR:
186 gdb_printf (stream, "^");
187 type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
188 flags);
189 break; /* Pointer should be handled normally
190 in pascal. */
192 case TYPE_CODE_METHOD:
193 if (passed_a_ptr)
194 gdb_printf (stream, "(");
195 if (TYPE_TARGET_TYPE (type) != NULL
196 && TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_VOID)
198 gdb_printf (stream, "function ");
200 else
202 gdb_printf (stream, "procedure ");
205 if (passed_a_ptr)
207 gdb_printf (stream, " ");
208 type_print_base (TYPE_SELF_TYPE (type),
209 stream, 0, passed_a_ptr, flags);
210 gdb_printf (stream, "::");
212 break;
214 case TYPE_CODE_REF:
215 type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
216 flags);
217 gdb_printf (stream, "&");
218 break;
220 case TYPE_CODE_FUNC:
221 if (passed_a_ptr)
222 gdb_printf (stream, "(");
224 if (TYPE_TARGET_TYPE (type) != NULL
225 && TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_VOID)
227 gdb_printf (stream, "function ");
229 else
231 gdb_printf (stream, "procedure ");
234 break;
236 case TYPE_CODE_ARRAY:
237 if (passed_a_ptr)
238 gdb_printf (stream, "(");
239 gdb_printf (stream, "array ");
240 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
241 && type->bounds ()->high.kind () != PROP_UNDEFINED)
242 gdb_printf (stream, "[%s..%s] ",
243 plongest (type->bounds ()->low.const_val ()),
244 plongest (type->bounds ()->high.const_val ()));
245 gdb_printf (stream, "of ");
246 break;
248 case TYPE_CODE_UNDEF:
249 case TYPE_CODE_STRUCT:
250 case TYPE_CODE_UNION:
251 case TYPE_CODE_ENUM:
252 case TYPE_CODE_INT:
253 case TYPE_CODE_FLT:
254 case TYPE_CODE_VOID:
255 case TYPE_CODE_ERROR:
256 case TYPE_CODE_CHAR:
257 case TYPE_CODE_BOOL:
258 case TYPE_CODE_SET:
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. */
266 break;
267 default:
268 gdb_assert_not_reached ("unexpected type");
269 break;
273 /* See p-lang.h. */
275 void
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 ();
281 if (len)
283 gdb_printf (stream, "(");
285 for (i = 0; i < len; i++)
287 if (i > 0)
289 gdb_puts (", ", stream);
290 stream->wrap_here (4);
292 /* Can we find if it is a var parameter ??
293 if ( TYPE_FIELD(type, i) == )
295 gdb_printf (stream, "var ");
296 } */
297 print_type (type->field (i).type (), "" /* TYPE_FIELD_NAME
298 seems invalid! */
299 ,stream, -1, 0, flags);
301 if (len)
303 gdb_printf (stream, ")");
307 /* See p-lang.h. */
309 void
310 pascal_language::type_print_func_varspec_suffix (struct type *type,
311 struct ui_file *stream,
312 int show, int passed_a_ptr,
313 int demangled_args,
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 gdb_printf (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);
325 else
326 type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
327 flags);
329 type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
330 passed_a_ptr, 0, flags);
334 /* See p-lang.h. */
336 void
337 pascal_language::type_print_varspec_suffix (struct type *type,
338 struct ui_file *stream,
339 int show, int passed_a_ptr,
340 int demangled_args,
341 const struct type_print_options *flags) const
343 if (type == 0)
344 return;
346 if (type->name () && show <= 0)
347 return;
349 QUIT;
351 switch (type->code ())
353 case TYPE_CODE_ARRAY:
354 if (passed_a_ptr)
355 gdb_printf (stream, ")");
356 break;
358 case TYPE_CODE_METHOD:
359 if (passed_a_ptr)
360 gdb_printf (stream, ")");
361 type_print_method_args ("", "", stream);
362 type_print_func_varspec_suffix (type, stream, show,
363 passed_a_ptr, 0, flags);
364 break;
366 case TYPE_CODE_PTR:
367 case TYPE_CODE_REF:
368 type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
369 stream, 0, 1, 0, flags);
370 break;
372 case TYPE_CODE_FUNC:
373 if (passed_a_ptr)
374 gdb_printf (stream, ")");
375 if (!demangled_args)
376 print_func_args (type, stream, flags);
377 type_print_func_varspec_suffix (type, stream, show,
378 passed_a_ptr, 0, flags);
379 break;
381 case TYPE_CODE_UNDEF:
382 case TYPE_CODE_STRUCT:
383 case TYPE_CODE_UNION:
384 case TYPE_CODE_ENUM:
385 case TYPE_CODE_INT:
386 case TYPE_CODE_FLT:
387 case TYPE_CODE_VOID:
388 case TYPE_CODE_ERROR:
389 case TYPE_CODE_CHAR:
390 case TYPE_CODE_BOOL:
391 case TYPE_CODE_SET:
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. */
399 break;
400 default:
401 gdb_assert_not_reached ("unexpected type");
402 break;
406 /* See p-lang.h. */
408 void
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
412 int i;
413 int len;
414 LONGEST lastval;
415 enum
417 s_none, s_public, s_private, s_protected
419 section_type;
421 QUIT;
422 stream->wrap_here (4);
423 if (type == NULL)
425 fputs_styled ("<type unknown>", metadata_style.style (), stream);
426 return;
429 /* void pointer */
430 if ((type->code () == TYPE_CODE_PTR)
431 && (TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_VOID))
433 gdb_puts (type->name () ? type->name () : "pointer",
434 stream);
435 return;
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. */
440 if (show <= 0
441 && type->name () != NULL)
443 gdb_puts (type->name (), stream);
444 return;
447 type = check_typedef (type);
449 switch (type->code ())
451 case TYPE_CODE_TYPEDEF:
452 case TYPE_CODE_PTR:
453 case TYPE_CODE_REF:
454 type_print_base (TYPE_TARGET_TYPE (type), stream, show, level,
455 flags);
456 break;
458 case TYPE_CODE_ARRAY:
459 print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0, flags);
460 break;
462 case TYPE_CODE_FUNC:
463 case TYPE_CODE_METHOD:
464 break;
465 case TYPE_CODE_STRUCT:
466 if (type->name () != NULL)
468 gdb_puts (type->name (), stream);
469 gdb_puts (" = ", stream);
471 if (HAVE_CPLUS_STRUCT (type))
473 gdb_printf (stream, "class ");
475 else
477 gdb_printf (stream, "record ");
479 goto struct_union;
481 case TYPE_CODE_UNION:
482 if (type->name () != NULL)
484 gdb_puts (type->name (), stream);
485 gdb_puts (" = ", stream);
487 gdb_printf (stream, "case <?> of ");
489 struct_union:
490 stream->wrap_here (4);
491 if (show < 0)
493 /* If we just printed a tag name, no need to print anything else. */
494 if (type->name () == NULL)
495 gdb_printf (stream, "{...}");
497 else if (show > 0 || type->name () == NULL)
499 type_print_derivation_info (stream, type);
501 gdb_printf (stream, "\n");
502 if ((type->num_fields () == 0) && (TYPE_NFN_FIELDS (type) == 0))
504 if (type->is_stub ())
505 gdb_printf (stream, "%*s<incomplete type>\n",
506 level + 4, "");
507 else
508 gdb_printf (stream, "%*s<no data fields>\n",
509 level + 4, "");
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++)
524 QUIT;
525 /* Don't print out virtual function table. */
526 if ((startswith (type->field (i).name (), "_vptr"))
527 && is_cplus_marker ((type->field (i).name ())[5]))
528 continue;
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 gdb_printf (stream, "%*sprotected\n",
541 level + 2, "");
544 else if (TYPE_FIELD_PRIVATE (type, i))
546 if (section_type != s_private)
548 section_type = s_private;
549 gdb_printf (stream, "%*sprivate\n",
550 level + 2, "");
553 else
555 if (section_type != s_public)
557 section_type = s_public;
558 gdb_printf (stream, "%*spublic\n",
559 level + 2, "");
564 print_spaces (level + 4, stream);
565 if (field_is_static (&type->field (i)))
566 gdb_printf (stream, "static ");
567 print_type (type->field (i).type (),
568 type->field (i).name (),
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 gdb_printf (stream, " : %d",
579 TYPE_FIELD_BITSIZE (type, i));
581 gdb_printf (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 gdb_printf (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__"));
607 QUIT;
608 if (TYPE_FN_FIELD_PROTECTED (f, j))
610 if (section_type != s_protected)
612 section_type = s_protected;
613 gdb_printf (stream, "%*sprotected\n",
614 level + 2, "");
617 else if (TYPE_FN_FIELD_PRIVATE (f, j))
619 if (section_type != s_private)
621 section_type = s_private;
622 gdb_printf (stream, "%*sprivate\n",
623 level + 2, "");
626 else
628 if (section_type != s_public)
630 section_type = s_public;
631 gdb_printf (stream, "%*spublic\n",
632 level + 2, "");
636 print_spaces (level + 4, stream);
637 if (TYPE_FN_FIELD_STATIC_P (f, j))
638 gdb_printf (stream, "static ");
639 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
641 /* Keep GDB from crashing here. */
642 gdb_printf (stream, "<undefined type> %s;\n",
643 TYPE_FN_FIELD_PHYSNAME (f, j));
644 break;
647 if (is_constructor)
649 gdb_printf (stream, "constructor ");
651 else if (is_destructor)
653 gdb_printf (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 gdb_printf (stream, "function ");
660 else
662 gdb_printf (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 gdb_puts (" : ", stream);
672 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
673 "", stream, -1);
675 if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
676 gdb_printf (stream, "; virtual");
678 gdb_printf (stream, ";\n");
681 gdb_printf (stream, "%*send", level, "");
683 break;
685 case TYPE_CODE_ENUM:
686 if (type->name () != NULL)
688 gdb_puts (type->name (), stream);
689 if (show > 0)
690 gdb_puts (" ", stream);
692 /* enum is just defined by
693 type enume_name = (enum_member1,enum_member2,...) */
694 gdb_printf (stream, " = ");
695 stream->wrap_here (4);
696 if (show < 0)
698 /* If we just printed a tag name, no need to print anything else. */
699 if (type->name () == NULL)
700 gdb_printf (stream, "(...)");
702 else if (show > 0 || type->name () == NULL)
704 gdb_printf (stream, "(");
705 len = type->num_fields ();
706 lastval = 0;
707 for (i = 0; i < len; i++)
709 QUIT;
710 if (i)
711 gdb_printf (stream, ", ");
712 stream->wrap_here (4);
713 gdb_puts (type->field (i).name (), stream);
714 if (lastval != type->field (i).loc_enumval ())
716 gdb_printf (stream,
717 " := %s",
718 plongest (type->field (i).loc_enumval ()));
719 lastval = type->field (i).loc_enumval ();
721 lastval++;
723 gdb_printf (stream, ")");
725 break;
727 case TYPE_CODE_VOID:
728 gdb_printf (stream, "void");
729 break;
731 case TYPE_CODE_UNDEF:
732 gdb_printf (stream, "record <unknown>");
733 break;
735 case TYPE_CODE_ERROR:
736 gdb_printf (stream, "%s", TYPE_ERROR_NAME (type));
737 break;
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 gdb_puts ("..", stream);
746 print_type_scalar (target, type->bounds ()->high.const_val (), stream);
748 break;
750 case TYPE_CODE_SET:
751 gdb_puts ("set of ", stream);
752 print_type (type->index_type (), "", stream,
753 show - 1, level, flags);
754 break;
756 case TYPE_CODE_STRING:
757 gdb_puts ("String", stream);
758 break;
760 default:
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 gdb_puts (type->name (), stream);
769 else
771 /* At least for dump_symtab, it is important that this not be
772 an error (). */
773 fprintf_styled (stream, metadata_style.style (),
774 "<invalid unnamed pascal type code %d>",
775 type->code ());
777 break;