]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/ada-typeprint.c
Update Copyright year range in all files maintained by GDB.
[thirdparty/binutils-gdb.git] / gdb / ada-typeprint.c
CommitLineData
14f9c5c9 1/* Support for printing Ada types for GDB, the GNU debugger.
ecd75fc8 2 Copyright (C) 1986-2014 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"
35
36#include <ctype.h>
0e9f083f 37#include <string.h>
14f9c5c9
AS
38#include <errno.h>
39
83e3a93c
PH
40static int print_selected_record_field_types (struct type *, struct type *,
41 int, int,
79d43c61
TT
42 struct ui_file *, int, int,
43 const struct type_print_options *);
83e3a93c 44
d2e4a39e 45static int print_record_field_types (struct type *, struct type *,
79d43c61
TT
46 struct ui_file *, int, int,
47 const struct type_print_options *);
14f9c5c9 48
79d43c61
TT
49static void print_array_type (struct type *, struct ui_file *, int, int,
50 const struct type_print_options *);
14f9c5c9 51
83e3a93c
PH
52static int print_choices (struct type *, int, struct ui_file *,
53 struct type *);
14f9c5c9 54
d2e4a39e 55static void print_range (struct type *, struct ui_file *);
14f9c5c9 56
d2e4a39e
AS
57static void print_range_bound (struct type *, char *, int *,
58 struct ui_file *);
14f9c5c9 59
d2e4a39e
AS
60static void
61print_dynamic_range_bound (struct type *, const char *, int,
62 const char *, struct ui_file *);
14f9c5c9 63
28c85d6c 64static void print_range_type (struct type *, struct ui_file *);
14f9c5c9
AS
65\f
66
d2e4a39e
AS
67
68static char *name_buffer;
14f9c5c9
AS
69static int name_buffer_len;
70
4c4b4cd2
PH
71/* The (decoded) Ada name of TYPE. This value persists until the
72 next call. */
14f9c5c9 73
d2e4a39e 74static char *
4c4b4cd2 75decoded_type_name (struct type *type)
14f9c5c9
AS
76{
77 if (ada_type_name (type) == NULL)
78 return NULL;
d2e4a39e 79 else
14f9c5c9 80 {
0d5cff50 81 const char *raw_name = ada_type_name (type);
d2e4a39e 82 char *s, *q;
14f9c5c9
AS
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
d2e4a39e 91 s = (char *) strstr (name_buffer, "___");
14f9c5c9
AS
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
d2e4a39e 102 if (!islower (s[1]))
14f9c5c9
AS
103 return NULL;
104
105 for (s = q = name_buffer; *s != '\0'; q += 1)
106 {
107 if (s[0] == '_' && s[1] == '_')
108 {
d2e4a39e
AS
109 *q = '.';
110 s += 2;
14f9c5c9
AS
111 }
112 else
113 {
d2e4a39e
AS
114 *q = *s;
115 s += 1;
14f9c5c9
AS
116 }
117 }
118 *q = '\0';
119 return name_buffer;
120 }
121}
122
43bbcdc2 123/* Print TYPE on STREAM, preferably as a range. */
14f9c5c9
AS
124
125static void
d2e4a39e 126print_range (struct type *type, struct ui_file *stream)
14f9c5c9 127{
43bbcdc2 128 switch (TYPE_CODE (type))
14f9c5c9
AS
129 {
130 case TYPE_CODE_RANGE:
14f9c5c9 131 case TYPE_CODE_ENUM:
43bbcdc2
PH
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 }
14f9c5c9
AS
143 break;
144 default:
14f9c5c9 145 fprintf_filtered (stream, "%.*s",
d2e4a39e
AS
146 ada_name_prefix_len (TYPE_NAME (type)),
147 TYPE_NAME (type));
43bbcdc2 148 break;
14f9c5c9
AS
149 }
150}
151
152/* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
4c4b4cd2 153 set *N past the bound and its delimiter, if any. */
14f9c5c9
AS
154
155static void
d2e4a39e
AS
156print_range_bound (struct type *type, char *bounds, int *n,
157 struct ui_file *stream)
14f9c5c9
AS
158{
159 LONGEST B;
5b4ee69b 160
14f9c5c9
AS
161 if (ada_scan_number (bounds, *n, &B, n))
162 {
4c4b4cd2
PH
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.
7c964f07
UW
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,
4c4b4cd2
PH
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)
7c964f07 175 type = NULL;
14f9c5c9
AS
176 ada_print_scalar (type, B, stream);
177 if (bounds[*n] == '_')
178 *n += 2;
179 }
180 else
181 {
182 int bound_len;
d2e4a39e
AS
183 char *bound = bounds + *n;
184 char *pend;
14f9c5c9
AS
185
186 pend = strstr (bound, "__");
187 if (pend == NULL)
188 *n += bound_len = strlen (bound);
d2e4a39e 189 else
14f9c5c9
AS
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
4c4b4cd2 200 "___U") according to the ___XD conventions. */
14f9c5c9
AS
201
202static void
d2e4a39e
AS
203print_dynamic_range_bound (struct type *type, const char *name, int name_len,
204 const char *suffix, struct ui_file *stream)
14f9c5c9
AS
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
4c4b4cd2 215 B = get_int_var_value (name_buf, &OK);
14f9c5c9
AS
216 if (OK)
217 ada_print_scalar (type, B, stream);
218 else
219 fprintf_filtered (stream, "?");
220}
221
28c85d6c
JB
222/* Print RAW_TYPE as a range type, using any bound information
223 following the GNAT encoding (if available). */
14f9c5c9
AS
224
225static void
28c85d6c 226print_range_type (struct type *raw_type, struct ui_file *stream)
14f9c5c9 227{
0d5cff50 228 const char *name;
14f9c5c9 229 struct type *base_type;
0d5cff50 230 const char *subtype_info;
14f9c5c9 231
28c85d6c
JB
232 gdb_assert (raw_type != NULL);
233 name = TYPE_NAME (raw_type);
234 gdb_assert (name != NULL);
1ce677a4
UW
235
236 if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
14f9c5c9
AS
237 base_type = TYPE_TARGET_TYPE (raw_type);
238 else
239 base_type = raw_type;
240
241 subtype_info = strstr (name, "___XD");
1ce677a4 242 if (subtype_info == NULL)
14f9c5c9
AS
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
d2e4a39e 254 if (*subtype_info == 'L')
14f9c5c9 255 {
4c4b4cd2 256 print_range_bound (base_type, bounds_str, &n, stream);
14f9c5c9
AS
257 subtype_info += 1;
258 }
259 else
4c4b4cd2 260 print_dynamic_range_bound (base_type, name, prefix_len, "___L",
d2e4a39e 261 stream);
14f9c5c9
AS
262
263 fprintf_filtered (stream, " .. ");
264
d2e4a39e 265 if (*subtype_info == 'U')
4c4b4cd2 266 print_range_bound (base_type, bounds_str, &n, stream);
14f9c5c9 267 else
4c4b4cd2 268 print_dynamic_range_bound (base_type, name, prefix_len, "___U",
d2e4a39e 269 stream);
14f9c5c9 270 }
d2e4a39e 271}
14f9c5c9 272
4c4b4cd2 273/* Print enumerated type TYPE on STREAM. */
14f9c5c9
AS
274
275static void
ebf56fd3 276print_enum_type (struct type *type, struct ui_file *stream)
14f9c5c9
AS
277{
278 int len = TYPE_NFIELDS (type);
14e75d8e
JK
279 int i;
280 LONGEST lastval;
14f9c5c9
AS
281
282 fprintf_filtered (stream, "(");
283 wrap_here (" ");
284
285 lastval = 0;
286 for (i = 0; i < len; i++)
287 {
288 QUIT;
d2e4a39e
AS
289 if (i)
290 fprintf_filtered (stream, ", ");
14f9c5c9
AS
291 wrap_here (" ");
292 fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
14e75d8e 293 if (lastval != TYPE_FIELD_ENUMVAL (type, i))
14f9c5c9 294 {
14e75d8e
JK
295 fprintf_filtered (stream, " => %s",
296 plongest (TYPE_FIELD_ENUMVAL (type, i)));
297 lastval = TYPE_FIELD_ENUMVAL (type, i);
14f9c5c9
AS
298 }
299 lastval += 1;
300 }
301 fprintf_filtered (stream, ")");
302}
303
4c4b4cd2 304/* Print representation of Ada fixed-point type TYPE on STREAM. */
14f9c5c9
AS
305
306static void
ebf56fd3 307print_fixed_point_type (struct type *type, struct ui_file *stream)
14f9c5c9
AS
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);
d2e4a39e 317 if (delta != small)
14f9c5c9
AS
318 fprintf_filtered (stream, " <'small = %g>", (double) small);
319 }
320}
321
4c4b4cd2
PH
322/* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
323 recursion (indentation) level, in case the element type itself has
14f9c5c9 324 nested structure, and SHOW is the number of levels of internal
4c4b4cd2 325 structure to show (see ada_print_type). */
14f9c5c9
AS
326
327static void
d2e4a39e 328print_array_type (struct type *type, struct ui_file *stream, int show,
79d43c61 329 int level, const struct type_print_options *flags)
14f9c5c9
AS
330{
331 int bitsize;
332 int n_indices;
333
ad82864c 334 if (ada_is_constrained_packed_array_type (type))
727e3d2e
JB
335 type = ada_coerce_to_simple_array_type (type);
336
14f9c5c9
AS
337 bitsize = 0;
338 fprintf_filtered (stream, "array (");
339
cb249c71
TT
340 if (type == NULL)
341 {
342 fprintf_filtered (stream, _("<undecipherable array type>"));
343 return;
344 }
345
14f9c5c9 346 n_indices = -1;
54ae186f 347 if (ada_is_simple_array_type (type))
14f9c5c9 348 {
54ae186f
JB
349 struct type *range_desc_type;
350 struct type *arr_type;
14f9c5c9 351
54ae186f
JB
352 range_desc_type = ada_find_parallel_type (type, "___XA");
353 ada_fixup_array_indexes_type (range_desc_type);
28c85d6c 354
54ae186f
JB
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))
14f9c5c9 360 {
54ae186f
JB
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);
14f9c5c9
AS
366 }
367 }
d2e4a39e 368 else
14f9c5c9 369 {
54ae186f 370 int k;
5b4ee69b 371
54ae186f
JB
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 }
14f9c5c9
AS
384 }
385 }
54ae186f
JB
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 }
14f9c5c9
AS
393
394 fprintf_filtered (stream, ") of ");
395 wrap_here ("");
d2e4a39e 396 ada_print_type (ada_array_element_type (type, n_indices), "", stream,
79d43c61 397 show == 0 ? 0 : show - 1, level + 1, flags);
14f9c5c9
AS
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
83e3a93c 403 STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
feb864b7 404 values. Return non-zero if the field is an encoding of
83e3a93c
PH
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
feb864b7 407 in types annotated with pragma Unchecked_Variant). */
14f9c5c9 408
83e3a93c 409static int
d2e4a39e
AS
410print_choices (struct type *type, int field_num, struct ui_file *stream,
411 struct type *val_type)
14f9c5c9
AS
412{
413 int have_output;
414 int p;
d2e4a39e 415 const char *name = TYPE_FIELD_NAME (type, field_num);
14f9c5c9
AS
416
417 have_output = 0;
418
4c4b4cd2 419 /* Skip over leading 'V': NOTE soon to be obsolete. */
14f9c5c9
AS
420 if (name[0] == 'V')
421 {
d2e4a39e 422 if (!ada_scan_number (name, 1, NULL, &p))
14f9c5c9
AS
423 goto Huh;
424 }
425 else
426 p = 0;
427
428 while (1)
429 {
d2e4a39e 430 switch (name[p])
14f9c5c9
AS
431 {
432 default:
83e3a93c
PH
433 goto Huh;
434 case '_':
435 case '\0':
436 fprintf_filtered (stream, " =>");
437 return 1;
14f9c5c9
AS
438 case 'S':
439 case 'R':
440 case 'O':
d2e4a39e 441 if (have_output)
14f9c5c9
AS
442 fprintf_filtered (stream, " | ");
443 have_output = 1;
444 break;
445 }
446
d2e4a39e 447 switch (name[p])
14f9c5c9
AS
448 {
449 case 'S':
450 {
451 LONGEST W;
5b4ee69b 452
d2e4a39e 453 if (!ada_scan_number (name, p + 1, &W, &p))
14f9c5c9
AS
454 goto Huh;
455 ada_print_scalar (val_type, W, stream);
456 break;
457 }
458 case 'R':
459 {
460 LONGEST L, U;
5b4ee69b 461
d2e4a39e
AS
462 if (!ada_scan_number (name, p + 1, &L, &p)
463 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
14f9c5c9
AS
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:
83e3a93c
PH
478 fprintf_filtered (stream, "?? =>");
479 return 0;
14f9c5c9
AS
480}
481
83e3a93c
PH
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. */
14f9c5c9
AS
489
490static void
ebf56fd3
AS
491print_variant_clauses (struct type *type, int field_num,
492 struct type *outer_type, struct ui_file *stream,
79d43c61
TT
493 int show, int level,
494 const struct type_print_options *flags)
14f9c5c9
AS
495{
496 int i;
4c4b4cd2 497 struct type *var_type, *par_type;
14f9c5c9
AS
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);
4c4b4cd2
PH
506 if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
507 return;
14f9c5c9
AS
508 }
509
4c4b4cd2
PH
510 par_type = ada_find_parallel_type (var_type, "___XVU");
511 if (par_type != NULL)
512 var_type = par_type;
513
d2e4a39e 514 for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
14f9c5c9
AS
515 {
516 fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
83e3a93c
PH
517 if (print_choices (var_type, i, stream, discr_type))
518 {
519 if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
79d43c61
TT
520 outer_type, stream, show, level + 4,
521 flags)
83e3a93c
PH
522 <= 0)
523 fprintf_filtered (stream, " null;");
524 }
525 else
526 print_selected_record_field_types (var_type, outer_type, i, i,
79d43c61 527 stream, show, level + 4, flags);
14f9c5c9
AS
528 }
529}
530
4c4b4cd2 531/* Assuming that field FIELD_NUM of TYPE is a variant part whose
14f9c5c9 532 discriminants are contained in OUTER_TYPE, print a description of it
4c4b4cd2
PH
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. */
14f9c5c9
AS
538
539static void
ebf56fd3 540print_variant_part (struct type *type, int field_num, struct type *outer_type,
79d43c61
TT
541 struct ui_file *stream, int show, int level,
542 const struct type_print_options *flags)
14f9c5c9
AS
543{
544 fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
d2e4a39e
AS
545 ada_variant_discrim_name
546 (TYPE_FIELD_TYPE (type, field_num)));
547 print_variant_clauses (type, field_num, outer_type, stream, show,
79d43c61 548 level + 4, flags);
14f9c5c9
AS
549 fprintf_filtered (stream, "\n%*send case;", level + 4, "");
550}
551
83e3a93c
PH
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
feb864b7 557 not print parent type information of TYPE. Returns 0 if no fields
83e3a93c
PH
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. */
14f9c5c9
AS
560
561static int
83e3a93c
PH
562print_selected_record_field_types (struct type *type, struct type *outer_type,
563 int fld0, int fld1,
79d43c61
TT
564 struct ui_file *stream, int show, int level,
565 const struct type_print_options *flags)
14f9c5c9 566{
83e3a93c 567 int i, flds;
14f9c5c9
AS
568
569 flds = 0;
14f9c5c9 570
83e3a93c 571 if (fld0 > fld1 && TYPE_STUB (type))
14f9c5c9
AS
572 return -1;
573
83e3a93c 574 for (i = fld0; i <= fld1; i += 1)
14f9c5c9
AS
575 {
576 QUIT;
577
d2e4a39e 578 if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
14f9c5c9
AS
579 ;
580 else if (ada_is_wrapper_field (type, i))
581 flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
79d43c61 582 stream, show, level, flags);
d2e4a39e 583 else if (ada_is_variant_part (type, i))
14f9c5c9 584 {
79d43c61 585 print_variant_part (type, i, outer_type, stream, show, level, flags);
14f9c5c9
AS
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),
79d43c61 594 stream, show - 1, level + 4, flags);
14f9c5c9
AS
595 fprintf_filtered (stream, ";");
596 }
597 }
598
599 return flds;
600}
601
83e3a93c
PH
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,
79d43c61
TT
607 struct ui_file *stream, int show, int level,
608 const struct type_print_options *flags)
83e3a93c
PH
609{
610 return print_selected_record_field_types (type, outer_type,
611 0, TYPE_NFIELDS (type) - 1,
79d43c61 612 stream, show, level, flags);
83e3a93c
PH
613}
614
615
4c4b4cd2
PH
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). */
14f9c5c9
AS
619
620static void
d2e4a39e 621print_record_type (struct type *type0, struct ui_file *stream, int show,
79d43c61 622 int level, const struct type_print_options *flags)
14f9c5c9 623{
d2e4a39e
AS
624 struct type *parent_type;
625 struct type *type;
626
4c4b4cd2
PH
627 type = ada_find_parallel_type (type0, "___XVE");
628 if (type == NULL)
629 type = type0;
14f9c5c9
AS
630
631 parent_type = ada_parent_type (type);
d2e4a39e 632 if (ada_type_name (parent_type) != NULL)
25552254
JB
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 }
4c4b4cd2 644 else if (parent_type == NULL && ada_is_tagged_type (type, 0))
0b48a291
PH
645 fprintf_filtered (stream, "tagged record");
646 else
647 fprintf_filtered (stream, "record");
14f9c5c9
AS
648
649 if (show < 0)
0b48a291 650 fprintf_filtered (stream, " ... end record");
14f9c5c9
AS
651 else
652 {
653 int flds;
654
655 flds = 0;
656 if (parent_type != NULL && ada_type_name (parent_type) == NULL)
d2e4a39e 657 flds += print_record_field_types (parent_type, parent_type,
79d43c61
TT
658 stream, show, level, flags);
659 flds += print_record_field_types (type, type, stream, show, level,
660 flags);
d2e4a39e 661
14f9c5c9 662 if (flds > 0)
0b48a291 663 fprintf_filtered (stream, "\n%*send record", level, "");
d2e4a39e 664 else if (flds < 0)
323e0a4a 665 fprintf_filtered (stream, _(" <incomplete type> end record"));
d2e4a39e 666 else
0b48a291 667 fprintf_filtered (stream, " null; end record");
14f9c5c9
AS
668 }
669}
670
671/* Print the unchecked union type TYPE in something resembling Ada
4c4b4cd2 672 format on STREAM. LEVEL is the recursion (indentation) level
14f9c5c9 673 in case the element type itself has nested structure, and SHOW is the
4c4b4cd2 674 number of levels of internal structure to show (see ada_print_type). */
14f9c5c9 675static void
d2e4a39e 676print_unchecked_union_type (struct type *type, struct ui_file *stream,
79d43c61
TT
677 int show, int level,
678 const struct type_print_options *flags)
14f9c5c9 679{
14f9c5c9 680 if (show < 0)
0b48a291 681 fprintf_filtered (stream, "record (?) is ... end record");
d2e4a39e 682 else if (TYPE_NFIELDS (type) == 0)
0b48a291 683 fprintf_filtered (stream, "record (?) is null; end record");
14f9c5c9
AS
684 else
685 {
686 int i;
687
0b48a291 688 fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
14f9c5c9 689
d2e4a39e 690 for (i = 0; i < TYPE_NFIELDS (type); i += 1)
14f9c5c9 691 {
0b48a291 692 fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
d2e4a39e 693 level + 12, "");
14f9c5c9
AS
694 ada_print_type (TYPE_FIELD_TYPE (type, i),
695 TYPE_FIELD_NAME (type, i),
79d43c61 696 stream, show - 1, level + 12, flags);
14f9c5c9
AS
697 fprintf_filtered (stream, ";");
698 }
699
0b48a291 700 fprintf_filtered (stream, "\n%*send case;\n%*send record",
d2e4a39e 701 level + 4, "", level, "");
14f9c5c9
AS
702 }
703}
d2e4a39e 704
14f9c5c9
AS
705
706
707/* Print function or procedure type TYPE on STREAM. Make it a header
4c4b4cd2 708 for function or procedure NAME if NAME is not null. */
14f9c5c9
AS
709
710static void
79d43c61
TT
711print_func_type (struct type *type, struct ui_file *stream, const char *name,
712 const struct type_print_options *flags)
14f9c5c9
AS
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
d2e4a39e 721 if (name != NULL && name[0] != '\0')
14f9c5c9
AS
722 fprintf_filtered (stream, " %s", name);
723
d2e4a39e 724 if (len > 0)
14f9c5c9
AS
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 }
d2e4a39e 734 fprintf_filtered (stream, "a%d: ", i + 1);
79d43c61
TT
735 ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0,
736 flags);
14f9c5c9
AS
737 }
738 fprintf_filtered (stream, ")");
d2e4a39e 739 }
14f9c5c9
AS
740
741 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
742 {
743 fprintf_filtered (stream, " return ");
79d43c61 744 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
14f9c5c9
AS
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.
4c4b4cd2 753 SHOW+1 is the maximum number of levels of internal type structure
14f9c5c9
AS
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
4c4b4cd2 757 when there is a type name for the SHOWth deepest level (0th is
14f9c5c9
AS
758 outer level).
759 When SHOW<0, no inner structure is shown.
4c4b4cd2 760 LEVEL indicates level of recursion (for nested definitions). */
14f9c5c9
AS
761
762void
25b524e8 763ada_print_type (struct type *type0, const char *varstring,
79d43c61
TT
764 struct ui_file *stream, int show, int level,
765 const struct type_print_options *flags)
14f9c5c9 766{
61ee279c 767 struct type *type = ada_check_typedef (ada_get_base_type (type0));
f192137b 768 char *type_name = decoded_type_name (type0);
14f9c5c9
AS
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: ",
d2e4a39e 775 ada_name_prefix_len (varstring), varstring);
14f9c5c9
AS
776 fprintf_filtered (stream, "<null type?>");
777 return;
778 }
779
780 if (show > 0)
61ee279c 781 type = ada_check_typedef (type);
14f9c5c9
AS
782
783 if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
d2e4a39e
AS
784 fprintf_filtered (stream, "%.*s: ",
785 ada_name_prefix_len (varstring), varstring);
14f9c5c9 786
d2d43431 787 if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
14f9c5c9 788 {
d2e4a39e 789 fprintf_filtered (stream, "%.*s",
14f9c5c9
AS
790 ada_name_prefix_len (type_name), type_name);
791 return;
792 }
793
794 if (ada_is_aligner_type (type))
79d43c61 795 ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
d2d43431
JB
796 else if (ada_is_constrained_packed_array_type (type)
797 && TYPE_CODE (type) != TYPE_CODE_PTR)
79d43c61 798 print_array_type (type, stream, show, level, flags);
14f9c5c9 799 else
d2e4a39e
AS
800 switch (TYPE_CODE (type))
801 {
802 default:
803 fprintf_filtered (stream, "<");
79d43c61 804 c_print_type (type, "", stream, show, level, flags);
d2e4a39e
AS
805 fprintf_filtered (stream, ">");
806 break;
807 case TYPE_CODE_PTR:
720d1a40 808 case TYPE_CODE_TYPEDEF:
d2e4a39e 809 fprintf_filtered (stream, "access ");
79d43c61
TT
810 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
811 flags);
d2e4a39e
AS
812 break;
813 case TYPE_CODE_REF:
814 fprintf_filtered (stream, "<ref> ");
79d43c61
TT
815 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
816 flags);
d2e4a39e
AS
817 break;
818 case TYPE_CODE_ARRAY:
79d43c61 819 print_array_type (type, stream, show, level, flags);
d2e4a39e 820 break;
690cc4eb
PH
821 case TYPE_CODE_BOOL:
822 fprintf_filtered (stream, "(false, true)");
823 break;
d2e4a39e
AS
824 case TYPE_CODE_INT:
825 if (ada_is_fixed_point_type (type))
826 print_fixed_point_type (type, stream);
d2e4a39e
AS
827 else
828 {
0d5cff50 829 const char *name = ada_type_name (type);
5b4ee69b 830
d2e4a39e 831 if (!ada_is_range_type_name (name))
e1d5a0d2 832 fprintf_filtered (stream, _("<%d-byte integer>"),
d2e4a39e
AS
833 TYPE_LENGTH (type));
834 else
835 {
836 fprintf_filtered (stream, "range ");
28c85d6c 837 print_range_type (type, stream);
d2e4a39e
AS
838 }
839 }
840 break;
841 case TYPE_CODE_RANGE:
842 if (ada_is_fixed_point_type (type))
843 print_fixed_point_type (type, stream);
d2e4a39e 844 else if (ada_is_modular_type (type))
529cad9c
PH
845 fprintf_filtered (stream, "mod %s",
846 int_string (ada_modulus (type), 10, 0, 0, 1));
d2e4a39e
AS
847 else
848 {
849 fprintf_filtered (stream, "range ");
850 print_range (type, stream);
851 }
852 break;
853 case TYPE_CODE_FLT:
e1d5a0d2 854 fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
d2e4a39e
AS
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:
4c4b4cd2 863 if (ada_is_array_descriptor_type (type))
79d43c61 864 print_array_type (type, stream, show, level, flags);
d2e4a39e
AS
865 else if (ada_is_bogus_array_descriptor (type))
866 fprintf_filtered (stream,
e1d5a0d2 867 _("array (?) of ? (<mal-formed descriptor>)"));
d2e4a39e 868 else
79d43c61 869 print_record_type (type, stream, show, level, flags);
d2e4a39e
AS
870 break;
871 case TYPE_CODE_UNION:
79d43c61 872 print_unchecked_union_type (type, stream, show, level, flags);
d2e4a39e
AS
873 break;
874 case TYPE_CODE_FUNC:
79d43c61 875 print_func_type (type, stream, varstring, flags);
d2e4a39e
AS
876 break;
877 }
14f9c5c9 878}
be942545
JB
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);
79d43c61 887 ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
be942545
JB
888 fprintf_filtered (stream, "\n");
889}