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