Import gdb-7.10.1
[dragonfly.git] / contrib / gdb-7 / gdb / p-typeprint.c
CommitLineData
5796c8dc 1/* Support for printing Pascal types for GDB, the GNU debugger.
25e4902b 2 Copyright (C) 2000-2015 Free Software Foundation, Inc.
5796c8dc
SS
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
8 the Free Software Foundation; either version 3 of the License, or
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
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
18
19/* This file is derived from p-typeprint.c */
20
21#include "defs.h"
22#include "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"
a45ae5f8 33#include "gdb-demangle.h"
5796c8dc
SS
34#include <ctype.h>
35
c50c785c 36static void pascal_type_print_varspec_suffix (struct type *, struct ui_file *,
ef5ccd6c
JM
37 int, int, int,
38 const struct type_print_options *);
5796c8dc 39
c50c785c
JM
40static void pascal_type_print_derivation_info (struct ui_file *,
41 struct type *);
5796c8dc 42
5796c8dc
SS
43\f
44
45/* LEVEL is the depth to indent lines by. */
46
47void
cf7f2e2d 48pascal_print_type (struct type *type, const char *varstring,
ef5ccd6c
JM
49 struct ui_file *stream, int show, int level,
50 const struct type_print_options *flags)
5796c8dc
SS
51{
52 enum type_code code;
53 int demangled_args;
54
55 code = TYPE_CODE (type);
56
57 if (show > 0)
58 CHECK_TYPEDEF (type);
59
60 if ((code == TYPE_CODE_FUNC
61 || code == TYPE_CODE_METHOD))
62 {
ef5ccd6c 63 pascal_type_print_varspec_prefix (type, stream, show, 0, flags);
5796c8dc
SS
64 }
65 /* first the name */
66 fputs_filtered (varstring, stream);
67
68 if ((varstring != NULL && *varstring != '\0')
69 && !(code == TYPE_CODE_FUNC
70 || code == TYPE_CODE_METHOD))
71 {
72 fputs_filtered (" : ", stream);
73 }
74
75 if (!(code == TYPE_CODE_FUNC
76 || code == TYPE_CODE_METHOD))
77 {
ef5ccd6c 78 pascal_type_print_varspec_prefix (type, stream, show, 0, flags);
5796c8dc
SS
79 }
80
ef5ccd6c 81 pascal_type_print_base (type, stream, show, level, flags);
5796c8dc 82 /* For demangled function names, we have the arglist as part of the name,
c50c785c 83 so don't print an additional pair of ()'s. */
5796c8dc
SS
84
85 demangled_args = varstring ? strchr (varstring, '(') != NULL : 0;
ef5ccd6c
JM
86 pascal_type_print_varspec_suffix (type, stream, show, 0, demangled_args,
87 flags);
5796c8dc
SS
88
89}
90
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{
99 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");
104}
105
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
c50c785c 108 of the base classes. I.e. for the derivation hierarchy:
5796c8dc
SS
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
c50c785c 128 the form that they appear in the source code. */
5796c8dc
SS
129
130static void
131pascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
132{
ef5ccd6c 133 const char *name;
5796c8dc
SS
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
a45ae5f8 154pascal_type_print_method_args (const char *physname, const char *methodname,
5796c8dc
SS
155 struct ui_file *stream)
156{
25e4902b
AHJ
157 int is_constructor = (startswith (physname, "__ct__"));
158 int is_destructor = (startswith (physname, "__dt__"));
5796c8dc
SS
159
160 if (is_constructor || is_destructor)
161 {
162 physname += 6;
163 }
164
165 fputs_filtered (methodname, stream);
166
167 if (physname && (*physname != 0))
168 {
5796c8dc 169 fputs_filtered (" (", stream);
c50c785c 170 /* We must demangle this. */
5796c8dc
SS
171 while (isdigit (physname[0]))
172 {
c50c785c 173 int len = 0;
a45ae5f8 174 int i, j;
c50c785c
JM
175 char *argname;
176
5796c8dc
SS
177 while (isdigit (physname[len]))
178 {
179 len++;
180 }
181 i = strtol (physname, &argname, 0);
182 physname += len;
a45ae5f8
JM
183
184 for (j = 0; j < i; ++j)
185 fputc_filtered (physname[j], stream);
186
5796c8dc
SS
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
206pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
ef5ccd6c
JM
207 int show, int passed_a_ptr,
208 const struct type_print_options *flags)
5796c8dc 209{
5796c8dc
SS
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, "^");
ef5ccd6c
JM
222 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
223 flags);
c50c785c
JM
224 break; /* Pointer should be handled normally
225 in pascal. */
5796c8dc
SS
226
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, " ");
25e4902b 242 pascal_type_print_base (TYPE_SELF_TYPE (type),
ef5ccd6c 243 stream, 0, passed_a_ptr, flags);
5796c8dc
SS
244 fprintf_filtered (stream, "::");
245 }
246 break;
247
248 case TYPE_CODE_REF:
ef5ccd6c
JM
249 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
250 flags);
5796c8dc
SS
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 ");
273 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
274 && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
cf7f2e2d
JM
275 fprintf_filtered (stream, "[%s..%s] ",
276 plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type)),
277 plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type)));
5796c8dc
SS
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:
5796c8dc
SS
294 case TYPE_CODE_COMPLEX:
295 case TYPE_CODE_TYPEDEF:
5796c8dc
SS
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:
300 error (_("type not handled in pascal_type_print_varspec_prefix()"));
301 break;
302 }
303}
304
305static void
ef5ccd6c
JM
306pascal_print_func_args (struct type *type, struct ui_file *stream,
307 const struct type_print_options *flags)
5796c8dc
SS
308{
309 int i, len = TYPE_NFIELDS (type);
cf7f2e2d 310
5796c8dc
SS
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 }
c50c785c 322 /* Can we find if it is a var parameter ??
5796c8dc
SS
323 if ( TYPE_FIELD(type, i) == )
324 {
325 fprintf_filtered (stream, "var ");
326 } */
c50c785c
JM
327 pascal_print_type (TYPE_FIELD_TYPE (type, i), "" /* TYPE_FIELD_NAME
328 seems invalid! */
ef5ccd6c 329 ,stream, -1, 0, flags);
5796c8dc
SS
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
342pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
343 int show, int passed_a_ptr,
ef5ccd6c
JM
344 int demangled_args,
345 const struct type_print_options *flags)
5796c8dc
SS
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
362 case TYPE_CODE_METHOD:
363 if (passed_a_ptr)
364 fprintf_filtered (stream, ")");
365 pascal_type_print_method_args ("",
366 "",
367 stream);
368 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
369 {
370 fprintf_filtered (stream, " : ");
c50c785c 371 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
ef5ccd6c
JM
372 stream, 0, 0, flags);
373 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
374 flags);
5796c8dc 375 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
ef5ccd6c 376 passed_a_ptr, 0, flags);
5796c8dc
SS
377 }
378 break;
379
380 case TYPE_CODE_PTR:
381 case TYPE_CODE_REF:
c50c785c 382 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
ef5ccd6c 383 stream, 0, 1, 0, flags);
5796c8dc
SS
384 break;
385
386 case TYPE_CODE_FUNC:
387 if (passed_a_ptr)
388 fprintf_filtered (stream, ")");
389 if (!demangled_args)
ef5ccd6c 390 pascal_print_func_args (type, stream, flags);
5796c8dc
SS
391 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
392 {
393 fprintf_filtered (stream, " : ");
c50c785c 394 pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
ef5ccd6c
JM
395 stream, 0, 0, flags);
396 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
397 flags);
5796c8dc 398 pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
ef5ccd6c 399 passed_a_ptr, 0, flags);
5796c8dc
SS
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:
5796c8dc
SS
416 case TYPE_CODE_COMPLEX:
417 case TYPE_CODE_TYPEDEF:
5796c8dc
SS
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:
422 error (_("type not handled in pascal_type_print_varspec_suffix()"));
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
444pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
ef5ccd6c 445 int level, const struct type_print_options *flags)
5796c8dc
SS
446{
447 int i;
448 int len;
ef5ccd6c 449 LONGEST lastval;
5796c8dc
SS
450 enum
451 {
452 s_none, s_public, s_private, s_protected
453 }
454 section_type;
5796c8dc 455
cf7f2e2d 456 QUIT;
5796c8dc
SS
457 wrap_here (" ");
458 if (type == NULL)
459 {
460 fputs_filtered ("<type unknown>", stream);
461 return;
462 }
463
464 /* void pointer */
c50c785c
JM
465 if ((TYPE_CODE (type) == TYPE_CODE_PTR)
466 && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
5796c8dc
SS
467 {
468 fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
469 stream);
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
482 CHECK_TYPEDEF (type);
483
484 switch (TYPE_CODE (type))
485 {
486 case TYPE_CODE_TYPEDEF:
487 case TYPE_CODE_PTR:
488 case TYPE_CODE_REF:
489 /* case TYPE_CODE_FUNC:
490 case TYPE_CODE_METHOD: */
ef5ccd6c
JM
491 pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level,
492 flags);
5796c8dc
SS
493 break;
494
495 case TYPE_CODE_ARRAY:
c50c785c
JM
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); */
ef5ccd6c 502 pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0, flags);
5796c8dc
SS
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);
c50c785c 509 only after args !! */
5796c8dc
SS
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 {
550 if (TYPE_STUB (type))
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
c50c785c 558 thereafter until we find another type. */
5796c8dc
SS
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. */
25e4902b 570 if ((startswith (TYPE_FIELD_NAME (type, i), "_vptr"))
5796c8dc
SS
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
c50c785c 575 various section labels. */
5796c8dc
SS
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);
607 if (field_is_static (&TYPE_FIELD (type, i)))
608 fprintf_filtered (stream, "static ");
609 pascal_print_type (TYPE_FIELD_TYPE (type, i),
610 TYPE_FIELD_NAME (type, i),
ef5ccd6c 611 stream, show - 1, level + 4, flags);
5796c8dc
SS
612 if (!field_is_static (&TYPE_FIELD (type, i))
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
c50c785c 626 /* If there are both fields and methods, put a space between. */
5796c8dc
SS
627 len = TYPE_NFN_FIELDS (type);
628 if (len && section_type != s_none)
629 fprintf_filtered (stream, "\n");
630
c50c785c 631 /* Object pascal: print out the methods. */
5796c8dc
SS
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);
ef5ccd6c 637 const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
cf7f2e2d 638
5796c8dc
SS
639 /* this is GNU C++ specific
640 how can we know constructor/destructor?
c50c785c 641 It might work for GNU pascal. */
5796c8dc
SS
642 for (j = 0; j < len2; j++)
643 {
a45ae5f8 644 const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
5796c8dc 645
25e4902b
AHJ
646 int is_constructor = (startswith (physname, "__ct__"));
647 int is_destructor = (startswith (physname, "__dt__"));
5796c8dc
SS
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 }
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)
698 {
699 fprintf_filtered (stream, "function ");
700 }
701 else
702 {
703 fprintf_filtered (stream, "procedure ");
704 }
c50c785c 705 /* This does not work, no idea why !! */
5796c8dc
SS
706
707 pascal_type_print_method_args (physname,
708 method_name,
709 stream);
710
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)
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
c50c785c 737 type enume_name = (enum_member1,enum_member2,...) */
5796c8dc
SS
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);
ef5ccd6c 758 if (lastval != TYPE_FIELD_ENUMVAL (type, i))
5796c8dc 759 {
c50c785c 760 fprintf_filtered (stream,
ef5ccd6c
JM
761 " := %s",
762 plongest (TYPE_FIELD_ENUMVAL (type, i)));
763 lastval = TYPE_FIELD_ENUMVAL (type, i);
5796c8dc
SS
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:
cf7f2e2d 780 fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
5796c8dc
SS
781 break;
782
c50c785c 783 /* this probably does not work for enums. */
5796c8dc
SS
784 case TYPE_CODE_RANGE:
785 {
786 struct type *target = TYPE_TARGET_TYPE (type);
cf7f2e2d 787
5796c8dc
SS
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,
ef5ccd6c 797 show - 1, level, flags);
5796c8dc
SS
798 break;
799
800 case TYPE_CODE_STRING:
801 fputs_filtered ("String", stream);
802 break;
803
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
c50c785c 808 is no type name, then complain. */
5796c8dc
SS
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}