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