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