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