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