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