xref: /dragonfly/contrib/gdb-7/gdb/p-typeprint.c (revision dcd37f7d)
1 /* Support for printing Pascal types for GDB, the GNU debugger.
2    Copyright (C) 2000, 2001, 2002, 2006, 2007, 2008, 2009
3    Free Software Foundation, Inc.
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
9    the Free Software Foundation; either version 3 of the License, or
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
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19 
20 /* This file is derived from p-typeprint.c */
21 
22 #include "defs.h"
23 #include "gdb_obstack.h"
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"
31 #include "language.h"
32 #include "p-lang.h"
33 #include "typeprint.h"
34 
35 #include "gdb_string.h"
36 #include <errno.h>
37 #include <ctype.h>
38 
39 static void pascal_type_print_varspec_suffix (struct type *, struct ui_file *, int, int, int);
40 
41 static void pascal_type_print_derivation_info (struct ui_file *, struct type *);
42 
43 void pascal_type_print_varspec_prefix (struct type *, struct ui_file *, int, int);
44 
45 
46 /* LEVEL is the depth to indent lines by.  */
47 
48 void
49 pascal_print_type (struct type *type, char *varstring, struct ui_file *stream,
50 		   int show, int level)
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     {
63       pascal_type_print_varspec_prefix (type, stream, show, 0);
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     {
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 
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 
94 void
95 pascal_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 
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 
129 static void
130 pascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
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 
152 void
153 pascal_type_print_method_args (char *physname, char *methodname,
154 			       struct ui_file *stream)
155 {
156   int is_constructor = (strncmp (physname, "__ct__", 6) == 0);
157   int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
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     {
168       int i = 0;
169       int len = 0;
170       char storec;
171       char *argname;
172       fputs_filtered (" (", stream);
173       /* we must demangle this */
174       while (isdigit (physname[0]))
175 	{
176 	  while (isdigit (physname[len]))
177 	    {
178 	      len++;
179 	    }
180 	  i = strtol (physname, &argname, 0);
181 	  physname += len;
182 	  storec = physname[i];
183 	  physname[i] = 0;
184 	  fputs_filtered (physname, stream);
185 	  physname[i] = storec;
186 	  physname += i;
187 	  if (physname[0] != 0)
188 	    {
189 	      fputs_filtered (", ", stream);
190 	    }
191 	}
192       fputs_filtered (")", stream);
193     }
194 }
195 
196 /* Print any asterisks or open-parentheses needed before the
197    variable name (to describe its type).
198 
199    On outermost call, pass 0 for PASSED_A_PTR.
200    On outermost call, SHOW > 0 means should ignore
201    any typename for TYPE and show its details.
202    SHOW is always zero on recursive calls.  */
203 
204 void
205 pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
206 				  int show, int passed_a_ptr)
207 {
208   char *name;
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 
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 ");
268       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
269 	&& !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
270 	fprintf_filtered (stream, "[%d..%d] ",
271 			  TYPE_ARRAY_LOWER_BOUND_VALUE (type),
272 			  TYPE_ARRAY_UPPER_BOUND_VALUE (type)
273 	  );
274       fprintf_filtered (stream, "of ");
275       break;
276 
277     case TYPE_CODE_UNDEF:
278     case TYPE_CODE_STRUCT:
279     case TYPE_CODE_UNION:
280     case TYPE_CODE_ENUM:
281     case TYPE_CODE_INT:
282     case TYPE_CODE_FLT:
283     case TYPE_CODE_VOID:
284     case TYPE_CODE_ERROR:
285     case TYPE_CODE_CHAR:
286     case TYPE_CODE_BOOL:
287     case TYPE_CODE_SET:
288     case TYPE_CODE_RANGE:
289     case TYPE_CODE_STRING:
290     case TYPE_CODE_BITSTRING:
291     case TYPE_CODE_COMPLEX:
292     case TYPE_CODE_TYPEDEF:
293     case TYPE_CODE_TEMPLATE:
294       /* These types need no prefix.  They are listed here so that
295          gcc -Wall will reveal any types that haven't been handled.  */
296       break;
297     default:
298       error (_("type not handled in pascal_type_print_varspec_prefix()"));
299       break;
300     }
301 }
302 
303 static void
304 pascal_print_func_args (struct type *type, struct ui_file *stream)
305 {
306   int i, len = TYPE_NFIELDS (type);
307   if (len)
308     {
309       fprintf_filtered (stream, "(");
310     }
311   for (i = 0; i < len; i++)
312     {
313       if (i > 0)
314 	{
315 	  fputs_filtered (", ", stream);
316 	  wrap_here ("    ");
317 	}
318       /*  can we find if it is a var parameter ??
319          if ( TYPE_FIELD(type, i) == )
320          {
321          fprintf_filtered (stream, "var ");
322          } */
323       pascal_print_type (TYPE_FIELD_TYPE (type, i), ""	/* TYPE_FIELD_NAME seems invalid ! */
324 			 ,stream, -1, 0);
325     }
326   if (len)
327     {
328       fprintf_filtered (stream, ")");
329     }
330 }
331 
332 /* Print any array sizes, function arguments or close parentheses
333    needed after the variable name (to describe its type).
334    Args work like pascal_type_print_varspec_prefix.  */
335 
336 static void
337 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
338 				  int show, int passed_a_ptr,
339 				  int demangled_args)
340 {
341   if (type == 0)
342     return;
343 
344   if (TYPE_NAME (type) && show <= 0)
345     return;
346 
347   QUIT;
348 
349   switch (TYPE_CODE (type))
350     {
351     case TYPE_CODE_ARRAY:
352       if (passed_a_ptr)
353 	fprintf_filtered (stream, ")");
354       break;
355 
356     case TYPE_CODE_METHOD:
357       if (passed_a_ptr)
358 	fprintf_filtered (stream, ")");
359       pascal_type_print_method_args ("",
360 				     "",
361 				     stream);
362       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
363 	{
364 	  fprintf_filtered (stream, " : ");
365 	  pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
366 	  pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
367 	  pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
368 					    passed_a_ptr, 0);
369 	}
370       break;
371 
372     case TYPE_CODE_PTR:
373     case TYPE_CODE_REF:
374       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
375       break;
376 
377     case TYPE_CODE_FUNC:
378       if (passed_a_ptr)
379 	fprintf_filtered (stream, ")");
380       if (!demangled_args)
381 	pascal_print_func_args (type, stream);
382       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
383 	{
384 	  fprintf_filtered (stream, " : ");
385 	  pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
386 	  pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
387 	  pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
388 					    passed_a_ptr, 0);
389 	}
390       break;
391 
392     case TYPE_CODE_UNDEF:
393     case TYPE_CODE_STRUCT:
394     case TYPE_CODE_UNION:
395     case TYPE_CODE_ENUM:
396     case TYPE_CODE_INT:
397     case TYPE_CODE_FLT:
398     case TYPE_CODE_VOID:
399     case TYPE_CODE_ERROR:
400     case TYPE_CODE_CHAR:
401     case TYPE_CODE_BOOL:
402     case TYPE_CODE_SET:
403     case TYPE_CODE_RANGE:
404     case TYPE_CODE_STRING:
405     case TYPE_CODE_BITSTRING:
406     case TYPE_CODE_COMPLEX:
407     case TYPE_CODE_TYPEDEF:
408     case TYPE_CODE_TEMPLATE:
409       /* These types do not need a suffix.  They are listed so that
410          gcc -Wall will report types that may not have been considered.  */
411       break;
412     default:
413       error (_("type not handled in pascal_type_print_varspec_suffix()"));
414       break;
415     }
416 }
417 
418 /* Print the name of the type (or the ultimate pointer target,
419    function value or array element), or the description of a
420    structure or union.
421 
422    SHOW positive means print details about the type (e.g. enum values),
423    and print structure elements passing SHOW - 1 for show.
424    SHOW negative means just print the type name or struct tag if there is one.
425    If there is no name, print something sensible but concise like
426    "struct {...}".
427    SHOW zero means just print the type name or struct tag if there is one.
428    If there is no name, print something sensible but not as concise like
429    "struct {int x; int y;}".
430 
431    LEVEL is the number of spaces to indent by.
432    We increase it for some recursive calls.  */
433 
434 void
435 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
436 			int level)
437 {
438   int i;
439   int len;
440   int lastval;
441   enum
442     {
443       s_none, s_public, s_private, s_protected
444     }
445   section_type;
446   QUIT;
447 
448   wrap_here ("    ");
449   if (type == NULL)
450     {
451       fputs_filtered ("<type unknown>", stream);
452       return;
453     }
454 
455   /* void pointer */
456   if ((TYPE_CODE (type) == TYPE_CODE_PTR) && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
457     {
458       fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
459 		      stream);
460       return;
461     }
462   /* When SHOW is zero or less, and there is a valid type name, then always
463      just print the type name directly from the type.  */
464 
465   if (show <= 0
466       && TYPE_NAME (type) != NULL)
467     {
468       fputs_filtered (TYPE_NAME (type), stream);
469       return;
470     }
471 
472   CHECK_TYPEDEF (type);
473 
474   switch (TYPE_CODE (type))
475     {
476     case TYPE_CODE_TYPEDEF:
477     case TYPE_CODE_PTR:
478     case TYPE_CODE_REF:
479       /* case TYPE_CODE_FUNC:
480          case TYPE_CODE_METHOD: */
481       pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
482       break;
483 
484     case TYPE_CODE_ARRAY:
485       /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
486          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
487          pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
488       pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0);
489       break;
490 
491     case TYPE_CODE_FUNC:
492     case TYPE_CODE_METHOD:
493       /*
494          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
495          only after args !! */
496       break;
497     case TYPE_CODE_STRUCT:
498       if (TYPE_TAG_NAME (type) != NULL)
499 	{
500 	  fputs_filtered (TYPE_TAG_NAME (type), stream);
501 	  fputs_filtered (" = ", stream);
502 	}
503       if (HAVE_CPLUS_STRUCT (type))
504 	{
505 	  fprintf_filtered (stream, "class ");
506 	}
507       else
508 	{
509 	  fprintf_filtered (stream, "record ");
510 	}
511       goto struct_union;
512 
513     case TYPE_CODE_UNION:
514       if (TYPE_TAG_NAME (type) != NULL)
515 	{
516 	  fputs_filtered (TYPE_TAG_NAME (type), stream);
517 	  fputs_filtered (" = ", stream);
518 	}
519       fprintf_filtered (stream, "case <?> of ");
520 
521     struct_union:
522       wrap_here ("    ");
523       if (show < 0)
524 	{
525 	  /* If we just printed a tag name, no need to print anything else.  */
526 	  if (TYPE_TAG_NAME (type) == NULL)
527 	    fprintf_filtered (stream, "{...}");
528 	}
529       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
530 	{
531 	  pascal_type_print_derivation_info (stream, type);
532 
533 	  fprintf_filtered (stream, "\n");
534 	  if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
535 	    {
536 	      if (TYPE_STUB (type))
537 		fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
538 	      else
539 		fprintfi_filtered (level + 4, stream, "<no data fields>\n");
540 	    }
541 
542 	  /* Start off with no specific section type, so we can print
543 	     one for the first field we find, and use that section type
544 	     thereafter until we find another type. */
545 
546 	  section_type = s_none;
547 
548 	  /* If there is a base class for this type,
549 	     do not print the field that it occupies.  */
550 
551 	  len = TYPE_NFIELDS (type);
552 	  for (i = TYPE_N_BASECLASSES (type); i < len; i++)
553 	    {
554 	      QUIT;
555 	      /* Don't print out virtual function table.  */
556 	      if ((strncmp (TYPE_FIELD_NAME (type, i), "_vptr", 5) == 0)
557 		  && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
558 		continue;
559 
560 	      /* If this is a pascal object or class we can print the
561 	         various section labels. */
562 
563 	      if (HAVE_CPLUS_STRUCT (type))
564 		{
565 		  if (TYPE_FIELD_PROTECTED (type, i))
566 		    {
567 		      if (section_type != s_protected)
568 			{
569 			  section_type = s_protected;
570 			  fprintfi_filtered (level + 2, stream,
571 					     "protected\n");
572 			}
573 		    }
574 		  else if (TYPE_FIELD_PRIVATE (type, i))
575 		    {
576 		      if (section_type != s_private)
577 			{
578 			  section_type = s_private;
579 			  fprintfi_filtered (level + 2, stream, "private\n");
580 			}
581 		    }
582 		  else
583 		    {
584 		      if (section_type != s_public)
585 			{
586 			  section_type = s_public;
587 			  fprintfi_filtered (level + 2, stream, "public\n");
588 			}
589 		    }
590 		}
591 
592 	      print_spaces_filtered (level + 4, stream);
593 	      if (field_is_static (&TYPE_FIELD (type, i)))
594 		fprintf_filtered (stream, "static ");
595 	      pascal_print_type (TYPE_FIELD_TYPE (type, i),
596 				 TYPE_FIELD_NAME (type, i),
597 				 stream, show - 1, level + 4);
598 	      if (!field_is_static (&TYPE_FIELD (type, i))
599 		  && TYPE_FIELD_PACKED (type, i))
600 		{
601 		  /* It is a bitfield.  This code does not attempt
602 		     to look at the bitpos and reconstruct filler,
603 		     unnamed fields.  This would lead to misleading
604 		     results if the compiler does not put out fields
605 		     for such things (I don't know what it does).  */
606 		  fprintf_filtered (stream, " : %d",
607 				    TYPE_FIELD_BITSIZE (type, i));
608 		}
609 	      fprintf_filtered (stream, ";\n");
610 	    }
611 
612 	  /* If there are both fields and methods, put a space between. */
613 	  len = TYPE_NFN_FIELDS (type);
614 	  if (len && section_type != s_none)
615 	    fprintf_filtered (stream, "\n");
616 
617 	  /* Pbject pascal: print out the methods */
618 
619 	  for (i = 0; i < len; i++)
620 	    {
621 	      struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
622 	      int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
623 	      char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
624 	      char *name = type_name_no_tag (type);
625 	      /* this is GNU C++ specific
626 	         how can we know constructor/destructor?
627 	         It might work for GNU pascal */
628 	      for (j = 0; j < len2; j++)
629 		{
630 		  char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
631 
632 		  int is_constructor = (strncmp (physname, "__ct__", 6) == 0);
633 		  int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
634 
635 		  QUIT;
636 		  if (TYPE_FN_FIELD_PROTECTED (f, j))
637 		    {
638 		      if (section_type != s_protected)
639 			{
640 			  section_type = s_protected;
641 			  fprintfi_filtered (level + 2, stream,
642 					     "protected\n");
643 			}
644 		    }
645 		  else if (TYPE_FN_FIELD_PRIVATE (f, j))
646 		    {
647 		      if (section_type != s_private)
648 			{
649 			  section_type = s_private;
650 			  fprintfi_filtered (level + 2, stream, "private\n");
651 			}
652 		    }
653 		  else
654 		    {
655 		      if (section_type != s_public)
656 			{
657 			  section_type = s_public;
658 			  fprintfi_filtered (level + 2, stream, "public\n");
659 			}
660 		    }
661 
662 		  print_spaces_filtered (level + 4, stream);
663 		  if (TYPE_FN_FIELD_STATIC_P (f, j))
664 		    fprintf_filtered (stream, "static ");
665 		  if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
666 		    {
667 		      /* Keep GDB from crashing here.  */
668 		      fprintf_filtered (stream, "<undefined type> %s;\n",
669 					TYPE_FN_FIELD_PHYSNAME (f, j));
670 		      break;
671 		    }
672 
673 		  if (is_constructor)
674 		    {
675 		      fprintf_filtered (stream, "constructor ");
676 		    }
677 		  else if (is_destructor)
678 		    {
679 		      fprintf_filtered (stream, "destructor  ");
680 		    }
681 		  else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
682 			   && TYPE_CODE (TYPE_TARGET_TYPE (
683 				TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
684 		    {
685 		      fprintf_filtered (stream, "function  ");
686 		    }
687 		  else
688 		    {
689 		      fprintf_filtered (stream, "procedure ");
690 		    }
691 		  /* this does not work, no idea why !! */
692 
693 		  pascal_type_print_method_args (physname,
694 						 method_name,
695 						 stream);
696 
697 		  if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
698 		      && TYPE_CODE (TYPE_TARGET_TYPE (
699 			   TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
700 		    {
701 		      fputs_filtered (" : ", stream);
702 		      type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
703 				  "", stream, -1);
704 		    }
705 		  if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
706 		    fprintf_filtered (stream, "; virtual");
707 
708 		  fprintf_filtered (stream, ";\n");
709 		}
710 	    }
711 	  fprintfi_filtered (level, stream, "end");
712 	}
713       break;
714 
715     case TYPE_CODE_ENUM:
716       if (TYPE_TAG_NAME (type) != NULL)
717 	{
718 	  fputs_filtered (TYPE_TAG_NAME (type), stream);
719 	  if (show > 0)
720 	    fputs_filtered (" ", stream);
721 	}
722       /* enum is just defined by
723          type enume_name = (enum_member1,enum_member2,...) */
724       fprintf_filtered (stream, " = ");
725       wrap_here ("    ");
726       if (show < 0)
727 	{
728 	  /* If we just printed a tag name, no need to print anything else.  */
729 	  if (TYPE_TAG_NAME (type) == NULL)
730 	    fprintf_filtered (stream, "(...)");
731 	}
732       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
733 	{
734 	  fprintf_filtered (stream, "(");
735 	  len = TYPE_NFIELDS (type);
736 	  lastval = 0;
737 	  for (i = 0; i < len; i++)
738 	    {
739 	      QUIT;
740 	      if (i)
741 		fprintf_filtered (stream, ", ");
742 	      wrap_here ("    ");
743 	      fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
744 	      if (lastval != TYPE_FIELD_BITPOS (type, i))
745 		{
746 		  fprintf_filtered (stream, " := %d", TYPE_FIELD_BITPOS (type, i));
747 		  lastval = TYPE_FIELD_BITPOS (type, i);
748 		}
749 	      lastval++;
750 	    }
751 	  fprintf_filtered (stream, ")");
752 	}
753       break;
754 
755     case TYPE_CODE_VOID:
756       fprintf_filtered (stream, "void");
757       break;
758 
759     case TYPE_CODE_UNDEF:
760       fprintf_filtered (stream, "record <unknown>");
761       break;
762 
763     case TYPE_CODE_ERROR:
764       fprintf_filtered (stream, "<unknown type>");
765       break;
766 
767       /* this probably does not work for enums */
768     case TYPE_CODE_RANGE:
769       {
770 	struct type *target = TYPE_TARGET_TYPE (type);
771 	print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
772 	fputs_filtered ("..", stream);
773 	print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
774       }
775       break;
776 
777     case TYPE_CODE_SET:
778       fputs_filtered ("set of ", stream);
779       pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
780 			 show - 1, level);
781       break;
782 
783     case TYPE_CODE_BITSTRING:
784       fputs_filtered ("BitString", stream);
785       break;
786 
787     case TYPE_CODE_STRING:
788       fputs_filtered ("String", stream);
789       break;
790 
791     default:
792       /* Handle types not explicitly handled by the other cases,
793          such as fundamental types.  For these, just print whatever
794          the type name is, as recorded in the type itself.  If there
795          is no type name, then complain. */
796       if (TYPE_NAME (type) != NULL)
797 	{
798 	  fputs_filtered (TYPE_NAME (type), stream);
799 	}
800       else
801 	{
802 	  /* At least for dump_symtab, it is important that this not be
803 	     an error ().  */
804 	  fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
805 			    TYPE_CODE (type));
806 	}
807       break;
808     }
809 }
810