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