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