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