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