xref: /dragonfly/contrib/gdb-7/gdb/ada-typeprint.c (revision e96fb831)
1 /* Support for printing Ada types for GDB, the GNU debugger.
2    Copyright (C) 1986, 1988, 1989, 1991, 1997, 1998, 1999, 2000, 2001, 2002,
3    2003, 2004, 2007, 2008, 2009, 2010, 2011 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 #include "defs.h"
21 #include "gdb_obstack.h"
22 #include "bfd.h"		/* Binary File Description */
23 #include "symtab.h"
24 #include "gdbtypes.h"
25 #include "expression.h"
26 #include "value.h"
27 #include "gdbcore.h"
28 #include "target.h"
29 #include "command.h"
30 #include "gdbcmd.h"
31 #include "language.h"
32 #include "demangle.h"
33 #include "c-lang.h"
34 #include "typeprint.h"
35 #include "ada-lang.h"
36 
37 #include <ctype.h>
38 #include "gdb_string.h"
39 #include <errno.h>
40 
41 static int print_selected_record_field_types (struct type *, struct type *,
42 					      int, int,
43 					      struct ui_file *, int, int);
44 
45 static int print_record_field_types (struct type *, struct type *,
46 				     struct ui_file *, int, int);
47 
48 static void print_array_type (struct type *, struct ui_file *, int, int);
49 
50 static int print_choices (struct type *, int, struct ui_file *,
51 			  struct type *);
52 
53 static void print_range (struct type *, struct ui_file *);
54 
55 static void print_range_bound (struct type *, char *, int *,
56 			       struct ui_file *);
57 
58 static void
59 print_dynamic_range_bound (struct type *, const char *, int,
60 			   const char *, struct ui_file *);
61 
62 static void print_range_type (struct type *, struct ui_file *);
63 
64 
65 
66 static char *name_buffer;
67 static int name_buffer_len;
68 
69 /* The (decoded) Ada name of TYPE.  This value persists until the
70    next call.  */
71 
72 static char *
73 decoded_type_name (struct type *type)
74 {
75   if (ada_type_name (type) == NULL)
76     return NULL;
77   else
78     {
79       char *raw_name = ada_type_name (type);
80       char *s, *q;
81 
82       if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
83 	{
84 	  name_buffer_len = 16 + 2 * strlen (raw_name);
85 	  name_buffer = xrealloc (name_buffer, name_buffer_len);
86 	}
87       strcpy (name_buffer, raw_name);
88 
89       s = (char *) strstr (name_buffer, "___");
90       if (s != NULL)
91 	*s = '\0';
92 
93       s = name_buffer + strlen (name_buffer) - 1;
94       while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
95 	s -= 1;
96 
97       if (s == name_buffer)
98 	return name_buffer;
99 
100       if (!islower (s[1]))
101 	return NULL;
102 
103       for (s = q = name_buffer; *s != '\0'; q += 1)
104 	{
105 	  if (s[0] == '_' && s[1] == '_')
106 	    {
107 	      *q = '.';
108 	      s += 2;
109 	    }
110 	  else
111 	    {
112 	      *q = *s;
113 	      s += 1;
114 	    }
115 	}
116       *q = '\0';
117       return name_buffer;
118     }
119 }
120 
121 /* Print TYPE on STREAM, preferably as a range.  */
122 
123 static void
124 print_range (struct type *type, struct ui_file *stream)
125 {
126   switch (TYPE_CODE (type))
127     {
128     case TYPE_CODE_RANGE:
129     case TYPE_CODE_ENUM:
130       {
131 	struct type *target_type;
132 	target_type = TYPE_TARGET_TYPE (type);
133 	if (target_type == NULL)
134 	  target_type = type;
135 	ada_print_scalar (target_type, ada_discrete_type_low_bound (type),
136 			  stream);
137 	fprintf_filtered (stream, " .. ");
138 	ada_print_scalar (target_type, ada_discrete_type_high_bound (type),
139 			  stream);
140       }
141       break;
142     default:
143       fprintf_filtered (stream, "%.*s",
144 			ada_name_prefix_len (TYPE_NAME (type)),
145 			TYPE_NAME (type));
146       break;
147     }
148 }
149 
150 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
151    set *N past the bound and its delimiter, if any.  */
152 
153 static void
154 print_range_bound (struct type *type, char *bounds, int *n,
155 		   struct ui_file *stream)
156 {
157   LONGEST B;
158 
159   if (ada_scan_number (bounds, *n, &B, n))
160     {
161       /* STABS decodes all range types which bounds are 0 .. -1 as
162          unsigned integers (ie. the type code is TYPE_CODE_INT, not
163          TYPE_CODE_RANGE).  Unfortunately, ada_print_scalar() relies
164          on the unsigned flag to determine whether the bound should
165          be printed as a signed or an unsigned value.  This causes
166          the upper bound of the 0 .. -1 range types to be printed as
167          a very large unsigned number instead of -1.
168          To workaround this stabs deficiency, we replace the TYPE by NULL
169          to indicate default output when we detect that the bound is negative,
170          and the type is a TYPE_CODE_INT.  The bound is negative when
171          'm' is the last character of the number scanned in BOUNDS.  */
172       if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
173 	type = NULL;
174       ada_print_scalar (type, B, stream);
175       if (bounds[*n] == '_')
176 	*n += 2;
177     }
178   else
179     {
180       int bound_len;
181       char *bound = bounds + *n;
182       char *pend;
183 
184       pend = strstr (bound, "__");
185       if (pend == NULL)
186 	*n += bound_len = strlen (bound);
187       else
188 	{
189 	  bound_len = pend - bound;
190 	  *n += bound_len + 2;
191 	}
192       fprintf_filtered (stream, "%.*s", bound_len, bound);
193     }
194 }
195 
196 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
197    the value (if found) of the bound indicated by SUFFIX ("___L" or
198    "___U") according to the ___XD conventions.  */
199 
200 static void
201 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
202 			   const char *suffix, struct ui_file *stream)
203 {
204   static char *name_buf = NULL;
205   static size_t name_buf_len = 0;
206   LONGEST B;
207   int OK;
208 
209   GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
210   strncpy (name_buf, name, name_len);
211   strcpy (name_buf + name_len, suffix);
212 
213   B = get_int_var_value (name_buf, &OK);
214   if (OK)
215     ada_print_scalar (type, B, stream);
216   else
217     fprintf_filtered (stream, "?");
218 }
219 
220 /* Print RAW_TYPE as a range type, using any bound information
221    following the GNAT encoding (if available).  */
222 
223 static void
224 print_range_type (struct type *raw_type, struct ui_file *stream)
225 {
226   char *name;
227   struct type *base_type;
228   char *subtype_info;
229 
230   gdb_assert (raw_type != NULL);
231   name = TYPE_NAME (raw_type);
232   gdb_assert (name != NULL);
233 
234   if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
235     base_type = TYPE_TARGET_TYPE (raw_type);
236   else
237     base_type = raw_type;
238 
239   subtype_info = strstr (name, "___XD");
240   if (subtype_info == NULL)
241     print_range (raw_type, stream);
242   else
243     {
244       int prefix_len = subtype_info - name;
245       char *bounds_str;
246       int n;
247 
248       subtype_info += 5;
249       bounds_str = strchr (subtype_info, '_');
250       n = 1;
251 
252       if (*subtype_info == 'L')
253 	{
254 	  print_range_bound (base_type, bounds_str, &n, stream);
255 	  subtype_info += 1;
256 	}
257       else
258 	print_dynamic_range_bound (base_type, name, prefix_len, "___L",
259 				   stream);
260 
261       fprintf_filtered (stream, " .. ");
262 
263       if (*subtype_info == 'U')
264 	print_range_bound (base_type, bounds_str, &n, stream);
265       else
266 	print_dynamic_range_bound (base_type, name, prefix_len, "___U",
267 				   stream);
268     }
269 }
270 
271 /* Print enumerated type TYPE on STREAM.  */
272 
273 static void
274 print_enum_type (struct type *type, struct ui_file *stream)
275 {
276   int len = TYPE_NFIELDS (type);
277   int i, lastval;
278 
279   fprintf_filtered (stream, "(");
280   wrap_here (" ");
281 
282   lastval = 0;
283   for (i = 0; i < len; i++)
284     {
285       QUIT;
286       if (i)
287 	fprintf_filtered (stream, ", ");
288       wrap_here ("    ");
289       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
290       if (lastval != TYPE_FIELD_BITPOS (type, i))
291 	{
292 	  fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
293 	  lastval = TYPE_FIELD_BITPOS (type, i);
294 	}
295       lastval += 1;
296     }
297   fprintf_filtered (stream, ")");
298 }
299 
300 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
301 
302 static void
303 print_fixed_point_type (struct type *type, struct ui_file *stream)
304 {
305   DOUBLEST delta = ada_delta (type);
306   DOUBLEST small = ada_fixed_to_float (type, 1.0);
307 
308   if (delta < 0.0)
309     fprintf_filtered (stream, "delta ??");
310   else
311     {
312       fprintf_filtered (stream, "delta %g", (double) delta);
313       if (delta != small)
314 	fprintf_filtered (stream, " <'small = %g>", (double) small);
315     }
316 }
317 
318 /* Print simple (constrained) array type TYPE on STREAM.  LEVEL is the
319    recursion (indentation) level, in case the element type itself has
320    nested structure, and SHOW is the number of levels of internal
321    structure to show (see ada_print_type).  */
322 
323 static void
324 print_array_type (struct type *type, struct ui_file *stream, int show,
325 		  int level)
326 {
327   int bitsize;
328   int n_indices;
329 
330   if (ada_is_constrained_packed_array_type (type))
331     type = ada_coerce_to_simple_array_type (type);
332 
333   bitsize = 0;
334   fprintf_filtered (stream, "array (");
335 
336   if (type == NULL)
337     {
338       fprintf_filtered (stream, _("<undecipherable array type>"));
339       return;
340     }
341 
342   n_indices = -1;
343   if (show < 0)
344     fprintf_filtered (stream, "...");
345   else
346     {
347       if (ada_is_simple_array_type (type))
348 	{
349 	  struct type *range_desc_type;
350 	  struct type *arr_type;
351 
352 	  range_desc_type = ada_find_parallel_type (type, "___XA");
353 	  ada_fixup_array_indexes_type (range_desc_type);
354 
355 	  bitsize = 0;
356 	  if (range_desc_type == NULL)
357 	    {
358 	      for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
359 		   arr_type = TYPE_TARGET_TYPE (arr_type))
360 		{
361 		  if (arr_type != type)
362 		    fprintf_filtered (stream, ", ");
363 		  print_range (TYPE_INDEX_TYPE (arr_type), stream);
364 		  if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
365 		    bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
366 		}
367 	    }
368 	  else
369 	    {
370 	      int k;
371 
372 	      n_indices = TYPE_NFIELDS (range_desc_type);
373 	      for (k = 0, arr_type = type;
374 		   k < n_indices;
375 		   k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
376 		{
377 		  if (k > 0)
378 		    fprintf_filtered (stream, ", ");
379 		  print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
380 				    stream);
381 		  if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
382 		    bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
383 		}
384 	    }
385 	}
386       else
387 	{
388 	  int i, i0;
389 
390 	  for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
391 	    fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
392 	}
393     }
394 
395   fprintf_filtered (stream, ") of ");
396   wrap_here ("");
397   ada_print_type (ada_array_element_type (type, n_indices), "", stream,
398 		  show == 0 ? 0 : show - 1, level + 1);
399   if (bitsize > 0)
400     fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
401 }
402 
403 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
404    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
405    values.  Return non-zero if the field is an encoding of
406    discriminant values, as in a standard variant record, and 0 if the
407    field is not so encoded (as happens with single-component variants
408    in types annotated with pragma Unchecked_Variant).  */
409 
410 static int
411 print_choices (struct type *type, int field_num, struct ui_file *stream,
412 	       struct type *val_type)
413 {
414   int have_output;
415   int p;
416   const char *name = TYPE_FIELD_NAME (type, field_num);
417 
418   have_output = 0;
419 
420   /* Skip over leading 'V': NOTE soon to be obsolete.  */
421   if (name[0] == 'V')
422     {
423       if (!ada_scan_number (name, 1, NULL, &p))
424 	goto Huh;
425     }
426   else
427     p = 0;
428 
429   while (1)
430     {
431       switch (name[p])
432 	{
433 	default:
434 	  goto Huh;
435 	case '_':
436 	case '\0':
437 	  fprintf_filtered (stream, " =>");
438 	  return 1;
439 	case 'S':
440 	case 'R':
441 	case 'O':
442 	  if (have_output)
443 	    fprintf_filtered (stream, " | ");
444 	  have_output = 1;
445 	  break;
446 	}
447 
448       switch (name[p])
449 	{
450 	case 'S':
451 	  {
452 	    LONGEST W;
453 
454 	    if (!ada_scan_number (name, p + 1, &W, &p))
455 	      goto Huh;
456 	    ada_print_scalar (val_type, W, stream);
457 	    break;
458 	  }
459 	case 'R':
460 	  {
461 	    LONGEST L, U;
462 
463 	    if (!ada_scan_number (name, p + 1, &L, &p)
464 		|| name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
465 	      goto Huh;
466 	    ada_print_scalar (val_type, L, stream);
467 	    fprintf_filtered (stream, " .. ");
468 	    ada_print_scalar (val_type, U, stream);
469 	    break;
470 	  }
471 	case 'O':
472 	  fprintf_filtered (stream, "others");
473 	  p += 1;
474 	  break;
475 	}
476     }
477 
478 Huh:
479   fprintf_filtered (stream, "?? =>");
480   return 0;
481 }
482 
483 /* Assuming that field FIELD_NUM of TYPE represents variants whose
484    discriminant is contained in OUTER_TYPE, print its components on STREAM.
485    LEVEL is the recursion (indentation) level, in case any of the fields
486    themselves have nested structure, and SHOW is the number of levels of
487    internal structure to show (see ada_print_type).  For this purpose,
488    fields nested in a variant part are taken to be at the same level as
489    the fields immediately outside the variant part.  */
490 
491 static void
492 print_variant_clauses (struct type *type, int field_num,
493 		       struct type *outer_type, struct ui_file *stream,
494 		       int show, int level)
495 {
496   int i;
497   struct type *var_type, *par_type;
498   struct type *discr_type;
499 
500   var_type = TYPE_FIELD_TYPE (type, field_num);
501   discr_type = ada_variant_discrim_type (var_type, outer_type);
502 
503   if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
504     {
505       var_type = TYPE_TARGET_TYPE (var_type);
506       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
507 	return;
508     }
509 
510   par_type = ada_find_parallel_type (var_type, "___XVU");
511   if (par_type != NULL)
512     var_type = par_type;
513 
514   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
515     {
516       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
517       if (print_choices (var_type, i, stream, discr_type))
518 	{
519 	  if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
520 					outer_type, stream, show, level + 4)
521 	      <= 0)
522 	    fprintf_filtered (stream, " null;");
523 	}
524       else
525 	print_selected_record_field_types (var_type, outer_type, i, i,
526 					   stream, show, level + 4);
527     }
528 }
529 
530 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
531    discriminants are contained in OUTER_TYPE, print a description of it
532    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
533    the fields themselves have nested structure, and SHOW is the number of
534    levels of internal structure to show (see ada_print_type).  For this
535    purpose, fields nested in a variant part are taken to be at the same
536    level as the fields immediately outside the variant part.  */
537 
538 static void
539 print_variant_part (struct type *type, int field_num, struct type *outer_type,
540 		    struct ui_file *stream, int show, int level)
541 {
542   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
543 		    ada_variant_discrim_name
544 		    (TYPE_FIELD_TYPE (type, field_num)));
545   print_variant_clauses (type, field_num, outer_type, stream, show,
546 			 level + 4);
547   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
548 }
549 
550 /* Print a description on STREAM of the fields FLD0 through FLD1 in
551    record or union type TYPE, whose discriminants are in OUTER_TYPE.
552    LEVEL is the recursion (indentation) level, in case any of the
553    fields themselves have nested structure, and SHOW is the number of
554    levels of internal structure to show (see ada_print_type).  Does
555    not print parent type information of TYPE.  Returns 0 if no fields
556    printed, -1 for an incomplete type, else > 0.  Prints each field
557    beginning on a new line, but does not put a new line at end.  */
558 
559 static int
560 print_selected_record_field_types (struct type *type, struct type *outer_type,
561 				   int fld0, int fld1,
562 				   struct ui_file *stream, int show, int level)
563 {
564   int i, flds;
565 
566   flds = 0;
567 
568   if (fld0 > fld1 && TYPE_STUB (type))
569     return -1;
570 
571   for (i = fld0; i <= fld1; i += 1)
572     {
573       QUIT;
574 
575       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
576 	;
577       else if (ada_is_wrapper_field (type, i))
578 	flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
579 					  stream, show, level);
580       else if (ada_is_variant_part (type, i))
581 	{
582 	  print_variant_part (type, i, outer_type, stream, show, level);
583 	  flds = 1;
584 	}
585       else
586 	{
587 	  flds += 1;
588 	  fprintf_filtered (stream, "\n%*s", level + 4, "");
589 	  ada_print_type (TYPE_FIELD_TYPE (type, i),
590 			  TYPE_FIELD_NAME (type, i),
591 			  stream, show - 1, level + 4);
592 	  fprintf_filtered (stream, ";");
593 	}
594     }
595 
596   return flds;
597 }
598 
599 /* Print a description on STREAM of all fields of record or union type
600    TYPE, as for print_selected_record_field_types, above.  */
601 
602 static int
603 print_record_field_types (struct type *type, struct type *outer_type,
604 			  struct ui_file *stream, int show, int level)
605 {
606   return print_selected_record_field_types (type, outer_type,
607 					    0, TYPE_NFIELDS (type) - 1,
608 					    stream, show, level);
609 }
610 
611 
612 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
613    level, in case the element type itself has nested structure, and SHOW is
614    the number of levels of internal structure to show (see ada_print_type).  */
615 
616 static void
617 print_record_type (struct type *type0, struct ui_file *stream, int show,
618 		   int level)
619 {
620   struct type *parent_type;
621   struct type *type;
622 
623   type = ada_find_parallel_type (type0, "___XVE");
624   if (type == NULL)
625     type = type0;
626 
627   parent_type = ada_parent_type (type);
628   if (ada_type_name (parent_type) != NULL)
629     fprintf_filtered (stream, "new %s with record",
630 		      decoded_type_name (parent_type));
631   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
632     fprintf_filtered (stream, "tagged record");
633   else
634     fprintf_filtered (stream, "record");
635 
636   if (show < 0)
637     fprintf_filtered (stream, " ... end record");
638   else
639     {
640       int flds;
641 
642       flds = 0;
643       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
644 	flds += print_record_field_types (parent_type, parent_type,
645 					  stream, show, level);
646       flds += print_record_field_types (type, type, stream, show, level);
647 
648       if (flds > 0)
649 	fprintf_filtered (stream, "\n%*send record", level, "");
650       else if (flds < 0)
651 	fprintf_filtered (stream, _(" <incomplete type> end record"));
652       else
653 	fprintf_filtered (stream, " null; end record");
654     }
655 }
656 
657 /* Print the unchecked union type TYPE in something resembling Ada
658    format on STREAM.  LEVEL is the recursion (indentation) level
659    in case the element type itself has nested structure, and SHOW is the
660    number of levels of internal structure to show (see ada_print_type).  */
661 static void
662 print_unchecked_union_type (struct type *type, struct ui_file *stream,
663 			    int show, int level)
664 {
665   if (show < 0)
666     fprintf_filtered (stream, "record (?) is ... end record");
667   else if (TYPE_NFIELDS (type) == 0)
668     fprintf_filtered (stream, "record (?) is null; end record");
669   else
670     {
671       int i;
672 
673       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
674 
675       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
676 	{
677 	  fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
678 			    level + 12, "");
679 	  ada_print_type (TYPE_FIELD_TYPE (type, i),
680 			  TYPE_FIELD_NAME (type, i),
681 			  stream, show - 1, level + 12);
682 	  fprintf_filtered (stream, ";");
683 	}
684 
685       fprintf_filtered (stream, "\n%*send case;\n%*send record",
686 			level + 4, "", level, "");
687     }
688 }
689 
690 
691 
692 /* Print function or procedure type TYPE on STREAM.  Make it a header
693    for function or procedure NAME if NAME is not null.  */
694 
695 static void
696 print_func_type (struct type *type, struct ui_file *stream, const char *name)
697 {
698   int i, len = TYPE_NFIELDS (type);
699 
700   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
701     fprintf_filtered (stream, "procedure");
702   else
703     fprintf_filtered (stream, "function");
704 
705   if (name != NULL && name[0] != '\0')
706     fprintf_filtered (stream, " %s", name);
707 
708   if (len > 0)
709     {
710       fprintf_filtered (stream, " (");
711       for (i = 0; i < len; i += 1)
712 	{
713 	  if (i > 0)
714 	    {
715 	      fputs_filtered ("; ", stream);
716 	      wrap_here ("    ");
717 	    }
718 	  fprintf_filtered (stream, "a%d: ", i + 1);
719 	  ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
720 	}
721       fprintf_filtered (stream, ")");
722     }
723 
724   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
725     {
726       fprintf_filtered (stream, " return ");
727       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
728     }
729 }
730 
731 
732 /* Print a description of a type TYPE0.
733    Output goes to STREAM (via stdio).
734    If VARSTRING is a non-empty string, print as an Ada variable/field
735        declaration.
736    SHOW+1 is the maximum number of levels of internal type structure
737       to show (this applies to record types, enumerated types, and
738       array types).
739    SHOW is the number of levels of internal type structure to show
740       when there is a type name for the SHOWth deepest level (0th is
741       outer level).
742    When SHOW<0, no inner structure is shown.
743    LEVEL indicates level of recursion (for nested definitions).  */
744 
745 void
746 ada_print_type (struct type *type0, const char *varstring,
747 		struct ui_file *stream, int show, int level)
748 {
749   struct type *type = ada_check_typedef (ada_get_base_type (type0));
750   char *type_name = decoded_type_name (type0);
751   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
752 
753   if (type == NULL)
754     {
755       if (is_var_decl)
756 	fprintf_filtered (stream, "%.*s: ",
757 			  ada_name_prefix_len (varstring), varstring);
758       fprintf_filtered (stream, "<null type?>");
759       return;
760     }
761 
762   if (show > 0)
763     type = ada_check_typedef (type);
764 
765   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
766     fprintf_filtered (stream, "%.*s: ",
767 		      ada_name_prefix_len (varstring), varstring);
768 
769   if (type_name != NULL && show <= 0)
770     {
771       fprintf_filtered (stream, "%.*s",
772 			ada_name_prefix_len (type_name), type_name);
773       return;
774     }
775 
776   if (ada_is_aligner_type (type))
777     ada_print_type (ada_aligned_type (type), "", stream, show, level);
778   else if (ada_is_constrained_packed_array_type (type))
779     {
780       if (TYPE_CODE (type) == TYPE_CODE_PTR)
781         {
782           fprintf_filtered (stream, "access ");
783           print_array_type (TYPE_TARGET_TYPE (type), stream, show, level);
784         }
785       else
786         {
787           print_array_type (type, stream, show, level);
788         }
789     }
790   else
791     switch (TYPE_CODE (type))
792       {
793       default:
794 	fprintf_filtered (stream, "<");
795 	c_print_type (type, "", stream, show, level);
796 	fprintf_filtered (stream, ">");
797 	break;
798       case TYPE_CODE_PTR:
799       case TYPE_CODE_TYPEDEF:
800 	fprintf_filtered (stream, "access ");
801 	ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
802 	break;
803       case TYPE_CODE_REF:
804 	fprintf_filtered (stream, "<ref> ");
805 	ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
806 	break;
807       case TYPE_CODE_ARRAY:
808 	print_array_type (type, stream, show, level);
809 	break;
810       case TYPE_CODE_BOOL:
811 	fprintf_filtered (stream, "(false, true)");
812 	break;
813       case TYPE_CODE_INT:
814 	if (ada_is_fixed_point_type (type))
815 	  print_fixed_point_type (type, stream);
816 	else
817 	  {
818 	    char *name = ada_type_name (type);
819 
820 	    if (!ada_is_range_type_name (name))
821 	      fprintf_filtered (stream, _("<%d-byte integer>"),
822 				TYPE_LENGTH (type));
823 	    else
824 	      {
825 		fprintf_filtered (stream, "range ");
826 		print_range_type (type, stream);
827 	      }
828 	  }
829 	break;
830       case TYPE_CODE_RANGE:
831 	if (ada_is_fixed_point_type (type))
832 	  print_fixed_point_type (type, stream);
833 	else if (ada_is_modular_type (type))
834 	  fprintf_filtered (stream, "mod %s",
835 			    int_string (ada_modulus (type), 10, 0, 0, 1));
836 	else
837 	  {
838 	    fprintf_filtered (stream, "range ");
839 	    print_range (type, stream);
840 	  }
841 	break;
842       case TYPE_CODE_FLT:
843 	fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
844 	break;
845       case TYPE_CODE_ENUM:
846 	if (show < 0)
847 	  fprintf_filtered (stream, "(...)");
848 	else
849 	  print_enum_type (type, stream);
850 	break;
851       case TYPE_CODE_STRUCT:
852 	if (ada_is_array_descriptor_type (type))
853 	  print_array_type (type, stream, show, level);
854 	else if (ada_is_bogus_array_descriptor (type))
855 	  fprintf_filtered (stream,
856 			    _("array (?) of ? (<mal-formed descriptor>)"));
857 	else
858 	  print_record_type (type, stream, show, level);
859 	break;
860       case TYPE_CODE_UNION:
861 	print_unchecked_union_type (type, stream, show, level);
862 	break;
863       case TYPE_CODE_FUNC:
864 	print_func_type (type, stream, varstring);
865 	break;
866       }
867 }
868 
869 /* Implement the la_print_typedef language method for Ada.  */
870 
871 void
872 ada_print_typedef (struct type *type, struct symbol *new_symbol,
873                    struct ui_file *stream)
874 {
875   type = ada_check_typedef (type);
876   ada_print_type (type, "", stream, 0, 0);
877   fprintf_filtered (stream, "\n");
878 }
879