]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/p-typeprint.c
update copyright year range in GDB files
[thirdparty/binutils-gdb.git] / gdb / p-typeprint.c
CommitLineData
373a8247 1/* Support for printing Pascal types for GDB, the GNU debugger.
61baf725 2 Copyright (C) 2000-2017 Free Software Foundation, Inc.
373a8247
PM
3
4 This file is part of GDB.
5
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
a9762ec7 8 the Free Software Foundation; either version 3 of the License, or
373a8247
PM
9 (at your option) any later version.
10
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.
15
16 You should have received a copy of the GNU General Public License
a9762ec7 17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
373a8247
PM
18
19/* This file is derived from p-typeprint.c */
20
21#include "defs.h"
04ea0df1 22#include "gdb_obstack.h"
373a8247
PM
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"
373a8247 30#include "language.h"
373a8247
PM
31#include "p-lang.h"
32#include "typeprint.h"
50f182aa 33#include "gdb-demangle.h"
373a8247
PM
34#include <ctype.h>
35
3e43a32a 36static void pascal_type_print_varspec_suffix (struct type *, struct ui_file *,
79d43c61
TT
37 int, int, int,
38 const struct type_print_options *);
373a8247 39
3e43a32a
MS
40static void pascal_type_print_derivation_info (struct ui_file *,
41 struct type *);
373a8247 42
373a8247
PM
43\f
44
45/* LEVEL is the depth to indent lines by. */
46
47void
25b524e8 48pascal_print_type (struct type *type, const char *varstring,
79d43c61
TT
49 struct ui_file *stream, int show, int level,
50 const struct type_print_options *flags)
373a8247 51{
52f0bd74 52 enum type_code code;
373a8247
PM
53 int demangled_args;
54
55 code = TYPE_CODE (type);
56
57 if (show > 0)
f168693b 58 type = check_typedef (type);
373a8247 59
3e9313ab
PM
60 if ((code == TYPE_CODE_FUNC
61 || code == TYPE_CODE_METHOD))
373a8247 62 {
79d43c61 63 pascal_type_print_varspec_prefix (type, stream, show, 0, flags);
373a8247
PM
64 }
65 /* first the name */
66 fputs_filtered (varstring, stream);
67
3e9313ab
PM
68 if ((varstring != NULL && *varstring != '\0')
69 && !(code == TYPE_CODE_FUNC
70 || code == TYPE_CODE_METHOD))
373a8247
PM
71 {
72 fputs_filtered (" : ", stream);
73 }
74
3e9313ab
PM
75 if (!(code == TYPE_CODE_FUNC
76 || code == TYPE_CODE_METHOD))
373a8247 77 {
79d43c61 78 pascal_type_print_varspec_prefix (type, stream, show, 0, flags);
373a8247
PM
79 }
80
79d43c61 81 pascal_type_print_base (type, stream, show, level, flags);
373a8247 82 /* For demangled function names, we have the arglist as part of the name,
0df8b418 83 so don't print an additional pair of ()'s. */
373a8247
PM
84
85 demangled_args = varstring ? strchr (varstring, '(') != NULL : 0;
79d43c61
TT
86 pascal_type_print_varspec_suffix (type, stream, show, 0, demangled_args,
87 flags);
373a8247
PM
88
89}
90
5c6ce71d
TT
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
93 which to print. */
94
95void
96pascal_print_typedef (struct type *type, struct symbol *new_symbol,
97 struct ui_file *stream)
98{
f168693b 99 type = check_typedef (type);
5c6ce71d
TT
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");
104}
105
373a8247
PM
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
0df8b418 108 of the base classes. I.e. for the derivation hierarchy:
373a8247
PM
109
110 class A { int a; };
111 class B : public A {int b; };
112 class C : public B {int c; };
113
114 Print the type of class C as:
115
116 class C : public B {
117 int c;
118 }
119
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:
122
123 class C : public B : public A {
124 int c;
125 }
126
127 In general, gdb should try to print the types as closely as possible to
0df8b418 128 the form that they appear in the source code. */
373a8247
PM
129
130static void
fba45db2 131pascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
373a8247 132{
0d5cff50 133 const char *name;
373a8247
PM
134 int i;
135
136 for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
137 {
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_no_tag (TYPE_BASECLASS (type, i));
143 fprintf_filtered (stream, "%s", name ? name : "(null)");
144 }
145 if (i > 0)
146 {
147 fputs_filtered (" ", stream);
148 }
149}
150
151/* Print the Pascal method arguments ARGS to the file STREAM. */
152
153void
1d06ead6 154pascal_type_print_method_args (const char *physname, const char *methodname,
fba45db2 155 struct ui_file *stream)
373a8247 156{
61012eef
GB
157 int is_constructor = (startswith (physname, "__ct__"));
158 int is_destructor = (startswith (physname, "__dt__"));
373a8247 159
c96d965c 160 if (is_constructor || is_destructor)
373a8247 161 {
c96d965c
MS
162 physname += 6;
163 }
00b8699c 164
c96d965c 165 fputs_filtered (methodname, stream);
00b8699c 166
c96d965c
MS
167 if (physname && (*physname != 0))
168 {
373a8247 169 fputs_filtered (" (", stream);
0df8b418 170 /* We must demangle this. */
8ce17b9a 171 while (isdigit (physname[0]))
373a8247 172 {
3a9d7214 173 int len = 0;
1d06ead6 174 int i, j;
3a9d7214
PM
175 char *argname;
176
8ce17b9a 177 while (isdigit (physname[len]))
373a8247
PM
178 {
179 len++;
180 }
181 i = strtol (physname, &argname, 0);
182 physname += len;
1d06ead6
TT
183
184 for (j = 0; j < i; ++j)
d0e7e15a 185 fputc_filtered (physname[j], stream);
1d06ead6 186
373a8247
PM
187 physname += i;
188 if (physname[0] != 0)
189 {
190 fputs_filtered (", ", stream);
191 }
192 }
193 fputs_filtered (")", stream);
194 }
195}
196
197/* Print any asterisks or open-parentheses needed before the
198 variable name (to describe its type).
199
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. */
204
205void
fba45db2 206pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
79d43c61
TT
207 int show, int passed_a_ptr,
208 const struct type_print_options *flags)
373a8247 209{
373a8247
PM
210 if (type == 0)
211 return;
212
213 if (TYPE_NAME (type) && show <= 0)
214 return;
215
216 QUIT;
217
218 switch (TYPE_CODE (type))
219 {
220 case TYPE_CODE_PTR:
221 fprintf_filtered (stream, "^");
79d43c61
TT
222 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
223 flags);
0df8b418
MS
224 break; /* Pointer should be handled normally
225 in pascal. */
373a8247 226
373a8247
PM
227 case TYPE_CODE_METHOD:
228 if (passed_a_ptr)
229 fprintf_filtered (stream, "(");
230 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
231 {
232 fprintf_filtered (stream, "function ");
233 }
234 else
235 {
236 fprintf_filtered (stream, "procedure ");
237 }
238
239 if (passed_a_ptr)
240 {
241 fprintf_filtered (stream, " ");
4bfb94b8 242 pascal_type_print_base (TYPE_SELF_TYPE (type),
79d43c61 243 stream, 0, passed_a_ptr, flags);
373a8247
PM
244 fprintf_filtered (stream, "::");
245 }
246 break;
247
248 case TYPE_CODE_REF:
79d43c61
TT
249 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
250 flags);
373a8247
PM
251 fprintf_filtered (stream, "&");
252 break;
253
254 case TYPE_CODE_FUNC:
255 if (passed_a_ptr)
256 fprintf_filtered (stream, "(");
257
258 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
259 {
260 fprintf_filtered (stream, "function ");
261 }
262 else
263 {
264 fprintf_filtered (stream, "procedure ");
265 }
266
267 break;
268
269 case TYPE_CODE_ARRAY:
270 if (passed_a_ptr)
271 fprintf_filtered (stream, "(");
272 fprintf_filtered (stream, "array ");
d5d6fca5 273 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
d78df370 274 && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
43bbcdc2
PH
275 fprintf_filtered (stream, "[%s..%s] ",
276 plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type)),
277 plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type)));
373a8247
PM
278 fprintf_filtered (stream, "of ");
279 break;
280
281 case TYPE_CODE_UNDEF:
282 case TYPE_CODE_STRUCT:
283 case TYPE_CODE_UNION:
284 case TYPE_CODE_ENUM:
285 case TYPE_CODE_INT:
286 case TYPE_CODE_FLT:
287 case TYPE_CODE_VOID:
288 case TYPE_CODE_ERROR:
289 case TYPE_CODE_CHAR:
290 case TYPE_CODE_BOOL:
291 case TYPE_CODE_SET:
292 case TYPE_CODE_RANGE:
293 case TYPE_CODE_STRING:
373a8247
PM
294 case TYPE_CODE_COMPLEX:
295 case TYPE_CODE_TYPEDEF:
373a8247
PM
296 /* These types need no prefix. They are listed here so that
297 gcc -Wall will reveal any types that haven't been handled. */
298 break;
299 default:
8a3fe4f8 300 error (_("type not handled in pascal_type_print_varspec_prefix()"));
373a8247
PM
301 break;
302 }
303}
304
373a8247 305static void
79d43c61
TT
306pascal_print_func_args (struct type *type, struct ui_file *stream,
307 const struct type_print_options *flags)
373a8247
PM
308{
309 int i, len = TYPE_NFIELDS (type);
ad3bbd48 310
373a8247
PM
311 if (len)
312 {
313 fprintf_filtered (stream, "(");
314 }
315 for (i = 0; i < len; i++)
316 {
317 if (i > 0)
318 {
319 fputs_filtered (", ", stream);
320 wrap_here (" ");
321 }
0df8b418 322 /* Can we find if it is a var parameter ??
373a8247
PM
323 if ( TYPE_FIELD(type, i) == )
324 {
325 fprintf_filtered (stream, "var ");
326 } */
3e43a32a
MS
327 pascal_print_type (TYPE_FIELD_TYPE (type, i), "" /* TYPE_FIELD_NAME
328 seems invalid! */
79d43c61 329 ,stream, -1, 0, flags);
373a8247
PM
330 }
331 if (len)
332 {
333 fprintf_filtered (stream, ")");
334 }
335}
336
337/* Print any array sizes, function arguments or close parentheses
338 needed after the variable name (to describe its type).
339 Args work like pascal_type_print_varspec_prefix. */
340
341static void
fba45db2
KB
342pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
343 int show, int passed_a_ptr,
79d43c61
TT
344 int demangled_args,
345 const struct type_print_options *flags)
373a8247
PM
346{
347 if (type == 0)
348 return;
349
350 if (TYPE_NAME (type) && show <= 0)
351 return;
352
353 QUIT;
354
355 switch (TYPE_CODE (type))
356 {
357 case TYPE_CODE_ARRAY:
358 if (passed_a_ptr)
359 fprintf_filtered (stream, ")");
360 break;
361
373a8247
PM
362 case TYPE_CODE_METHOD:
363 if (passed_a_ptr)
364 fprintf_filtered (stream, ")");
365 pascal_type_print_method_args ("",
366 "",
367 stream);
373a8247
PM
368 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
369 {
370 fprintf_filtered (stream, " : ");
3e43a32a 371 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
79d43c61
TT
372 stream, 0, 0, flags);
373 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
374 flags);
373a8247 375 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
79d43c61 376 passed_a_ptr, 0, flags);
373a8247
PM
377 }
378 break;
379
380 case TYPE_CODE_PTR:
381 case TYPE_CODE_REF:
3e43a32a 382 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
79d43c61 383 stream, 0, 1, 0, flags);
373a8247
PM
384 break;
385
386 case TYPE_CODE_FUNC:
387 if (passed_a_ptr)
388 fprintf_filtered (stream, ")");
389 if (!demangled_args)
79d43c61 390 pascal_print_func_args (type, stream, flags);
373a8247
PM
391 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
392 {
393 fprintf_filtered (stream, " : ");
3e43a32a 394 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
79d43c61
TT
395 stream, 0, 0, flags);
396 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
397 flags);
373a8247 398 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
79d43c61 399 passed_a_ptr, 0, flags);
373a8247
PM
400 }
401 break;
402
403 case TYPE_CODE_UNDEF:
404 case TYPE_CODE_STRUCT:
405 case TYPE_CODE_UNION:
406 case TYPE_CODE_ENUM:
407 case TYPE_CODE_INT:
408 case TYPE_CODE_FLT:
409 case TYPE_CODE_VOID:
410 case TYPE_CODE_ERROR:
411 case TYPE_CODE_CHAR:
412 case TYPE_CODE_BOOL:
413 case TYPE_CODE_SET:
414 case TYPE_CODE_RANGE:
415 case TYPE_CODE_STRING:
373a8247
PM
416 case TYPE_CODE_COMPLEX:
417 case TYPE_CODE_TYPEDEF:
373a8247
PM
418 /* These types do not need a suffix. They are listed so that
419 gcc -Wall will report types that may not have been considered. */
420 break;
421 default:
8a3fe4f8 422 error (_("type not handled in pascal_type_print_varspec_suffix()"));
373a8247
PM
423 break;
424 }
425}
426
427/* Print the name of the type (or the ultimate pointer target,
428 function value or array element), or the description of a
429 structure or union.
430
431 SHOW positive means print details about the type (e.g. enum values),
432 and print structure elements passing SHOW - 1 for show.
433 SHOW negative means just print the type name or struct tag if there is one.
434 If there is no name, print something sensible but concise like
435 "struct {...}".
436 SHOW zero means just print the type name or struct tag if there is one.
437 If there is no name, print something sensible but not as concise like
438 "struct {int x; int y;}".
439
440 LEVEL is the number of spaces to indent by.
441 We increase it for some recursive calls. */
442
443void
fba45db2 444pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
79d43c61 445 int level, const struct type_print_options *flags)
373a8247 446{
52f0bd74
AC
447 int i;
448 int len;
b4aa388a 449 LONGEST lastval;
373a8247
PM
450 enum
451 {
452 s_none, s_public, s_private, s_protected
453 }
454 section_type;
373a8247 455
ad3bbd48 456 QUIT;
373a8247
PM
457 wrap_here (" ");
458 if (type == NULL)
459 {
460 fputs_filtered ("<type unknown>", stream);
461 return;
462 }
463
464 /* void pointer */
3e43a32a
MS
465 if ((TYPE_CODE (type) == TYPE_CODE_PTR)
466 && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
373a8247 467 {
306d9ac5
DC
468 fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
469 stream);
373a8247
PM
470 return;
471 }
472 /* When SHOW is zero or less, and there is a valid type name, then always
473 just print the type name directly from the type. */
474
475 if (show <= 0
476 && TYPE_NAME (type) != NULL)
477 {
478 fputs_filtered (TYPE_NAME (type), stream);
479 return;
480 }
481
f168693b 482 type = check_typedef (type);
373a8247
PM
483
484 switch (TYPE_CODE (type))
485 {
486 case TYPE_CODE_TYPEDEF:
487 case TYPE_CODE_PTR:
373a8247
PM
488 case TYPE_CODE_REF:
489 /* case TYPE_CODE_FUNC:
490 case TYPE_CODE_METHOD: */
79d43c61
TT
491 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level,
492 flags);
373a8247
PM
493 break;
494
495 case TYPE_CODE_ARRAY:
3e43a32a
MS
496 /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
497 stream, 0, 0);
498 pascal_type_print_base (TYPE_TARGET_TYPE (type),
499 stream, show, level);
500 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
501 stream, 0, 0, 0); */
79d43c61 502 pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0, flags);
373a8247
PM
503 break;
504
505 case TYPE_CODE_FUNC:
506 case TYPE_CODE_METHOD:
507 /*
508 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
0df8b418 509 only after args !! */
373a8247
PM
510 break;
511 case TYPE_CODE_STRUCT:
512 if (TYPE_TAG_NAME (type) != NULL)
513 {
514 fputs_filtered (TYPE_TAG_NAME (type), stream);
515 fputs_filtered (" = ", stream);
516 }
517 if (HAVE_CPLUS_STRUCT (type))
518 {
519 fprintf_filtered (stream, "class ");
520 }
521 else
522 {
523 fprintf_filtered (stream, "record ");
524 }
525 goto struct_union;
526
527 case TYPE_CODE_UNION:
528 if (TYPE_TAG_NAME (type) != NULL)
529 {
530 fputs_filtered (TYPE_TAG_NAME (type), stream);
531 fputs_filtered (" = ", stream);
532 }
533 fprintf_filtered (stream, "case <?> of ");
534
535 struct_union:
536 wrap_here (" ");
537 if (show < 0)
538 {
539 /* If we just printed a tag name, no need to print anything else. */
540 if (TYPE_TAG_NAME (type) == NULL)
541 fprintf_filtered (stream, "{...}");
542 }
543 else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
544 {
545 pascal_type_print_derivation_info (stream, type);
546
547 fprintf_filtered (stream, "\n");
548 if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
549 {
74a9bb82 550 if (TYPE_STUB (type))
373a8247
PM
551 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
552 else
553 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
554 }
555
556 /* Start off with no specific section type, so we can print
557 one for the first field we find, and use that section type
0df8b418 558 thereafter until we find another type. */
373a8247
PM
559
560 section_type = s_none;
561
562 /* If there is a base class for this type,
563 do not print the field that it occupies. */
564
565 len = TYPE_NFIELDS (type);
566 for (i = TYPE_N_BASECLASSES (type); i < len; i++)
567 {
568 QUIT;
569 /* Don't print out virtual function table. */
61012eef 570 if ((startswith (TYPE_FIELD_NAME (type, i), "_vptr"))
373a8247
PM
571 && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
572 continue;
573
574 /* If this is a pascal object or class we can print the
0df8b418 575 various section labels. */
373a8247
PM
576
577 if (HAVE_CPLUS_STRUCT (type))
578 {
579 if (TYPE_FIELD_PROTECTED (type, i))
580 {
581 if (section_type != s_protected)
582 {
583 section_type = s_protected;
584 fprintfi_filtered (level + 2, stream,
585 "protected\n");
586 }
587 }
588 else if (TYPE_FIELD_PRIVATE (type, i))
589 {
590 if (section_type != s_private)
591 {
592 section_type = s_private;
593 fprintfi_filtered (level + 2, stream, "private\n");
594 }
595 }
596 else
597 {
598 if (section_type != s_public)
599 {
600 section_type = s_public;
601 fprintfi_filtered (level + 2, stream, "public\n");
602 }
603 }
604 }
605
606 print_spaces_filtered (level + 4, stream);
d6a843b5
JK
607 if (field_is_static (&TYPE_FIELD (type, i)))
608 fprintf_filtered (stream, "static ");
373a8247
PM
609 pascal_print_type (TYPE_FIELD_TYPE (type, i),
610 TYPE_FIELD_NAME (type, i),
79d43c61 611 stream, show - 1, level + 4, flags);
d6a843b5 612 if (!field_is_static (&TYPE_FIELD (type, i))
373a8247
PM
613 && TYPE_FIELD_PACKED (type, i))
614 {
615 /* It is a bitfield. This code does not attempt
616 to look at the bitpos and reconstruct filler,
617 unnamed fields. This would lead to misleading
618 results if the compiler does not put out fields
619 for such things (I don't know what it does). */
620 fprintf_filtered (stream, " : %d",
621 TYPE_FIELD_BITSIZE (type, i));
622 }
623 fprintf_filtered (stream, ";\n");
624 }
625
0df8b418 626 /* If there are both fields and methods, put a space between. */
373a8247
PM
627 len = TYPE_NFN_FIELDS (type);
628 if (len && section_type != s_none)
629 fprintf_filtered (stream, "\n");
630
0df8b418 631 /* Object pascal: print out the methods. */
373a8247
PM
632
633 for (i = 0; i < len; i++)
634 {
635 struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
636 int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
0d5cff50 637 const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
9216103f 638
373a8247
PM
639 /* this is GNU C++ specific
640 how can we know constructor/destructor?
0df8b418 641 It might work for GNU pascal. */
373a8247
PM
642 for (j = 0; j < len2; j++)
643 {
1d06ead6 644 const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
373a8247 645
61012eef
GB
646 int is_constructor = (startswith (physname, "__ct__"));
647 int is_destructor = (startswith (physname, "__dt__"));
373a8247
PM
648
649 QUIT;
650 if (TYPE_FN_FIELD_PROTECTED (f, j))
651 {
652 if (section_type != s_protected)
653 {
654 section_type = s_protected;
655 fprintfi_filtered (level + 2, stream,
656 "protected\n");
657 }
658 }
659 else if (TYPE_FN_FIELD_PRIVATE (f, j))
660 {
661 if (section_type != s_private)
662 {
663 section_type = s_private;
664 fprintfi_filtered (level + 2, stream, "private\n");
665 }
666 }
667 else
668 {
669 if (section_type != s_public)
670 {
671 section_type = s_public;
672 fprintfi_filtered (level + 2, stream, "public\n");
673 }
674 }
675
676 print_spaces_filtered (level + 4, stream);
677 if (TYPE_FN_FIELD_STATIC_P (f, j))
678 fprintf_filtered (stream, "static ");
679 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
680 {
681 /* Keep GDB from crashing here. */
682 fprintf_filtered (stream, "<undefined type> %s;\n",
683 TYPE_FN_FIELD_PHYSNAME (f, j));
684 break;
685 }
686
687 if (is_constructor)
688 {
689 fprintf_filtered (stream, "constructor ");
690 }
691 else if (is_destructor)
692 {
693 fprintf_filtered (stream, "destructor ");
694 }
3e9313ab
PM
695 else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
696 && TYPE_CODE (TYPE_TARGET_TYPE (
697 TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
373a8247
PM
698 {
699 fprintf_filtered (stream, "function ");
700 }
701 else
702 {
703 fprintf_filtered (stream, "procedure ");
704 }
0df8b418 705 /* This does not work, no idea why !! */
373a8247
PM
706
707 pascal_type_print_method_args (physname,
708 method_name,
709 stream);
710
3e9313ab
PM
711 if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
712 && TYPE_CODE (TYPE_TARGET_TYPE (
713 TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
373a8247
PM
714 {
715 fputs_filtered (" : ", stream);
716 type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
717 "", stream, -1);
718 }
719 if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
720 fprintf_filtered (stream, "; virtual");
721
722 fprintf_filtered (stream, ";\n");
723 }
724 }
725 fprintfi_filtered (level, stream, "end");
726 }
727 break;
728
729 case TYPE_CODE_ENUM:
730 if (TYPE_TAG_NAME (type) != NULL)
731 {
732 fputs_filtered (TYPE_TAG_NAME (type), stream);
733 if (show > 0)
734 fputs_filtered (" ", stream);
735 }
736 /* enum is just defined by
0df8b418 737 type enume_name = (enum_member1,enum_member2,...) */
373a8247
PM
738 fprintf_filtered (stream, " = ");
739 wrap_here (" ");
740 if (show < 0)
741 {
742 /* If we just printed a tag name, no need to print anything else. */
743 if (TYPE_TAG_NAME (type) == NULL)
744 fprintf_filtered (stream, "(...)");
745 }
746 else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
747 {
748 fprintf_filtered (stream, "(");
749 len = TYPE_NFIELDS (type);
750 lastval = 0;
751 for (i = 0; i < len; i++)
752 {
753 QUIT;
754 if (i)
755 fprintf_filtered (stream, ", ");
756 wrap_here (" ");
757 fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
14e75d8e 758 if (lastval != TYPE_FIELD_ENUMVAL (type, i))
373a8247 759 {
3e43a32a 760 fprintf_filtered (stream,
14e75d8e
JK
761 " := %s",
762 plongest (TYPE_FIELD_ENUMVAL (type, i)));
763 lastval = TYPE_FIELD_ENUMVAL (type, i);
373a8247
PM
764 }
765 lastval++;
766 }
767 fprintf_filtered (stream, ")");
768 }
769 break;
770
771 case TYPE_CODE_VOID:
772 fprintf_filtered (stream, "void");
773 break;
774
775 case TYPE_CODE_UNDEF:
776 fprintf_filtered (stream, "record <unknown>");
777 break;
778
779 case TYPE_CODE_ERROR:
b00fdb78 780 fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
373a8247
PM
781 break;
782
0df8b418 783 /* this probably does not work for enums. */
373a8247
PM
784 case TYPE_CODE_RANGE:
785 {
786 struct type *target = TYPE_TARGET_TYPE (type);
ad3bbd48 787
373a8247
PM
788 print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
789 fputs_filtered ("..", stream);
790 print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
791 }
792 break;
793
794 case TYPE_CODE_SET:
795 fputs_filtered ("set of ", stream);
796 pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
79d43c61 797 show - 1, level, flags);
373a8247
PM
798 break;
799
6604db2e
PM
800 case TYPE_CODE_STRING:
801 fputs_filtered ("String", stream);
802 break;
803
373a8247
PM
804 default:
805 /* Handle types not explicitly handled by the other cases,
806 such as fundamental types. For these, just print whatever
807 the type name is, as recorded in the type itself. If there
0df8b418 808 is no type name, then complain. */
373a8247
PM
809 if (TYPE_NAME (type) != NULL)
810 {
811 fputs_filtered (TYPE_NAME (type), stream);
812 }
813 else
814 {
815 /* At least for dump_symtab, it is important that this not be
816 an error (). */
817 fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
818 TYPE_CODE (type));
819 }
820 break;
821 }
822}