1 /* Support for printing Pascal types for GDB, the GNU debugger.
2 Copyright 2000, 2001, 2002
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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
21 /* This file is derived from p-typeprint.c */
25 #include "bfd.h" /* Binary File Description */
28 #include "expression.h"
34 #include "typeprint.h"
36 #include "gdb_string.h"
40 static void pascal_type_print_varspec_suffix (struct type *, struct ui_file *, int, int, int);
42 static void pascal_type_print_derivation_info (struct ui_file *, struct type *);
44 void pascal_type_print_varspec_prefix (struct type *, struct ui_file *, int, int);
47 /* LEVEL is the depth to indent lines by. */
50 pascal_print_type (struct type *type, char *varstring, struct ui_file *stream,
53 register enum type_code code;
56 code = TYPE_CODE (type);
61 if ((code == TYPE_CODE_FUNC ||
62 code == TYPE_CODE_METHOD))
64 pascal_type_print_varspec_prefix (type, stream, show, 0);
67 fputs_filtered (varstring, stream);
69 if ((varstring != NULL && *varstring != '\0') &&
70 !(code == TYPE_CODE_FUNC ||
71 code == TYPE_CODE_METHOD))
73 fputs_filtered (" : ", stream);
76 if (!(code == TYPE_CODE_FUNC ||
77 code == TYPE_CODE_METHOD))
79 pascal_type_print_varspec_prefix (type, stream, show, 0);
82 pascal_type_print_base (type, stream, show, level);
83 /* For demangled function names, we have the arglist as part of the name,
84 so don't print an additional pair of ()'s */
86 demangled_args = varstring ? strchr (varstring, '(') != NULL : 0;
87 pascal_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
91 /* If TYPE is a derived type, then print out derivation information.
92 Print only the actual base classes of this type, not the base classes
93 of the base classes. I.E. for the derivation hierarchy:
96 class B : public A {int b; };
97 class C : public B {int c; };
99 Print the type of class C as:
105 Not as the following (like gdb used to), which is not legal C++ syntax for
106 derived types and may be confused with the multiple inheritance form:
108 class C : public B : public A {
112 In general, gdb should try to print the types as closely as possible to
113 the form that they appear in the source code. */
116 pascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
121 for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
123 fputs_filtered (i == 0 ? ": " : ", ", stream);
124 fprintf_filtered (stream, "%s%s ",
125 BASETYPE_VIA_PUBLIC (type, i) ? "public" : "private",
126 BASETYPE_VIA_VIRTUAL (type, i) ? " virtual" : "");
127 name = type_name_no_tag (TYPE_BASECLASS (type, i));
128 fprintf_filtered (stream, "%s", name ? name : "(null)");
132 fputs_filtered (" ", stream);
136 /* Print the Pascal method arguments ARGS to the file STREAM. */
139 pascal_type_print_method_args (char *physname, char *methodname,
140 struct ui_file *stream)
142 int is_constructor = STREQN (physname, "__ct__", 6);
143 int is_destructor = STREQN (physname, "__dt__", 6);
145 if (is_constructor || is_destructor)
150 fputs_filtered (methodname, stream);
152 if (physname && (*physname != 0))
158 fputs_filtered (" (", stream);
159 /* we must demangle this */
160 while (isdigit (physname[0]))
162 while (isdigit (physname[len]))
166 i = strtol (physname, &argname, 0);
168 storec = physname[i];
170 fputs_filtered (physname, stream);
171 physname[i] = storec;
173 if (physname[0] != 0)
175 fputs_filtered (", ", stream);
178 fputs_filtered (")", stream);
182 /* Print any asterisks or open-parentheses needed before the
183 variable name (to describe its type).
185 On outermost call, pass 0 for PASSED_A_PTR.
186 On outermost call, SHOW > 0 means should ignore
187 any typename for TYPE and show its details.
188 SHOW is always zero on recursive calls. */
191 pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
192 int show, int passed_a_ptr)
198 if (TYPE_NAME (type) && show <= 0)
203 switch (TYPE_CODE (type))
206 fprintf_filtered (stream, "^");
207 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
208 break; /* pointer should be handled normally in pascal */
210 case TYPE_CODE_MEMBER:
212 fprintf_filtered (stream, "(");
213 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
214 fprintf_filtered (stream, " ");
215 name = type_name_no_tag (TYPE_DOMAIN_TYPE (type));
217 fputs_filtered (name, stream);
219 pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
220 fprintf_filtered (stream, "::");
223 case TYPE_CODE_METHOD:
225 fprintf_filtered (stream, "(");
226 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
228 fprintf_filtered (stream, "function ");
232 fprintf_filtered (stream, "procedure ");
237 fprintf_filtered (stream, " ");
238 pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
239 fprintf_filtered (stream, "::");
244 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
245 fprintf_filtered (stream, "&");
250 fprintf_filtered (stream, "(");
252 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
254 fprintf_filtered (stream, "function ");
258 fprintf_filtered (stream, "procedure ");
263 case TYPE_CODE_ARRAY:
265 fprintf_filtered (stream, "(");
266 fprintf_filtered (stream, "array ");
267 if (TYPE_LENGTH (type) >= 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
268 && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED)
269 fprintf_filtered (stream, "[%d..%d] ",
270 TYPE_ARRAY_LOWER_BOUND_VALUE (type),
271 TYPE_ARRAY_UPPER_BOUND_VALUE (type)
273 fprintf_filtered (stream, "of ");
276 case TYPE_CODE_UNDEF:
277 case TYPE_CODE_STRUCT:
278 case TYPE_CODE_UNION:
283 case TYPE_CODE_ERROR:
287 case TYPE_CODE_RANGE:
288 case TYPE_CODE_STRING:
289 case TYPE_CODE_BITSTRING:
290 case TYPE_CODE_COMPLEX:
291 case TYPE_CODE_TYPEDEF:
292 case TYPE_CODE_TEMPLATE:
293 /* These types need no prefix. They are listed here so that
294 gcc -Wall will reveal any types that haven't been handled. */
297 error ("type not handled in pascal_type_print_varspec_prefix()");
303 pascal_print_func_args (struct type *type, struct ui_file *stream)
305 int i, len = TYPE_NFIELDS (type);
308 fprintf_filtered (stream, "(");
310 for (i = 0; i < len; i++)
314 fputs_filtered (", ", stream);
317 /* can we find if it is a var parameter ??
318 if ( TYPE_FIELD(type, i) == )
320 fprintf_filtered (stream, "var ");
322 pascal_print_type (TYPE_FIELD_TYPE (type, i), "" /* TYPE_FIELD_NAME seems invalid ! */
327 fprintf_filtered (stream, ")");
331 /* Print any array sizes, function arguments or close parentheses
332 needed after the variable name (to describe its type).
333 Args work like pascal_type_print_varspec_prefix. */
336 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
337 int show, int passed_a_ptr,
343 if (TYPE_NAME (type) && show <= 0)
348 switch (TYPE_CODE (type))
350 case TYPE_CODE_ARRAY:
352 fprintf_filtered (stream, ")");
355 case TYPE_CODE_MEMBER:
357 fprintf_filtered (stream, ")");
358 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
361 case TYPE_CODE_METHOD:
363 fprintf_filtered (stream, ")");
364 pascal_type_print_method_args ("",
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,
379 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
384 fprintf_filtered (stream, ")");
386 pascal_print_func_args (type, stream);
387 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
389 fprintf_filtered (stream, " : ");
390 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
391 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
392 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
397 case TYPE_CODE_UNDEF:
398 case TYPE_CODE_STRUCT:
399 case TYPE_CODE_UNION:
404 case TYPE_CODE_ERROR:
408 case TYPE_CODE_RANGE:
409 case TYPE_CODE_STRING:
410 case TYPE_CODE_BITSTRING:
411 case TYPE_CODE_COMPLEX:
412 case TYPE_CODE_TYPEDEF:
413 case TYPE_CODE_TEMPLATE:
414 /* These types do not need a suffix. They are listed so that
415 gcc -Wall will report types that may not have been considered. */
418 error ("type not handled in pascal_type_print_varspec_suffix()");
423 /* Print the name of the type (or the ultimate pointer target,
424 function value or array element), or the description of a
427 SHOW positive means print details about the type (e.g. enum values),
428 and print structure elements passing SHOW - 1 for show.
429 SHOW negative means just print the type name or struct tag if there is one.
430 If there is no name, print something sensible but concise like
432 SHOW zero means just print the type name or struct tag if there is one.
433 If there is no name, print something sensible but not as concise like
434 "struct {int x; int y;}".
436 LEVEL is the number of spaces to indent by.
437 We increase it for some recursive calls. */
440 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
445 register int lastval;
448 s_none, s_public, s_private, s_protected
456 fputs_filtered ("<type unknown>", stream);
461 if ((TYPE_CODE (type) == TYPE_CODE_PTR) && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
463 fprintf_filtered (stream,
464 TYPE_NAME (type) ? TYPE_NAME (type) : "pointer");
467 /* When SHOW is zero or less, and there is a valid type name, then always
468 just print the type name directly from the type. */
471 && TYPE_NAME (type) != NULL)
473 fputs_filtered (TYPE_NAME (type), stream);
477 CHECK_TYPEDEF (type);
479 switch (TYPE_CODE (type))
481 case TYPE_CODE_TYPEDEF:
483 case TYPE_CODE_MEMBER:
485 /* case TYPE_CODE_FUNC:
486 case TYPE_CODE_METHOD: */
487 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
490 case TYPE_CODE_ARRAY:
491 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
492 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
493 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
494 pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0);
498 case TYPE_CODE_METHOD:
500 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
501 only after args !! */
503 case TYPE_CODE_STRUCT:
504 if (TYPE_TAG_NAME (type) != NULL)
506 fputs_filtered (TYPE_TAG_NAME (type), stream);
507 fputs_filtered (" = ", stream);
509 if (HAVE_CPLUS_STRUCT (type))
511 fprintf_filtered (stream, "class ");
515 fprintf_filtered (stream, "record ");
519 case TYPE_CODE_UNION:
520 if (TYPE_TAG_NAME (type) != NULL)
522 fputs_filtered (TYPE_TAG_NAME (type), stream);
523 fputs_filtered (" = ", stream);
525 fprintf_filtered (stream, "case <?> of ");
531 /* If we just printed a tag name, no need to print anything else. */
532 if (TYPE_TAG_NAME (type) == NULL)
533 fprintf_filtered (stream, "{...}");
535 else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
537 pascal_type_print_derivation_info (stream, type);
539 fprintf_filtered (stream, "\n");
540 if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
542 if (TYPE_STUB (type))
543 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
545 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
548 /* Start off with no specific section type, so we can print
549 one for the first field we find, and use that section type
550 thereafter until we find another type. */
552 section_type = s_none;
554 /* If there is a base class for this type,
555 do not print the field that it occupies. */
557 len = TYPE_NFIELDS (type);
558 for (i = TYPE_N_BASECLASSES (type); i < len; i++)
561 /* Don't print out virtual function table. */
562 if (STREQN (TYPE_FIELD_NAME (type, i), "_vptr", 5)
563 && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
566 /* If this is a pascal object or class we can print the
567 various section labels. */
569 if (HAVE_CPLUS_STRUCT (type))
571 if (TYPE_FIELD_PROTECTED (type, i))
573 if (section_type != s_protected)
575 section_type = s_protected;
576 fprintfi_filtered (level + 2, stream,
580 else if (TYPE_FIELD_PRIVATE (type, i))
582 if (section_type != s_private)
584 section_type = s_private;
585 fprintfi_filtered (level + 2, stream, "private\n");
590 if (section_type != s_public)
592 section_type = s_public;
593 fprintfi_filtered (level + 2, stream, "public\n");
598 print_spaces_filtered (level + 4, stream);
599 if (TYPE_FIELD_STATIC (type, i))
601 fprintf_filtered (stream, "static ");
603 pascal_print_type (TYPE_FIELD_TYPE (type, i),
604 TYPE_FIELD_NAME (type, i),
605 stream, show - 1, level + 4);
606 if (!TYPE_FIELD_STATIC (type, i)
607 && TYPE_FIELD_PACKED (type, i))
609 /* It is a bitfield. This code does not attempt
610 to look at the bitpos and reconstruct filler,
611 unnamed fields. This would lead to misleading
612 results if the compiler does not put out fields
613 for such things (I don't know what it does). */
614 fprintf_filtered (stream, " : %d",
615 TYPE_FIELD_BITSIZE (type, i));
617 fprintf_filtered (stream, ";\n");
620 /* If there are both fields and methods, put a space between. */
621 len = TYPE_NFN_FIELDS (type);
622 if (len && section_type != s_none)
623 fprintf_filtered (stream, "\n");
625 /* Pbject pascal: print out the methods */
627 for (i = 0; i < len; i++)
629 struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
630 int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
631 char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
632 char *name = type_name_no_tag (type);
633 /* this is GNU C++ specific
634 how can we know constructor/destructor?
635 It might work for GNU pascal */
636 for (j = 0; j < len2; j++)
638 char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
640 int is_constructor = STREQN (physname, "__ct__", 6);
641 int is_destructor = STREQN (physname, "__dt__", 6);
644 if (TYPE_FN_FIELD_PROTECTED (f, j))
646 if (section_type != s_protected)
648 section_type = s_protected;
649 fprintfi_filtered (level + 2, stream,
653 else if (TYPE_FN_FIELD_PRIVATE (f, j))
655 if (section_type != s_private)
657 section_type = s_private;
658 fprintfi_filtered (level + 2, stream, "private\n");
663 if (section_type != s_public)
665 section_type = s_public;
666 fprintfi_filtered (level + 2, stream, "public\n");
670 print_spaces_filtered (level + 4, stream);
671 if (TYPE_FN_FIELD_STATIC_P (f, j))
672 fprintf_filtered (stream, "static ");
673 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
675 /* Keep GDB from crashing here. */
676 fprintf_filtered (stream, "<undefined type> %s;\n",
677 TYPE_FN_FIELD_PHYSNAME (f, j));
683 fprintf_filtered (stream, "constructor ");
685 else if (is_destructor)
687 fprintf_filtered (stream, "destructor ");
689 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 &&
690 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
692 fprintf_filtered (stream, "function ");
696 fprintf_filtered (stream, "procedure ");
698 /* this does not work, no idea why !! */
700 pascal_type_print_method_args (physname,
704 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 &&
705 TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
707 fputs_filtered (" : ", stream);
708 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
711 if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
712 fprintf_filtered (stream, "; virtual");
714 fprintf_filtered (stream, ";\n");
717 fprintfi_filtered (level, stream, "end");
722 if (TYPE_TAG_NAME (type) != NULL)
724 fputs_filtered (TYPE_TAG_NAME (type), stream);
726 fputs_filtered (" ", stream);
728 /* enum is just defined by
729 type enume_name = (enum_member1,enum_member2,...) */
730 fprintf_filtered (stream, " = ");
734 /* If we just printed a tag name, no need to print anything else. */
735 if (TYPE_TAG_NAME (type) == NULL)
736 fprintf_filtered (stream, "(...)");
738 else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
740 fprintf_filtered (stream, "(");
741 len = TYPE_NFIELDS (type);
743 for (i = 0; i < len; i++)
747 fprintf_filtered (stream, ", ");
749 fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
750 if (lastval != TYPE_FIELD_BITPOS (type, i))
752 fprintf_filtered (stream, " := %d", TYPE_FIELD_BITPOS (type, i));
753 lastval = TYPE_FIELD_BITPOS (type, i);
757 fprintf_filtered (stream, ")");
762 fprintf_filtered (stream, "void");
765 case TYPE_CODE_UNDEF:
766 fprintf_filtered (stream, "record <unknown>");
769 case TYPE_CODE_ERROR:
770 fprintf_filtered (stream, "<unknown type>");
773 /* this probably does not work for enums */
774 case TYPE_CODE_RANGE:
776 struct type *target = TYPE_TARGET_TYPE (type);
778 target = builtin_type_long;
779 print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
780 fputs_filtered ("..", stream);
781 print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
786 fputs_filtered ("set of ", stream);
787 pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
791 case TYPE_CODE_BITSTRING:
792 fputs_filtered ("BitString", stream);
795 case TYPE_CODE_STRING:
796 fputs_filtered ("String", stream);
800 /* Handle types not explicitly handled by the other cases,
801 such as fundamental types. For these, just print whatever
802 the type name is, as recorded in the type itself. If there
803 is no type name, then complain. */
804 if (TYPE_NAME (type) != NULL)
806 fputs_filtered (TYPE_NAME (type), stream);
810 /* At least for dump_symtab, it is important that this not be
812 fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",