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