]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/ada-typeprint.c
* ada-lang.c (ada_value_struct_elt, to_fixed_array_type)
[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,
9b254dd1 3 2003, 2004, 2007, 2008 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
d2e4a39e 58static void print_range_type_named (char *, 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
117
4c4b4cd2 118/* Print a description of a type in the format of a
14f9c5c9 119 typedef for the current language.
4c4b4cd2 120 NEW is the new name for a type TYPE. */
14f9c5c9
AS
121
122void
d2e4a39e
AS
123ada_typedef_print (struct type *type, struct symbol *new,
124 struct ui_file *stream)
14f9c5c9 125{
323e0a4a 126 /* XXX: type_sprint */
0b48a291 127 fprintf_filtered (stream, "type %.*s is ",
de5ad195
DC
128 ada_name_prefix_len (SYMBOL_PRINT_NAME (new)),
129 SYMBOL_PRINT_NAME (new));
14f9c5c9
AS
130 type_print (type, "", stream, 1);
131}
132
4c4b4cd2 133/* Print range type TYPE on STREAM. */
14f9c5c9
AS
134
135static void
d2e4a39e 136print_range (struct type *type, struct ui_file *stream)
14f9c5c9 137{
d2e4a39e 138 struct type *target_type;
14f9c5c9
AS
139 target_type = TYPE_TARGET_TYPE (type);
140 if (target_type == NULL)
141 target_type = type;
142
d2e4a39e 143 switch (TYPE_CODE (target_type))
14f9c5c9
AS
144 {
145 case TYPE_CODE_RANGE:
146 case TYPE_CODE_INT:
147 case TYPE_CODE_BOOL:
148 case TYPE_CODE_CHAR:
149 case TYPE_CODE_ENUM:
150 break;
151 default:
72d5681a 152 target_type = builtin_type_int;
14f9c5c9
AS
153 break;
154 }
155
156 if (TYPE_NFIELDS (type) < 2)
157 {
4c4b4cd2 158 /* A range needs at least 2 bounds to be printed. If there are less
14f9c5c9 159 than 2, just print the type name instead of the range itself.
4c4b4cd2 160 This check handles cases such as characters, for example.
14f9c5c9 161
529cad9c 162 If the name is not defined, then we don't print anything.
14f9c5c9
AS
163 */
164 fprintf_filtered (stream, "%.*s",
d2e4a39e
AS
165 ada_name_prefix_len (TYPE_NAME (type)),
166 TYPE_NAME (type));
14f9c5c9
AS
167 }
168 else
169 {
170 /* We extract the range type bounds respectively from the first element
171 and the last element of the type->fields array */
172 const LONGEST lower_bound = (LONGEST) TYPE_LOW_BOUND (type);
173 const LONGEST upper_bound =
d2e4a39e 174 (LONGEST) TYPE_FIELD_BITPOS (type, TYPE_NFIELDS (type) - 1);
14f9c5c9
AS
175
176 ada_print_scalar (target_type, lower_bound, stream);
177 fprintf_filtered (stream, " .. ");
178 ada_print_scalar (target_type, upper_bound, stream);
179 }
180}
181
182/* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
4c4b4cd2 183 set *N past the bound and its delimiter, if any. */
14f9c5c9
AS
184
185static void
d2e4a39e
AS
186print_range_bound (struct type *type, char *bounds, int *n,
187 struct ui_file *stream)
14f9c5c9
AS
188{
189 LONGEST B;
190 if (ada_scan_number (bounds, *n, &B, n))
191 {
4c4b4cd2
PH
192 /* STABS decodes all range types which bounds are 0 .. -1 as
193 unsigned integers (ie. the type code is TYPE_CODE_INT, not
194 TYPE_CODE_RANGE). Unfortunately, ada_print_scalar() relies
195 on the unsigned flag to determine whether the bound should
196 be printed as a signed or an unsigned value. This causes
197 the upper bound of the 0 .. -1 range types to be printed as
198 a very large unsigned number instead of -1.
199 To workaround this stabs deficiency, we replace the TYPE by
200 builtin_type_long when we detect that the bound is negative,
201 and the type is a TYPE_CODE_INT. The bound is negative when
202 'm' is the last character of the number scanned in BOUNDS. */
203 if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
204 type = builtin_type_long;
14f9c5c9
AS
205 ada_print_scalar (type, B, stream);
206 if (bounds[*n] == '_')
207 *n += 2;
208 }
209 else
210 {
211 int bound_len;
d2e4a39e
AS
212 char *bound = bounds + *n;
213 char *pend;
14f9c5c9
AS
214
215 pend = strstr (bound, "__");
216 if (pend == NULL)
217 *n += bound_len = strlen (bound);
d2e4a39e 218 else
14f9c5c9
AS
219 {
220 bound_len = pend - bound;
221 *n += bound_len + 2;
222 }
223 fprintf_filtered (stream, "%.*s", bound_len, bound);
224 }
225}
226
227/* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
228 the value (if found) of the bound indicated by SUFFIX ("___L" or
4c4b4cd2 229 "___U") according to the ___XD conventions. */
14f9c5c9
AS
230
231static void
d2e4a39e
AS
232print_dynamic_range_bound (struct type *type, const char *name, int name_len,
233 const char *suffix, struct ui_file *stream)
14f9c5c9
AS
234{
235 static char *name_buf = NULL;
236 static size_t name_buf_len = 0;
237 LONGEST B;
238 int OK;
239
240 GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
241 strncpy (name_buf, name, name_len);
242 strcpy (name_buf + name_len, suffix);
243
4c4b4cd2 244 B = get_int_var_value (name_buf, &OK);
14f9c5c9
AS
245 if (OK)
246 ada_print_scalar (type, B, stream);
247 else
248 fprintf_filtered (stream, "?");
249}
250
4c4b4cd2 251/* Print the range type named NAME. */
14f9c5c9
AS
252
253static void
d2e4a39e 254print_range_type_named (char *name, struct ui_file *stream)
14f9c5c9
AS
255{
256 struct type *raw_type = ada_find_any_type (name);
257 struct type *base_type;
d2e4a39e 258 char *subtype_info;
14f9c5c9
AS
259
260 if (raw_type == NULL)
261 base_type = builtin_type_int;
262 else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
263 base_type = TYPE_TARGET_TYPE (raw_type);
264 else
265 base_type = raw_type;
266
267 subtype_info = strstr (name, "___XD");
268 if (subtype_info == NULL && raw_type == NULL)
269 fprintf_filtered (stream, "? .. ?");
270 else if (subtype_info == NULL)
271 print_range (raw_type, stream);
272 else
273 {
274 int prefix_len = subtype_info - name;
275 char *bounds_str;
276 int n;
277
278 subtype_info += 5;
279 bounds_str = strchr (subtype_info, '_');
280 n = 1;
281
d2e4a39e 282 if (*subtype_info == 'L')
14f9c5c9 283 {
4c4b4cd2 284 print_range_bound (base_type, bounds_str, &n, stream);
14f9c5c9
AS
285 subtype_info += 1;
286 }
287 else
4c4b4cd2 288 print_dynamic_range_bound (base_type, name, prefix_len, "___L",
d2e4a39e 289 stream);
14f9c5c9
AS
290
291 fprintf_filtered (stream, " .. ");
292
d2e4a39e 293 if (*subtype_info == 'U')
4c4b4cd2 294 print_range_bound (base_type, bounds_str, &n, stream);
14f9c5c9 295 else
4c4b4cd2 296 print_dynamic_range_bound (base_type, name, prefix_len, "___U",
d2e4a39e 297 stream);
14f9c5c9 298 }
d2e4a39e 299}
14f9c5c9 300
4c4b4cd2 301/* Print enumerated type TYPE on STREAM. */
14f9c5c9
AS
302
303static void
ebf56fd3 304print_enum_type (struct type *type, struct ui_file *stream)
14f9c5c9
AS
305{
306 int len = TYPE_NFIELDS (type);
307 int i, lastval;
308
309 fprintf_filtered (stream, "(");
310 wrap_here (" ");
311
312 lastval = 0;
313 for (i = 0; i < len; i++)
314 {
315 QUIT;
d2e4a39e
AS
316 if (i)
317 fprintf_filtered (stream, ", ");
14f9c5c9
AS
318 wrap_here (" ");
319 fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
320 if (lastval != TYPE_FIELD_BITPOS (type, i))
321 {
322 fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
323 lastval = TYPE_FIELD_BITPOS (type, i);
324 }
325 lastval += 1;
326 }
327 fprintf_filtered (stream, ")");
328}
329
4c4b4cd2 330/* Print representation of Ada fixed-point type TYPE on STREAM. */
14f9c5c9
AS
331
332static void
ebf56fd3 333print_fixed_point_type (struct type *type, struct ui_file *stream)
14f9c5c9
AS
334{
335 DOUBLEST delta = ada_delta (type);
336 DOUBLEST small = ada_fixed_to_float (type, 1.0);
337
338 if (delta < 0.0)
339 fprintf_filtered (stream, "delta ??");
340 else
341 {
342 fprintf_filtered (stream, "delta %g", (double) delta);
d2e4a39e 343 if (delta != small)
14f9c5c9
AS
344 fprintf_filtered (stream, " <'small = %g>", (double) small);
345 }
346}
347
4c4b4cd2 348/* Print representation of special VAX floating-point type TYPE on STREAM. */
14f9c5c9
AS
349
350static void
ebf56fd3 351print_vax_floating_point_type (struct type *type, struct ui_file *stream)
14f9c5c9
AS
352{
353 fprintf_filtered (stream, "<float format %c>",
354 ada_vax_float_type_suffix (type));
355}
356
4c4b4cd2
PH
357/* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
358 recursion (indentation) level, in case the element type itself has
14f9c5c9 359 nested structure, and SHOW is the number of levels of internal
4c4b4cd2 360 structure to show (see ada_print_type). */
14f9c5c9
AS
361
362static void
d2e4a39e
AS
363print_array_type (struct type *type, struct ui_file *stream, int show,
364 int level)
14f9c5c9
AS
365{
366 int bitsize;
367 int n_indices;
368
369 bitsize = 0;
370 fprintf_filtered (stream, "array (");
371
372 n_indices = -1;
d2e4a39e 373 if (show < 0)
14f9c5c9
AS
374 fprintf_filtered (stream, "...");
375 else
376 {
377 if (ada_is_packed_array_type (type))
378 type = ada_coerce_to_simple_array_type (type);
4c4b4cd2
PH
379 if (type == NULL)
380 {
e1d5a0d2 381 fprintf_filtered (stream, _("<undecipherable array type>"));
4c4b4cd2
PH
382 return;
383 }
384 if (ada_is_simple_array_type (type))
14f9c5c9 385 {
d2e4a39e 386 struct type *range_desc_type =
14f9c5c9 387 ada_find_parallel_type (type, "___XA");
d2e4a39e 388 struct type *arr_type;
14f9c5c9
AS
389
390 bitsize = 0;
391 if (range_desc_type == NULL)
392 {
393 for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
394 arr_type = TYPE_TARGET_TYPE (arr_type))
395 {
396 if (arr_type != type)
397 fprintf_filtered (stream, ", ");
398 print_range (TYPE_INDEX_TYPE (arr_type), stream);
399 if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
400 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
401 }
402 }
d2e4a39e 403 else
14f9c5c9
AS
404 {
405 int k;
d2e4a39e
AS
406 n_indices = TYPE_NFIELDS (range_desc_type);
407 for (k = 0, arr_type = type;
14f9c5c9
AS
408 k < n_indices;
409 k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
410 {
411 if (k > 0)
412 fprintf_filtered (stream, ", ");
d2e4a39e
AS
413 print_range_type_named (TYPE_FIELD_NAME
414 (range_desc_type, k), stream);
14f9c5c9
AS
415 if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
416 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
d2e4a39e 417 }
14f9c5c9
AS
418 }
419 }
d2e4a39e 420 else
14f9c5c9
AS
421 {
422 int i, i0;
423 for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
424 fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
425 }
426 }
427
428 fprintf_filtered (stream, ") of ");
429 wrap_here ("");
d2e4a39e
AS
430 ada_print_type (ada_array_element_type (type, n_indices), "", stream,
431 show == 0 ? 0 : show - 1, level + 1);
14f9c5c9
AS
432 if (bitsize > 0)
433 fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
434}
435
436/* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
4c4b4cd2 437 STREAM, assuming the VAL_TYPE is the type of the values. */
14f9c5c9
AS
438
439static void
d2e4a39e
AS
440print_choices (struct type *type, int field_num, struct ui_file *stream,
441 struct type *val_type)
14f9c5c9
AS
442{
443 int have_output;
444 int p;
d2e4a39e 445 const char *name = TYPE_FIELD_NAME (type, field_num);
14f9c5c9
AS
446
447 have_output = 0;
448
4c4b4cd2 449 /* Skip over leading 'V': NOTE soon to be obsolete. */
14f9c5c9
AS
450 if (name[0] == 'V')
451 {
d2e4a39e 452 if (!ada_scan_number (name, 1, NULL, &p))
14f9c5c9
AS
453 goto Huh;
454 }
455 else
456 p = 0;
457
458 while (1)
459 {
d2e4a39e 460 switch (name[p])
14f9c5c9
AS
461 {
462 default:
463 return;
464 case 'S':
465 case 'R':
466 case 'O':
d2e4a39e 467 if (have_output)
14f9c5c9
AS
468 fprintf_filtered (stream, " | ");
469 have_output = 1;
470 break;
471 }
472
d2e4a39e 473 switch (name[p])
14f9c5c9
AS
474 {
475 case 'S':
476 {
477 LONGEST W;
d2e4a39e 478 if (!ada_scan_number (name, p + 1, &W, &p))
14f9c5c9
AS
479 goto Huh;
480 ada_print_scalar (val_type, W, stream);
481 break;
482 }
483 case 'R':
484 {
485 LONGEST L, U;
d2e4a39e
AS
486 if (!ada_scan_number (name, p + 1, &L, &p)
487 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
14f9c5c9
AS
488 goto Huh;
489 ada_print_scalar (val_type, L, stream);
490 fprintf_filtered (stream, " .. ");
491 ada_print_scalar (val_type, U, stream);
492 break;
493 }
494 case 'O':
495 fprintf_filtered (stream, "others");
496 p += 1;
497 break;
498 }
499 }
500
501Huh:
502 fprintf_filtered (stream, "??");
503
504}
505
4c4b4cd2
PH
506/* Assuming that field FIELD_NUM of TYPE is a VARIANTS field whose
507 discriminant is contained in OUTER_TYPE, print its variants on STREAM.
14f9c5c9
AS
508 LEVEL is the recursion
509 (indentation) level, in case any of the fields themselves have
510 nested structure, and SHOW is the number of levels of internal structure
4c4b4cd2 511 to show (see ada_print_type). For this purpose, fields nested in a
14f9c5c9 512 variant part are taken to be at the same level as the fields
4c4b4cd2 513 immediately outside the variant part. */
14f9c5c9
AS
514
515static void
ebf56fd3
AS
516print_variant_clauses (struct type *type, int field_num,
517 struct type *outer_type, struct ui_file *stream,
518 int show, int level)
14f9c5c9
AS
519{
520 int i;
4c4b4cd2 521 struct type *var_type, *par_type;
14f9c5c9
AS
522 struct type *discr_type;
523
524 var_type = TYPE_FIELD_TYPE (type, field_num);
525 discr_type = ada_variant_discrim_type (var_type, outer_type);
526
527 if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
528 {
529 var_type = TYPE_TARGET_TYPE (var_type);
4c4b4cd2
PH
530 if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
531 return;
14f9c5c9
AS
532 }
533
4c4b4cd2
PH
534 par_type = ada_find_parallel_type (var_type, "___XVU");
535 if (par_type != NULL)
536 var_type = par_type;
537
d2e4a39e 538 for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
14f9c5c9
AS
539 {
540 fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
541 print_choices (var_type, i, stream, discr_type);
542 fprintf_filtered (stream, " =>");
d2e4a39e
AS
543 if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
544 outer_type, stream, show, level + 4) <= 0)
14f9c5c9
AS
545 fprintf_filtered (stream, " null;");
546 }
547}
548
4c4b4cd2 549/* Assuming that field FIELD_NUM of TYPE is a variant part whose
14f9c5c9 550 discriminants are contained in OUTER_TYPE, print a description of it
4c4b4cd2
PH
551 on STREAM. LEVEL is the recursion (indentation) level, in case any of
552 the fields themselves have nested structure, and SHOW is the number of
553 levels of internal structure to show (see ada_print_type). For this
554 purpose, fields nested in a variant part are taken to be at the same
555 level as the fields immediately outside the variant part. */
14f9c5c9
AS
556
557static void
ebf56fd3
AS
558print_variant_part (struct type *type, int field_num, struct type *outer_type,
559 struct ui_file *stream, int show, int level)
14f9c5c9
AS
560{
561 fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
d2e4a39e
AS
562 ada_variant_discrim_name
563 (TYPE_FIELD_TYPE (type, field_num)));
564 print_variant_clauses (type, field_num, outer_type, stream, show,
565 level + 4);
14f9c5c9
AS
566 fprintf_filtered (stream, "\n%*send case;", level + 4, "");
567}
568
4c4b4cd2
PH
569/* Print a description on STREAM of the fields in record type TYPE, whose
570 discriminants are in OUTER_TYPE. LEVEL is the recursion (indentation)
571 level, in case any of the fields themselves have nested structure,
572 and SHOW is the number of levels of internal structure to show
573 (see ada_print_type). Does not print parent type information of TYPE.
574 Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
14f9c5c9 575 Prints each field beginning on a new line, but does not put a new line at
4c4b4cd2 576 end. */
14f9c5c9
AS
577
578static int
ebf56fd3
AS
579print_record_field_types (struct type *type, struct type *outer_type,
580 struct ui_file *stream, int show, int level)
14f9c5c9
AS
581{
582 int len, i, flds;
583
584 flds = 0;
585 len = TYPE_NFIELDS (type);
586
587 if (len == 0 && (TYPE_FLAGS (type) & TYPE_FLAG_STUB) != 0)
588 return -1;
589
590 for (i = 0; i < len; i += 1)
591 {
592 QUIT;
593
d2e4a39e 594 if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
14f9c5c9
AS
595 ;
596 else if (ada_is_wrapper_field (type, i))
597 flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
598 stream, show, level);
d2e4a39e 599 else if (ada_is_variant_part (type, i))
14f9c5c9
AS
600 {
601 print_variant_part (type, i, outer_type, stream, show, level);
602 flds = 1;
603 }
604 else
605 {
606 flds += 1;
607 fprintf_filtered (stream, "\n%*s", level + 4, "");
608 ada_print_type (TYPE_FIELD_TYPE (type, i),
609 TYPE_FIELD_NAME (type, i),
610 stream, show - 1, level + 4);
611 fprintf_filtered (stream, ";");
612 }
613 }
614
615 return flds;
616}
617
4c4b4cd2
PH
618/* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
619 level, in case the element type itself has nested structure, and SHOW is
620 the number of levels of internal structure to show (see ada_print_type). */
14f9c5c9
AS
621
622static void
d2e4a39e
AS
623print_record_type (struct type *type0, struct ui_file *stream, int show,
624 int level)
14f9c5c9 625{
d2e4a39e
AS
626 struct type *parent_type;
627 struct type *type;
628
4c4b4cd2
PH
629 type = ada_find_parallel_type (type0, "___XVE");
630 if (type == NULL)
631 type = type0;
14f9c5c9
AS
632
633 parent_type = ada_parent_type (type);
d2e4a39e 634 if (ada_type_name (parent_type) != NULL)
0b48a291 635 fprintf_filtered (stream, "new %s with record",
4c4b4cd2
PH
636 decoded_type_name (parent_type));
637 else if (parent_type == NULL && ada_is_tagged_type (type, 0))
0b48a291
PH
638 fprintf_filtered (stream, "tagged record");
639 else
640 fprintf_filtered (stream, "record");
14f9c5c9
AS
641
642 if (show < 0)
0b48a291 643 fprintf_filtered (stream, " ... end record");
14f9c5c9
AS
644 else
645 {
646 int flds;
647
648 flds = 0;
649 if (parent_type != NULL && ada_type_name (parent_type) == NULL)
d2e4a39e 650 flds += print_record_field_types (parent_type, parent_type,
14f9c5c9
AS
651 stream, show, level);
652 flds += print_record_field_types (type, type, stream, show, level);
d2e4a39e 653
14f9c5c9 654 if (flds > 0)
0b48a291 655 fprintf_filtered (stream, "\n%*send record", level, "");
d2e4a39e 656 else if (flds < 0)
323e0a4a 657 fprintf_filtered (stream, _(" <incomplete type> end record"));
d2e4a39e 658 else
0b48a291 659 fprintf_filtered (stream, " null; end record");
14f9c5c9
AS
660 }
661}
662
663/* Print the unchecked union type TYPE in something resembling Ada
4c4b4cd2 664 format on STREAM. LEVEL is the recursion (indentation) level
14f9c5c9 665 in case the element type itself has nested structure, and SHOW is the
4c4b4cd2 666 number of levels of internal structure to show (see ada_print_type). */
14f9c5c9 667static void
d2e4a39e 668print_unchecked_union_type (struct type *type, struct ui_file *stream,
14f9c5c9
AS
669 int show, int level)
670{
14f9c5c9 671 if (show < 0)
0b48a291 672 fprintf_filtered (stream, "record (?) is ... end record");
d2e4a39e 673 else if (TYPE_NFIELDS (type) == 0)
0b48a291 674 fprintf_filtered (stream, "record (?) is null; end record");
14f9c5c9
AS
675 else
676 {
677 int i;
678
0b48a291 679 fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
14f9c5c9 680
d2e4a39e 681 for (i = 0; i < TYPE_NFIELDS (type); i += 1)
14f9c5c9 682 {
0b48a291 683 fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
d2e4a39e 684 level + 12, "");
14f9c5c9
AS
685 ada_print_type (TYPE_FIELD_TYPE (type, i),
686 TYPE_FIELD_NAME (type, i),
687 stream, show - 1, level + 12);
688 fprintf_filtered (stream, ";");
689 }
690
0b48a291 691 fprintf_filtered (stream, "\n%*send case;\n%*send record",
d2e4a39e 692 level + 4, "", level, "");
14f9c5c9
AS
693 }
694}
d2e4a39e 695
14f9c5c9
AS
696
697
698/* Print function or procedure type TYPE on STREAM. Make it a header
4c4b4cd2 699 for function or procedure NAME if NAME is not null. */
14f9c5c9
AS
700
701static void
d2e4a39e 702print_func_type (struct type *type, struct ui_file *stream, char *name)
14f9c5c9
AS
703{
704 int i, len = TYPE_NFIELDS (type);
705
706 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
707 fprintf_filtered (stream, "procedure");
708 else
709 fprintf_filtered (stream, "function");
710
d2e4a39e 711 if (name != NULL && name[0] != '\0')
14f9c5c9
AS
712 fprintf_filtered (stream, " %s", name);
713
d2e4a39e 714 if (len > 0)
14f9c5c9
AS
715 {
716 fprintf_filtered (stream, " (");
717 for (i = 0; i < len; i += 1)
718 {
719 if (i > 0)
720 {
721 fputs_filtered ("; ", stream);
722 wrap_here (" ");
723 }
d2e4a39e 724 fprintf_filtered (stream, "a%d: ", i + 1);
14f9c5c9
AS
725 ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
726 }
727 fprintf_filtered (stream, ")");
d2e4a39e 728 }
14f9c5c9
AS
729
730 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
731 {
732 fprintf_filtered (stream, " return ");
733 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
734 }
735}
736
737
738/* Print a description of a type TYPE0.
739 Output goes to STREAM (via stdio).
740 If VARSTRING is a non-empty string, print as an Ada variable/field
741 declaration.
4c4b4cd2 742 SHOW+1 is the maximum number of levels of internal type structure
14f9c5c9
AS
743 to show (this applies to record types, enumerated types, and
744 array types).
745 SHOW is the number of levels of internal type structure to show
4c4b4cd2 746 when there is a type name for the SHOWth deepest level (0th is
14f9c5c9
AS
747 outer level).
748 When SHOW<0, no inner structure is shown.
4c4b4cd2 749 LEVEL indicates level of recursion (for nested definitions). */
14f9c5c9
AS
750
751void
d2e4a39e 752ada_print_type (struct type *type0, char *varstring, struct ui_file *stream,
ebf56fd3 753 int show, int level)
14f9c5c9 754{
61ee279c 755 struct type *type = ada_check_typedef (ada_get_base_type (type0));
4c4b4cd2 756 char *type_name = decoded_type_name (type);
14f9c5c9
AS
757 int is_var_decl = (varstring != NULL && varstring[0] != '\0');
758
759 if (type == NULL)
760 {
761 if (is_var_decl)
762 fprintf_filtered (stream, "%.*s: ",
d2e4a39e 763 ada_name_prefix_len (varstring), varstring);
14f9c5c9
AS
764 fprintf_filtered (stream, "<null type?>");
765 return;
766 }
767
768 if (show > 0)
61ee279c 769 type = ada_check_typedef (type);
14f9c5c9
AS
770
771 if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
d2e4a39e
AS
772 fprintf_filtered (stream, "%.*s: ",
773 ada_name_prefix_len (varstring), varstring);
14f9c5c9
AS
774
775 if (type_name != NULL && show <= 0)
776 {
d2e4a39e 777 fprintf_filtered (stream, "%.*s",
14f9c5c9
AS
778 ada_name_prefix_len (type_name), type_name);
779 return;
780 }
781
782 if (ada_is_aligner_type (type))
783 ada_print_type (ada_aligned_type (type), "", stream, show, level);
784 else if (ada_is_packed_array_type (type))
785 print_array_type (type, stream, show, level);
786 else
d2e4a39e
AS
787 switch (TYPE_CODE (type))
788 {
789 default:
790 fprintf_filtered (stream, "<");
791 c_print_type (type, "", stream, show, level);
792 fprintf_filtered (stream, ">");
793 break;
794 case TYPE_CODE_PTR:
795 fprintf_filtered (stream, "access ");
796 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
797 break;
798 case TYPE_CODE_REF:
799 fprintf_filtered (stream, "<ref> ");
800 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
801 break;
802 case TYPE_CODE_ARRAY:
14f9c5c9 803 print_array_type (type, stream, show, level);
d2e4a39e
AS
804 break;
805 case TYPE_CODE_INT:
806 if (ada_is_fixed_point_type (type))
807 print_fixed_point_type (type, stream);
808 else if (ada_is_vax_floating_type (type))
809 print_vax_floating_point_type (type, stream);
810 else
811 {
812 char *name = ada_type_name (type);
813 if (!ada_is_range_type_name (name))
e1d5a0d2 814 fprintf_filtered (stream, _("<%d-byte integer>"),
d2e4a39e
AS
815 TYPE_LENGTH (type));
816 else
817 {
818 fprintf_filtered (stream, "range ");
819 print_range_type_named (name, stream);
820 }
821 }
822 break;
823 case TYPE_CODE_RANGE:
824 if (ada_is_fixed_point_type (type))
825 print_fixed_point_type (type, stream);
826 else if (ada_is_vax_floating_type (type))
827 print_vax_floating_point_type (type, stream);
828 else if (ada_is_modular_type (type))
529cad9c
PH
829 fprintf_filtered (stream, "mod %s",
830 int_string (ada_modulus (type), 10, 0, 0, 1));
d2e4a39e
AS
831 else
832 {
833 fprintf_filtered (stream, "range ");
834 print_range (type, stream);
835 }
836 break;
837 case TYPE_CODE_FLT:
e1d5a0d2 838 fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
d2e4a39e
AS
839 break;
840 case TYPE_CODE_ENUM:
841 if (show < 0)
842 fprintf_filtered (stream, "(...)");
843 else
844 print_enum_type (type, stream);
845 break;
846 case TYPE_CODE_STRUCT:
4c4b4cd2 847 if (ada_is_array_descriptor_type (type))
d2e4a39e
AS
848 print_array_type (type, stream, show, level);
849 else if (ada_is_bogus_array_descriptor (type))
850 fprintf_filtered (stream,
e1d5a0d2 851 _("array (?) of ? (<mal-formed descriptor>)"));
d2e4a39e
AS
852 else
853 print_record_type (type, stream, show, level);
854 break;
855 case TYPE_CODE_UNION:
856 print_unchecked_union_type (type, stream, show, level);
857 break;
858 case TYPE_CODE_FUNC:
859 print_func_type (type, stream, varstring);
860 break;
861 }
14f9c5c9 862}