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